' Atanosoff-Berry-Computer ' set monitor to 1280 x 1024 ' ' Started Jan 25, 2010, ' March 11 ' Make an optional "magnified" GUI ' for easier viewing from a distance ' bit array half size, from 50 bit words to 25 ' 30 colums to 10 of 15 ' all characters ( curently 16x16 ? and features double size ' having trouble with larger characters - now what?? ' ?? Fabricate characters with blocks ?? ' ' data types in FreeBasic ' STRING - array of characters, CHR$(0) not allowed !!, is terminator ' name does not need to end with $ ' BYTE - 8 bit signed ' UBYTE - 8 bit unsigned ' SHORT - 16 bit signed ' USHORT - 16 bit Unsigned ' INTEGER - 32 bit signed ' LONG - 32 bit signed, same as INTEGER so far ' UINTEGER - 32 bit unsigned ' LONGINT - 64 bit signed integer ' ULOONGINT - 64 bit unsigned integer ' Single - 32 bit floating ' DOUBLE - 64 bit floating OPTION EXPLICIT DEFint A-Z ' default everything to 32 bit Intager DIM SiteStatus,LastSiteStatus AS INTEGER CONST White = &hFFFFFF ' colors CONST Grey = &h606060 CONST GreyD = &h101010 CONST GreyL = &hA0A0A0 CONST Red = &hFF0000 CONST RedDull = &h800000 CONST Yellow = &hFFFF00 CONST YellowDull = &h808000 CONST Green = &h00FF00 CONST Blue = &h0000FF CONST BlueDull = &h000080 CONST Black = &h000000 CONST Debug = 0 Const WorkingEquationOffsetX = 12 Const WorkingEquationOffsetY = 52 CONST ScaleFactor = 2^30 ' DIM SingleFloat as SINGLE DIM SHARED AS INTEGER RunUntil = 1 ' preset to run 1 bit DIM SHARED RunUntilLatch, RunUntil1ButtonMemory AS INTEGER ' DIM I,J,L,M AS INTEGER DIM SHARED AS DOUBLE ThisTime, LastTime, DynamicsLastTime DIM SHARED AS DOUBLE DynamicsInterval = 0.016666 LastTime = TIMER DIM RealTimeMode = 1 'goto Main CONST LEFTBUTTON = 1 CONST MIDDLEBUTTON = 4 CONST RIGHTBUTTON = 2 CONST SHOWMOUSE = 1 CONST HIDEMOUSE = 0 DIM MouseXCurrent AS INTEGER, MouseYCurrent AS INTEGER, MouseButtonsCurrent AS INTEGER DIM AS INTEGER StepModeExecute ' execute existing step mode once, mode may change DIM AS INTEGER StepModeButtonWasUp ' Button was raised, can be used to detect edge DIM AS INTEGER StepModePrintEnable ' Have done enough to print dim testcnt CONST BitsPerCoefficient = 50 ' Number of binary digits + 1, zeroth only for carry CONST Coefficients = 30 DIM AccumDbl AS double ' Arrays as bits in Keyboard, Carry, Counter DIM KA(Coefficients + 4, BitsPerCoefficient + 4) ' 1 to n DIM CA(Coefficients + 4, BitsPerCoefficient + 4) ' 1 to n DIM CarryArray(Coefficients + 4, BitsPerCoefficient + 4) ' 0 to n-1 'DIM Pivot ' the coefficient pair in the rotors we are ' using for ratoing DIM PivotCA_Sign ' set by LoadCA, add, subtract DIM PivotCA_OldSign ' set by LoadCA, operated by ?? DIM PivotCA_NonZero ' operated by add and subtract, no bits changed, -zero ??? DIM PivotKA_NonZero ' set by LoadKA, operated by KA_Shift, no bits changed -zero ??? DIM PivotCoefEndFlag ' if not 0, we have eliminated that coefficient from this pair of equations :-)) DIM LoadEquationPairFlag ' if not 0, no equations to load DIM PivotColumn ' which column (coefficient) in equations is the pivot DIM PivotKA_Equation ' DIM PivotCA_Equation ' DIM LastStoreCA = -1 ' last move from CA to WorkingArrayDbl ' used in usage vectors DIM BaseBitX,BaseBitY DIM OldKA_LineX,OldKA_LineY,NewKA_LineX,NewKA_LineY DIM OldCA_LineX,OldCA_LineY,NewCA_LineX,NewCA_LineY DIM OldSC_LineX,OldSC_LineY,NewSC_LineX,NewSC_LineY DIM AS INTEGER NumVariables = 5 ' set up, does not include the equation constant ' Array of Coefficients in the equations CONST Equation = Coefficients ' CONST CoefficientInEq = Coefficients ' DIM AS DOUBLE WorkingArrayDbl(Equation,CoefficientInEq) ' DIM AS INTEGER ReferenceEquation, WorkingEquation ' control loop for forward elimination DIM Ky= 0, Ct= 1 ' which Equation is used for which - DIM LSign DIM AS LONGINT LONGINT1, LONGINT2, LONGINT3 DIM AS LONG LONG1, LONG2, LONG3 CONST RotorDisplayX = 70 ' 50 CONST RotorDisplayY = 100 DIM AS INTEGER PxlX,PxlY DIM AS INTEGER BitCntr ' which bit # being processed 0 to ? DIM AS INTEGER NextCommand = 1 ' next command to execute DIM AS INTEGER RunFlag DIM AS INTEGER WordEndFlag = 0 DIM AS INTEGER CoefficientEndFlag = 0 DIM AS INTEGER ABC_Phase ' 0 = Forward Elimination , 1 = Back Substitution, 2 = Desk Calculator dim DoneFlag = 0 'DIM Button1On Start: DIM WhichArray WhichArray = 1 ' the 3x3 ReStart: DynamicsLastTime = TIMER DoneFlag = 0 SCREEN 21, 16, 1, 1 '18,16,1,1,1 '21, 16, 1, 0 ' 1280x1024 mode[,16 bit color depth [, one page[, 0 = not fullscreen]]] 'dim w,h,depth,driver_name$ 'screeninfo w, h, depth,,,,driver_name$ 'Print str$(w)+"x"+str$(h) + "x" + STR$(depth); 'Print " using " + driver_name$ + " driver" 'sleep 'Screen 19, 32, 1,0 ' 800x600 ' SCREENRES width, height[depth[,nump_pages..]]] RunFlag = 0 WordEndFlag = 0 CoefficientEndFlag = 0 ABC_Phase = 0 ' 0 = Forward Elimination , 1 = Back Substitution, 2 = Desk Calculat LastStoreCA = -1 Ky= 0 : Ct= 1 NextCommand = 1 BitCntr = 0 RunUntil = 1 PivotCoefEndFlag = 0 ' if not 0, we have eliminated that coefficient from this pair of equations :-)) LoadEquationPairFlag = 0 ' if not 0, no equations to load PivotColumn = 0 ' which column (coefficient) in equations is the pivot PivotKA_Equation = 0 ' PivotCA_Equation = 0 ' FOR I = 0 to Coefficients+1 ' clear rotor arrays For J = 0 to BitsPerCoefficient+1 KA(I,J) = 0 CA(I,J) = 0 CarryArray(I,J) = 0 NEXT J NEXT I FOR I = 0 to Equation ' clear rotor arrays For J = 0 to CoefficientInEq WorkingArrayDbl(I,J) = 0' NEXT J NEXT I ' line x,y 'LINE(0,0)-(1500,1200), Grey,bf ' grey background for photography - 'print " commands are 'q' = quit, '?' = notes " ' set up Equation Coefficients ' test ????/// ReferenceEquation = 0 ' set up forware elimination control loop WorkingEquation = 1 ' '----------------------------------- Select input ---------------- Select case WhichArray case 1 GoSub Set3Page11 case 2 GoSub Set5Random case 3 GoSub Set9Random case else GoSub Set3Page11 END SELECT ABC_Phase = 0 ' 0 = Forward, 1 = Reverse, 2 = Desk Calculator GoSub PrintWorkingArray ' operator sets up drums ' game plan ' select two equations, based on ?????? ' ( based on nothing ??? we start with 0 and 1) ' we select coefficient 0 for pivot, ??????? ' ( based on nothing ??? we start with coefficient 0) ' ' find which coefficient is greater in magnitude ' set that into counter (Cntr) ' set other into keyboard (KyBd) - to be added or subtracted from counter ' choose starting operation by table ' KyBd Cntr starting operation ' + + - ' + - + ' - + + ' - - - ' then DO it UNTIL ' (the sign of the pivot Cntr changes) ' or (Cntr becomes 0 or -0) ie, no bit change ' ?or? (KyBd becomes 0 or -0) ' then ' a)shift KyBd one bit right (divide by 2) ' (exit if KyBd becomes 0 or -0) ' b) change operation, from add to sub, or sub to add ' END UNITL ' if here, the pivot coefficient has become 0 or -0 ' and time to store the coefficients for the next elimination ' ' if all remaining equations have a single non-zero something, ' we are done with the ABC ?except for converting binary to decimal? ' ' ?? there is a promise of having to do a little desk calculator work ' to get the final results?? GoSub LoadDrums GoSub TestSimulationMode ' start reading mode control buttons GoSub PrintAll ' initial print GoSub PrintSimulationMode ' initial print '-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IdleLoop: ThisTime = TIMER IF RealTimeMode <> 0 then IF BitCntr = 49 Then Sleep (100*DynamicsInterval) DynamicsLastTime = TIMER ELSE DO sleep 1 ThisTime = TIMER LOOP WHILE ThisTime < DynamicsLastTime + DynamicsInterval DynamicsLastTime += DynamicsInterval ' increment DynamicsLastTime END IF ELSE DynamicsLastTime = ThisTime END IF ' - PauseTimeAdjust ' subtract out pause time ' limit speed if in "real time" DIM k$ ' keyboard control input character k$ = LCASE$(INKEY$) IF K$ <> "" THEN SELECT CASE K$ 'CASE "p" ' WHILE INKEY$ = "": SLEEP (10):WEND CASE "q" END CASE chr$( 27 ) ' Esc key END END SELECT ' K$ END IF ' K$ GoSub TestSimulationMode SELECT CASE RunUntil CASE 1 ' one bit IF StepModePrintEnable <> 0 then GoSub PrintBitCntr ' print arrays - and initial StepModePrintEnable = 0 END IF ' wait for any edge if StepModeExecute <> 0 then GoSub PerformNextCommandAndTest ' do one bit StepModeExecute = 0 StepModePrintEnable = 1 END IF CASE 2 ' do complete word IF StepModePrintEnable <> 0 then GoSub PrintBitCntr ' print arrays - and initial StepModePrintEnable = 0 END IF ' wait for any edge if StepModeExecute <> 0 AND WordEndFlag = 0 then GoSub PerformNextCommandAndTest ' do one bit StepModePrintEnable = 1 ELSE StepModeExecute = 0 WordEndFlag = 0 END IF CASE 3 ' do complete coefficient IF StepModePrintEnable <> 0 OR RealTimeMode <> 0 then GoSub PrintBitCntr ' print arrays - and initial StepModePrintEnable = 0 END IF ' wait for any edge if (StepModeExecute <> 0 AND WordEndFlag = 0) then ' or (FullSpeed <>0) then GoSub PerformNextCommandAndTest ' do one bit ELSEIF WordEndFlag = 1 THEN StepModePrintEnable = 1 WordEndFlag = 0 END IF IF PivotCoefEndFlag <> 0 then ' store CA Drum into WorkingArray(WorkingEquation) GoSub SubrStoreCA ' print WorkingArray GoSub PrintWorkingArray StepModeExecute = 0 SELECT CASE ABC_Phase ' 0 = Forward, 1 = back substitution, 2 = Desk Calculator CASE 0 WorkingEquation += 1 IF WorkingEquation > NumVariables-1 THEN PivotColumn += 1 IF PivotColumn = NumVariables -1 THEN ABC_Phase = 1 ' go to back substitution ReferenceEquation = NumVariables-1 ' WorkingEquation = ReferenceEquation PivotColumn = NumVariables-1 ' PRINT " " goto BackJump END IF ReferenceEquation += 1 WorkingEquation = ReferenceEquation + 1 END IF Case 1 ' back substitution BackJump: WorkingEquation -= 1 ' go virtically one IF WorkingEquation < 0 Then ReferenceEquation -=1 ' move reference equation up one WorkingEquation = ReferenceEquation - 1 PivotColumn = ReferenceEquation ' move IF ReferenceEquation = 0 THEN ABC_Phase = 2 ' go to DeskJump GoTo DeskJump END IF ' ref eq END IF ' work eq ' LOCATE DiagOffsetY+19,DiagOffsetX 'PRINT " back sub WE = ";WorkingEquation;" RE = ";ReferenceEquation;" ";PivotColumn CASE 2 DeskJump: print " " ' print final result of desk calculations print print "Convert binary cards to ABC dials, then desk calculator for divisions " print " "; LOCATE 90,2 ' for reasons unknown, this statement doesn't work !!! color red For I = 0 to NumVariables-1 For J = 0 to NumVariables-1 IF I = J Then PRINT CHR$(ASC("A")+J); 'PRINT " "; PRINT "="; AccumDbl = WorkingArrayDbl(I,I) SingleFloat = WorkingArrayDbl(I,NumVariables)/AccumDbl GoSub PrintSingleFloat IF I <> NumVariables-1 Then PRINT " , "; END IF END IF NEXT ' J NEXT ' I GoSub PrintAll ABC_Phase = 3 ' go to Desk Calculator GoTo DoneJump CASE 3 ' if here, all done DoneJump: DoneFlag = 1 COLOR RED locate WorkingEquationOffsetY-2,WorkingEquationOffsetX+20 PRINT " Done " Sleep 250 COLOR WHITE locate WorkingEquationOffsetY-2,WorkingEquationOffsetX+20 PRINT " Done " Sleep 250 GoTo IdleLoop END SELECT GoSub LoadDrums GoSub PrintAll WordEndFlag = 0 PivotCoefEndFlag = 0 'sleep (1000) RunUntil = 1 END IF CASE ELSE GOTO IdleLoop END SELECT GOTO IdleLoop ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PerformNextCommandAndTest: ' Start of control logic ' SELECT CASE NextCommand CASE 1 ' GoSub SubrAddBit ' 1 (BitCntr) CASE 2 ' GoSub SubrSubBit ' 2 (BitCntr) CASE 3 ' GoSub SubrShiftKA ' 3 with sign extension !! CASE 4 ' GoSub SubrLoadKA ' 4 (PivotKA_Equation) CASE 5 ' GoSub SubrLoadCA ' 5 (PivotCA_Equation) CASE 6 ' GoSub SubrStoreCA ' 6 (PivotCA_Equation) CASE ELSE END SELECT BitCntr = BitCntr + 1 ' increment BitCntr if BitCntr = BitsPerCoefficient then ' BitsPerCoefficient then BitCntr = 0 WordEndFlag = 1 ' is sign change - or maybe overflow then IF CA(PivotColumn,BitsPerCoefficient-1) <> PivotCA_OldSign THEN PivotCA_OldSign = CA(PivotColumn,BitsPerCoefficient-1) 'LOCATE DiagOffsetY+10,DiagOffsetX 'PRINT " Sign change " 'LOCATE DiagOffsetY+11,DiagOffsetX 'PRINT " shifted KA" GoSub SubrShiftKA ' divide all KA coefficients by 2, ie shift right GoSub PrintBitCntr ' now - have we reduced KA to zero or -0 ?? I = 0 ' prepare to sum the # of one bits L = 0 ' FOR J = 0 to BitsPerCoefficient-1 I += KA(PivotColumn,j) L += CA(PivotColumn,j) NEXT J if I = 0 OR (I = -BitsPerCoefficient AND L = 0) then 'LOCATE DiagOffsetY+12,DiagOffsetX 'PRINT " store this equation, select another pair " PivotCoefEndFlag = 1 RETURN END IF 'LOCATE DiagOffsetY+13,DiagOffsetX 'PRINT " KA bits = ";I ' shift KA right one (divide by 2) and change sign of operation NextCommand = NextCommand + 1 ' ????? initial test, add & subtract IF NextCommand > 2 THEN : NextCommand = 1 : END IF LOCATE WorkingEquationOffsetY-1,WorkingEquationOffsetX-8 ' print data 'PRINT " Operation "; IF NextCommand = 1 then PRINT "Add "; ELSEIF NextCommand = 2 then PRINT "Sub "; ELSEIF NextCommand = 3 then PRINT "Shft"; END IF END IF ELSE WordEndFlag = 0 END IF RETURN '-------------------------------------------------------------------- PrintSingleFloat: ' print SingleFloat as sn.nnnEsnn, non-distructively DIM SFTemp as SiNGLE DIM SFSign, SFExp, SFCnt SFTemp = SingleFloat ' save from distruction SFSign = 0 ' positive SFExp = 0 SFCnt = 0 IF SFTemp <> 0.0 then IF SFTemp < 0.0 then SFSign = 1 ' set negative flag SFTemp = -SFTemp ' set to positive for eval END IF WHILE SFTemp > 10.0 SFExp += 1 SFTemp /= 10.0 WEND WHILE SFTemp < 1.0 SFExp -= 1 SFTemp *= 10.0 WEND END IF ' IF SFTemp <> 0.0 then ' - - - - - - Now Print formatted IF SFSign = 0 THEN print "+"; ELSE PRINT "-"; END IF FOR SFCnt = 0 to 3 IF SFCnt = 1 Then : Print "."; : END IF ' place decimal point PRINT USING "#";INT(SFTemp); SFTemp = (SFTemp - INT(SFTemp))*10.0 NEXT SFCNT 'PRINT " SFExp= ";SFExp; PRINT "e"; IF SFExp < 0 THEN PRINT "-"; SFExp = -SFExp ELSE PRINT "+"; END IF IF SFExp >= 10 THEN PRINT USING "#";INT(SFExp/10); SFExp = (SFExp - INT(SFExp))*10.0 ELSE PRINT "0"; END IF PRINT USING "#";SFExp; RETURN '-------------------------------------------------------------------- LoadDrums: ' Inputs ' ReferenceEquation ' WorkingEquation ' PivotColumn ' Outputs ' set up KA_Drum ' set up CA_Drum ' ' get absolute values of Pivot Coefficients DIM as DOUBLE LD_RefPivotAbs, LD_WorkingPivotAbs LD_RefPivotAbs = ABS(WorkingArrayDbl(ReferenceEquation,PivotColumn)) LD_WorkingPivotAbs = ABS(WorkingArrayDbl(WorkingEquation,PivotColumn)) ' Load larger || into counter CA - remember sign of selected coefficient ' Load smaller || into keyboard KA - remember sign of selected coefficient IF LD_RefPivotAbs > LD_WorkingPivotAbs THEN PivotKA_Equation = ReferenceEquation GoSub SubrLoadKA PivotCA_Equation = WorkingEquation GoSub SubrLoadCA ELSE PivotKA_Equation = WorkingEquation GoSub SubrLoadKA PivotCA_Equation = ReferenceEquation GoSub SubrLoadCA END IF PivotCA_OldSign = CA(PivotColumn,BitsPerCoefficient-1) ' set operation using following table ' KA CA operation ' + + SUB - ' + - ADD + ' - + ADD + ' - - SUB - ' RETURN IF CA(PivotColumn,BitsPerCoefficient-1) = KA(PivotColumn,BitsPerCoefficient-1) then NextCommand = 2 ' set for subtract ELSE NextCommand = 1 ' set for add END IF LOCATE WorkingEquationOffsetY-1,WorkingEquationOffsetX-8 ' print data 'PRINT " Operation "; IF NextCommand = 1 then PRINT "Add " ELSEIF NextCommand = 2 then PRINT "Sub " ELSEIF NextCommand = 3 then PRINT "Shft" END IF 'LOCATE DiagOffsetY+10,DiagOffsetX 'PrinT USING "LREq = ## LWEq = ## PvtC = ##";ReferenceEquation;WorkingEquation;PivotColumn 'LOCATE DiagOffsetY+11,DiagOffsetX 'PrinT USING "KAEq = ## CAEq = ## PvtC = ##";PivotKA_Equation;PivotCA_Equation;PivotColumn RETURN '-------------------------------------------------------------------- SubrAddBit: ' 1 (BitCntr) IF RunUntil = 1 then ' LOCATE 53,DiagOffsetY ' PRINT USING " Add Ky plus Ct -> Ct ## ";BitCntr END IF ' add logic Ct Carry+1 ' Ky CT Cy Sum Carry ' 0 0 0 0 0 ' 0 0 1 1 0 ' 0 1 0 1 0 ' 0 1 1 0 1 ' 1 0 0 1 0 ' 1 0 1 0 1 ' 1 1 0 0 1 ' 1 1 1 1 1 DIM LKy,LCt,LCy, AddSum, AddCarry FOR I = 0 to NumVariables ' step through this bit in all the coefficients LKy = KA(I,BitCntr) IF LKy <> 0 then LKy = 1 : END IF LCt = CA(I,BitCntr) IF LCt <> 0 then LCt = 1 : END IF LCy = CarryArray(I,BitCntr) IF LCy <> 0 then LCy = 1 : END IF IF BitCntr = 0 then LCy = 0 : END IF ' assure no carry into word IF LKY = 0 and LCT = 0 and LCy = 0 then : AddSum = 0 : AddCarry=0 ELSEIF LKY = 0 and LCT = 0 and LCy = 1 then : AddSum = 1 : AddCarry=0 ELSEIF LKY = 0 and LCT = 1 and LCy = 0 then : AddSum = 1 : AddCarry=0 ELSEIF LKY = 0 and LCT = 1 and LCy = 1 then : AddSum = 0 : AddCarry=1 ELSEIF LKY = 1 and LCT = 0 and LCy = 0 then : AddSum = 1 : AddCarry=0 ELSEIF LKY = 1 and LCT = 0 and LCy = 1 then : AddSum = 0 : AddCarry=1 ELSEIF LKY = 1 and LCT = 1 and LCy = 0 then : AddSum = 0 : AddCarry=1 ELSEIF LKY = 1 and LCT = 1 and LCy = 1 then : AddSum = 1 : AddCarry=1 END IF CA(I,BitCntr) = AddSum CarryArray(I,BitCntr+1) = AddCarry IF BitCntr > 0 then CarryArray(I,BitCntr-1) = 0 ' tidy it up 'IF RunUntil = 1 AND I = PivotColumn THEN ' Locate 60,DiagOffsetY ' PRINT USING " Add Ct plus Ky -> Ct bit = ## ";BitCntr ' Locate 61,DiagOffsetY ' print using " LKY=# LCt=# LCy=# ";LKy,LCt,LCy ' Locate 62,DiagOffsetY ' print using " AddSum=# AddCarry=# ";AddSum,AddCarry 'END IF NEXT I RETURN '-------------------------------------------------------------------- SubrSubBit: ' 2 (BitCntr) IF RunUntil = 1 then ' LOCATE 53,DiagOffsetY ' PRINT USING " Sub Ct minus Ky -> Ct ## ";BitCntr END IF ' sub logic ' as per http://www.shef.ac.uk/physics/teaching/phy107/logicsub.html ' Ky Ct Ct Bor+1 ' Min Sub Borr Dif Borr ' 0 0 0 0 0 ' 0 0 1 1 1 ' 0 1 0 1 0 ' 0 1 1 0 0 ' 1 0 0 1 1 ' 1 0 1 0 1 ' 1 1 0 0 0 ' 1 1 1 1 1 ' Burks book page 322 ' Ky Ct Ct Bor+1 ' Min Sub Borr Dif Borr ' 0 0 0 0 0 ' 0 0 1 1 1 ' 0 1 0 1 1 ' 0 1 1 0 1 ' 1 0 0 1 0 ' 1 0 1 0 0 ' 1 1 0 0 0 ' 1 1 1 1 1 DIM Minu, Subt, Differ, Borrow, BorrowOut ' minuend FOR I = 0 to NumVariables ' step through this bit in all the coefficients Subt = KA(I,BitCntr) IF Subt <> 0 then Subt = 1 : END IF Minu = CA(I,BitCntr) IF Minu <> 0 then Minu = 1 : END IF Borrow = CarryArray(I,BitCntr) IF Borrow <> 0 then Borrow = 1 : END IF IF BitCntr = 0 then : Borrow = 0 : END IF IF Minu = 0 and Subt = 0 and Borrow = 0 then : Differ = 0 : BorrowOut=0 ELSEIF Minu = 0 and Subt = 0 and Borrow = 1 then : Differ = 1 : BorrowOut=1 ELSEIF Minu = 0 and Subt = 1 and Borrow = 0 then : Differ = 1 : BorrowOut=1 ELSEIF Minu = 0 and Subt = 1 and Borrow = 1 then : Differ = 0 : BorrowOut=1 ELSEIF Minu = 1 and Subt = 0 and Borrow = 0 then : Differ = 1 : BorrowOut=0 ELSEIF Minu = 1 and Subt = 0 and Borrow = 1 then : Differ = 0 : BorrowOut=0 ELSEIF Minu = 1 and Subt = 1 and Borrow = 0 then : Differ = 0 : BorrowOut=0 ELSEIF Minu = 1 and Subt = 1 and Borrow = 1 then : Differ = 1 : BorrowOut=1 END IF CA(I,BitCntr) = Differ CarryArray(I,BitCntr+1) = BorrowOut IF BitCntr > 0 then CarryArray(I,BitCntr-1) = 0 ' tidy it up 'IF RunUntil = 1 AND I = PivotColumn THEN ' bit 'Locate 60,DiagOffsetY 'PRINT USING " Sub Ct minus Ky -> Ct bit = ## ";BitCntr ' Locate 61,DiagOffsetY ' print using " Minu=# Subt=# Borrow=# ";Minu,Subt,Borrow ' Locate 62,DiagOffsetY ' print using " Differ=# BorrowOut=# ";Differ,BorrowOut 'END IF NEXT I RETURN '-------------------------------------------------------------------- SubrShiftKA: ' 3 'LOCATE 53,DiagOffsetX 'PRINT " executing SubrShiftKA: " FOR I = 0 to NumVariables FOR J = 0 to BitsPerCoefficient-2 ' sign extend KA(I,J) = KA(I,J+1) CarryArray(I,J) = 0 ' pretty up a little NEXT J CarryArray(I,BitsPerCoefficient-1) = 0 ' pretty up a little NEXT I RETURN '------------------------------'-------------------------------------------------------------------- SubrLoadKA: ' 4 (PivotKA_Equation) move coefficients to KA 'LOCATE 50,DiagOffsetX 'PRINT USING "Read binary card to KA Drum <- Eqn ## ";PivotKA_Equation For I = 0 to NumVariables LONGINT1 = WorkingArrayDbl(PivotKA_Equation,I)*ScaleFactor ' OK, we got it LONG1 = LONGINT1 ' shift bug in FREEBASIC LONGINT LONG2 = LONGINT1 SHR 32 FOR L = 20 to 0 STEP -1 'LONGINT2 = LONGINT1/(2**L) KA(I,L+32) = BIT(LONG2,L) CarryArray(I,L+32) = 0 NEXT L FOR L = 31 to 0 STEP -1 KA(I,L) = BIT(LONG1,L) CarryArray(I,L) = 0 ' clear all carrys, makes it look good NEXT L NEXT I GoSub MarkDataFlow RETURN '------------------------------'-------------------------------------------------------------------- SubrLoadCA: ' 5 (PivotCA_Equation) 'LOCATE 49,DiagOffsetX 'PRINT USING "Read binary card to CA Drum <- Eqn ## ";PivotCA_Equation For I = 0 to coefficients-1 LONGINT1 = WorkingArrayDbl(PivotCA_Equation,I)*ScaleFactor ' OK, we got it LONG1 = LONGINT1 ' shift bug in FREEBASIC LONGINT LONG2 = LONGINT1 SHR 32 FOR L = 20 to 0 STEP -1 'LONGINT2 = LONGINT1/(2**L) CA(I,L+32) = BIT(LONG2,L) CarryArray(I,L+32) = 0 NEXT L FOR L = 31 to 0 STEP -1 CA(I,L) = BIT(LONG1,L) CarryArray(I,L) = 0 ' clear all carrys, makes it look good NEXT L NEXT I GoSub MarkDataFlow RETURN '------------------------------ SubrStoreCA: ' 6 (WorkingEquation) 'LOCATE 49,DiagOffsetX 'PRINT USING "Punched binary card from CA Drum -> Eqn ## "; WorkingEquation DIM AS INTEGER StoreCASignFlag AccumDbl = 0 For I = 0 to coefficients-1 ' print input CA IF CA(I,BitsPerCoefficient-1) <> 0 then StoreCASignFlag = 1 ELSE StoreCASignFlag = 0 END IF AccumDbl = 0.0 for J = BitsPerCoefficient-1 to 0 step -1 AccumDbl = AccumDbl*2 IF (StoreCASignFlag = 0 AND CA(I,J) <> 0) OR (StoreCASignFlag = 1 AND CA(I,J) = 0) then AccumDbl += 1 END IF NEXT J ' AccumDbl = |value| IF StoreCASignFlag = 1 THEN AccumDbl = -AccumDbl END IF WorkingArrayDbl(WorkingEquation,I) = AccumDbl/ScaleFactor NEXT I LastStoreCA = WorkingEquation GoSub MarkDataFlow RETURN '--------------------------------------------------------------------------------------------- PrintAll: Dim SaveBitCntr SaveBitCntr = BitCntr For BitCntr = 0 to BitsPerCoefficient ' -1 GoSub PrintBitCntr Next BitCntr BitCntr = SaveBitCntr RETURN PrintBitCntr: ' this BitCntr and +1 unless > BitsPerCoefficient IF DoneFlag <> 0 then : RETURN : END IF IF BitCntr = 0 then COLOR White LOCATE 1,2 PRINT " Atanasoff-Berry-Computer Simulation " PRINT " Ed Thelen March 21, 2010 ed@ed-thelen.org" LOCATE 4,2 color white Print " Legend:"; COLOR Red PRINT " KA Drum "; color White Print ","; color White PRINT " Carry bit "; color White Print ","; color Green Print " CA Drum "; color White Print ","; color Yellow Print " 'Pivot' "; color White Print ","; color green Print " Dot on right = CA to storage" LOCATE 5,20 Color White PRINT " <--- Bits ---- " color White LOCATE 6, 9 PRINT "49 40 30 20 10 0" LOCATE 9,2 PRINT "C" LOCATE 10,2 PRINT "O" LOCATE 11,2 PRINT "E" LOCATE 12,2 PRINT "F" LOCATE 13,2 PRINT "F" LOCATE 14,2 PRINT "I" LOCATE 15,2 PRINT "C" LOCATE 16,2 PRINT "I" LOCATE 17,2 PRINT "E" LOCATE 18,2 PRINT "N" LOCATE 19,2 PRINT "T" LOCATE 20,2 PRINT "S" LOCATE 7,5 PRINT "0" LOCATE 14,5 PRINT "5" LOCATE 21,4 PRINT "10" LOCATE 28,4 PRINT "15" LOCATE 35,4 PRINT "20" LOCATE 42,4 PRINT "25" LOCATE 47,4 PRINT "29" CONST BoxLabelX = 143 CONST BoxLabelY = 4 LOCATE BoxLabelY,BoxLabelX PRINT "Equation"; LOCATE BoxLabelY+1,BoxLabelX PRINT "Storage"; LOCATE BoxLabelY+2,BoxLabelX PRINT "Boxes"; LOCATE BoxLabelY+0,BoxLabelX-21 PRINT " |KA| >= |CA|" LOCATE BoxLabelY+1,BoxLabelX-21 PRINT "< data from store" LOCATE BoxLabelY+2,BoxLabelX-21 PRINT "data to store > " END IF ' BitCntr = 0 ' - - - - - - - - - draw coefficients one at a time vertically --- PxlX = RotorDisplayX FOR I = BitsPerCoefficient-1 to 0 step -1 ' present bit of Coefficients, X, horizontal PxlY = RotorDisplayY For J = 0 to Coefficients-1 ' -1 ' present Coefficients , Y, vertical IF I = BitsPerCoefficient-1 then if j = PivotColumn then ' draw pivot arrow :-)) LINE(PxlX-16,PxlY )-(PxlX-14,PxlY+1), Yellow,bf LINE(PxlX-16,PxlY+2)-(PxlX-11,PxlY+3), Yellow,bf LINE(PxlX-16,PxlY+4)-(PxlX-8,PxlY+5), Yellow,bf LINE(PxlX-16,PxlY+6)-(PxlX-11,PxlY+7), Yellow,bf LINE(PxlX-16,PxlY+8)-(PxlX-14,PxlY+9), Yellow,bf ELSE LINE(PxlX-16,PxlY)-(PxlX-8,PxlY+12), Black,bf END IF END IF if I = 0 then ' Draw box LINE(PxlX+200,PxlY)-(PxlX+240,PxlY+12), White,b If j = 0 then ' remember location of BaseBit BaseBitX = PxlX+12 BaseBitY = PxlY ' remove old lines IF OldKA_LineY <> NewKA_LineY then if OldKA_LineX <> 0 then LINE(BaseBitX,BaseBitY)-(OldKA_LineX,OldKA_LineY),black',b end if OldKA_LineX = NewKA_LineX OldKA_LineY = NewKA_LineY End IF IF OldCA_LineY <> NewCA_LineY then if OldCA_LineX <> 0 then LINE(BaseBitX,BaseBitY+10)-(OldCA_LineX,OldCA_LineY),black',b end if OldCA_LineX = NewCA_LineX OldCA_LineY = NewCA_LineY End IF ' OldSC_LineX,OldSC_LineY,NewSC_LineX,NewSC_LineY IF OldSC_LineY <> NewSC_LineY then If OldSC_LineX <> 0 then LINE(BaseBitX,BaseBitY+10)-(OldSC_LineX,OldSC_LineY), black CIRCLE(OldSC_LineX,OldSC_LineY),3,black,,,,f end if OldSC_LineX = NewSC_LineX OldSC_LineY = NewSC_LineY End If End If IF J = PivotKA_Equation then ' draw new KA pickup NewKA_LineX = PxlX+190 NewKA_LineY = PxlY+0 LINE(BaseBitX,BaseBitY)-(NewKA_LineX,NewKA_LineY), Red CIRCLE(BaseBitX,BaseBitY),3,red,,,,f End If IF J = PivotCA_Equation then NewCA_LineX = PxlX+190 NewCA_LineY = PxlY+10 LINE(BaseBitX,BaseBitY+10)-(NewCA_LineX,NewCA_LineY), Green CIRCLE(BaseBitX,BaseBitY+10),3,Green,,,,f End If ' OldSC_LineX,OldSC_LineY,NewSC_LineX,NewSC_LineY IF J = LastStoreCA then NewSC_LineX = PxlX+190 NewSC_LineY = PxlY+10 LINE(BaseBitX,BaseBitY+10)-(NewSC_LineX,NewSC_LineY), green CIRCLE(NewSC_LineX,NewSC_LineY),3,green,,,,f End If end if LINE(PxlX,PxlY)-(PxlX+1,PxlY+2), Red,bf IF KA(J,I) = 0 Then LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), Black,bf ELSE LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), Red,bf END IF PxlY += 5 LINE(PxlX,PxlY)-(PxlX+1,PxlY+2), White,bf ' note vertical offset IF CarryArray(J,I) = 0 Then LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), Black,bf ELSE LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), White,bf END IF PxlY += 5 LINE(PxlX,PxlY)-(PxlX+1,PxlY+2), Green,bf IF CA(J,I) = 0 Then LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), Black,bf ELSE LINE(PxlX+2,PxlY)-(PxlX+6,PxlY+2), Green,bf END IF 'end if 'end if ' PxlY = PxlY+10 IF J mod 5 = 4 then : PxlY = PxlY+10 : END IF NEXT J PxlX = PxlX+15 IF I mod 5 = 0 then : PxlX = PxlX+15 : END IF NEXT I FOR I = 0 to 0 ' equation locate WorkingEquationOffsetY-2,WorkingEquationOffsetX-8 SELECT CASE ABC_Phase ' 0 = Forward Elimination , 1 = Back Substitution, 2 = Desk Calculator CASE 0 PRINT "Forward Elimination" CASE 1 PRINT "Back Substitution " CASE 2 PRINT "Desk Calculations " CASE ELSE 'PRINT " " END SELECT NEXT I Return '------------------------------------------------------------------------- PrintText1: 'SCREEN 19, 32, 1,0 ' 800x600 SCREEN 21, 16, 1, 0 '1 ' 1280x1024 mode[,16 bit color depth [, one page[, 0 = not fullscreen]]] PRINT " A Simulation of the 'ABC Computer' " PRINT " " PRINT " Based on 'The First Electronic Computer - The Atanasoff Story" PRINT " by Burks & Burks - c 1988 " PRINT " and information from: John Gustafson, CA; Charles Shorb, N.C.; Gary Sleege, Iowa" PRINT PRINT " The Atanasoff version of the Gaussian elimination method " PRINT " To eliminate a Coefficient, " PRINT " a) select the same Coefficient y in two equations Em, En m<>n " PRINT " b) determine the absolute ratio of the two Coefficients y,Em / y,En " PRINT " c) apply ratio to all elements of Em " PRINT " d) subtract (or add) to all elements of (Em times VEm/VEn) - En " PRINT " which leaves the selected Coefficient with a Coefficient of zero." PRINT " " PRINT " A divide operation is complicated, Atanasoff did what might be called a 'microcoded ratio', " PRINT " using the shift as a divide by 2 and forming the 'ratio' on all Coefficients simultaniously" PRINT " ie. when the Coefficient y,En = y,Em, all Coefficients in y,En are already correctly 'ratioed'" PRINT " and the 'Pivot' Coefficient reduced to zero." PRINT PRINT " There were five major phases of processing: " PRINT " 1) Production of binary cards, one per equation, from 1 to 5 decimal (IBM) cards. " PRINT " 2) 'Forward Elimination' to zero the lower left coefficients. " PRINT " 3) 'Reverse Substitution' to zero the upper right coefficients, leaving a non-zero diagonal. " PRINT " 4) Converting the non-zero coefficients and constants to decimal counter on machine, " PRINT " Operator copies each decimal value to paper. " PRINT " 5) Operator uses desk calculator to divide the non-zero coefficients into the constants, yielding A=nn, B=mm, ..." PRINT PRINT " The decimal to binary, and binary to decimal, conversion that the ABC machine possesed is not shown. " PRINT " That is, phases 1) and 4) above are not shown, only implied. " PRINT PRINT " The operator had to choose which two equations to process next, " PRINT " and which coefficient pair to 'pivot' on. " PRINT " The operator had to determine which equation's pivot coefficient had the greater absolute value" PRINT " and place that in the KA Drum for optimal performance, placing the other equation in the CA Drum" PRINT " In this simulation/emulation, the program performs the selections, and reading operations quickly and reliably ." PRINT " At the conclusion of each coefficient elimination, the operator (simulation) punches a binary card from the " PRINT " CA Drum for re-entry in further processing " PRINT " " PRINT " " PRINT " KA> sn.nnnesnnA sn.nnnesnnB sn.nnnesnnC ... = sn.nnnesnn " PRINT " CA> sn.nnnesnnA sn.nnnesnnB sn.nnnesnnC ... = sn.nnnesnn " PRINT " ... " PRINT " sn.nnnesnnA sn.nnnesnnB sn.nnnesnnC ... = sn.nnnesnn " PRINT " " PRINT " " PRINT "" PRINT " click 'any key' or mouse button to return to the simulation. " TextMouseWait: ' wait for mouse buttons up GETMOUSE MouseXCurrent, MouseYCurrent, , MouseButtonsCurrent ' only GETMOUSE !! if MouseButtonsCurrent <> 0 then : GoTo TextMouseWait : END IF TextExitWait: IF INKEY$ <> "" THEN GoTo TextExit : END IF GETMOUSE MouseXCurrent, MouseYCurrent, , MouseButtonsCurrent IF MouseButtonsCurrent <> 0 then : GoTo TextExit : END IF GoTo TextExitWait TextExit: GOTO Start ' WHILE INKEY$ = "": SLEEP (10):WEND 'GOTO Start '-------------------------------------------------------------------- TestSimulationMode: ' is operator changing sim mode? 'locate 2,50 'print using "MouseX = ### ";MouseXCurrent; 'PRINT USING "MouseY = ### ";MouseYCurrent GETMOUSE MouseXCurrent, MouseYCurrent, , MouseButtonsCurrent ' only GETMOUSE !! IF MouseXCurrent < 475 OR MouseXCurrent > 762 Then : GoTo CheckArray : END IF IF MouseYCurrent < 0 OR MouseYCurrent > 10 Then : GoTo CheckArray : END IF locate 3,80 ' print using "MouseButtonsCurrent = ### ";MouseButtonsCurrent; ' print using "StepModeButtonWasUp = ### ";StepModeButtonWasUp; if MouseButtonsCurrent <> 1 then StepModeButtonWasUp =1 Return End IF ' if here button is down IF StepModeButtonWasUp =1 then ' was released , now depressed StepModeButtonWasUp = 0 ' show step ELSE RETURN END IF SELECT CASE AS CONST MouseXCurrent CASE 475 to 514 ' bit RunUntil = 1 StepModeExecute = 1 CASE 514 TO 587 ' RealTime RunUntil = 3 StepModeExecute = 1 RealTimeMode = 1 CASE 587 TO 668 ' FastTime RunUntil = 3 StepModeExecute = 1 RealTimeMode = 0 CASE 668 TO 715 ' exit RunUntil = 8 END CASE 715 TO 762 ' TEXT RunUntil = 9 ' come back in Bit GOTO PrintText1 CASE ELSE END SELECT 'END IF ' MouseYCurrent RETURN CheckArray: IF MouseXCurrent < 791 OR MouseXCurrent > 980 Then RETURN IF MouseYCurrent < 14 OR MouseYCurrent > 59 Then RETURN if MouseButtonsCurrent <> 1 then RETURN SELECT CASE AS CONST MouseYCurrent CASE 14 to 30 ' 3x3 WhichArray = 1 GoTo ReStart CASE 30 TO 46 ' 5x5 WhichArray = 2 GoTo ReStart CASE 46 TO 59 ' 9x9 WhichArray = 3 GoTo ReStart CASE ELSE END SELECT RETURN '-------------------------------------------------------------------- PrintSimulationMode: LOCATE 1,50 ' color white PRINT "Run Until: "; PRINT "Bit, "; PRINT "ABC Time, "; PRINT "FastTime, "; PRINT "Exit, "; PRINT "Text. "; COLOR White CONST InputTextX = 100 CONST InputTextY = 1 LOCATE InputTextY,InputTextX ' row,column PRINT "You may select the following" LOCATE InputTextY+1,InputTextX PRINT "- a 3x3 , integers"; LOCATE InputTextY+2,InputTextX PRINT "- a 5x5 , random "; LOCATE InputTextY+3,InputTextX PRINT "- a 9x9 , random "; 'LOCATE InputTextY+4,InputTextX 'PRINT "- a 9x9 , random "; RETURN PrintWorkingArray: FOR I = 0 to NumVariables-1 ' ??? Coefficients ' equation I IF I = 0 then locate WorkingEquationOffsetY-1,WorkingEquationOffsetX Print " Working Equations, on binary cards, shown here unscaled " END IF locate WorkingEquationOffsetY+I,WorkingEquationOffsetX FOR J = 0 to NumVariables ' print current equations - IF J = NumVariables Then PRINT " = "; SingleFloat = WorkingArrayDbl(I,J) GoSub PrintSingleFloat ELSE SingleFloat = WorkingArrayDbl(I,J) IF SingleFloat = 0 THEN PRINT " 0 "; ELSE GoSub PrintSingleFloat END IF PRINT "x"; PRINT CHR$(ASC("A")+J); PRINT " "; END IF NEXT J NEXT I RETURN MarkDataFlow: 'LOCATE WorkingEquationOffsetY+I,WorkingEquationOffsetX-8 ' print data ' 'PRINT " Operation "; ' IF NextCommand = 1 then ' PRINT "Add " ' ELSEIF NextCommand = 2 then ' PRINT "Sub " ' ELSEIF NextCommand = 3 then ' PRINT "Shft" ' END IF FOR I = 0 to NumVariables-1 ' ??? Coefficients ' equation I LOCATE WorkingEquationOffsetY+I,WorkingEquationOffsetX-9 ' print data movement tags color white IF I = ReferenceEquation THEN Print "REq "; ELSEIF I = WorkingEquation THEN Print "WEq "; ELSE PRINT " "; END IF IF I = PivotCA_Equation THEN ' print CA in GREEN color green Print "CA"; ELSEIF I = PivotKA_Equation THEN ' print KA in RED color red Print "KA"; ELSE PRINT " "; END IF IF I = LastStoreCA THEN ' print move CA to WA in green color green print " >"; ELSE PRINT " "; END IF color white NEXT I RETURN '---------------------------------------------------- Set9Random: NumVariables = 9 GoTo SetRandom Set5Random: NumVariables = 5 SetRandom: FOR I = 0 to NumVariables-1 ' ??? Coefficients ' equation I FOR J = 0 to NumVariables ' ??? Coefficients AccumDbl = 39.0*RND(1)-19.5 If AccumDbl > 0 then AccumDbl += 0.05 ELSE AccumDbl -= 0.05 END IF WorkingArrayDbl(I,J) = AccumDbl NEXT J IF I = 0 then locate WorkingEquationOffsetY-1,WorkingEquationOffsetX Print " Working Equations " END IF NEXT I RETURN '---------------------------------------------------- Set3Page11: NumVariables = 3 FOR I = 0 to NumVariables-1 ' ??? Coefficients ' equation I FOR J = 0 to NumVariables ' ??? Coefficients L = I*(NumVariables+1) + J SELECT CASE L Case 0 AccumDbl = 1 Case 1 AccumDbl = 3 Case 2 AccumDbl = -2 Case 3 AccumDbl = 1 ' Case 4 AccumDbl = 2 Case 5 AccumDbl = 5 Case 6 AccumDbl = -2 Case 7 AccumDbl = 6 ' Case 8 AccumDbl = 4 Case 9 AccumDbl = 13 Case 10 AccumDbl = -9 Case 11 AccumDbl = 3 Case ELSE AccumDbl = -99 END SELECT ' K WorkingArrayDbl(I,J) = AccumDbl NEXT J NEXT I RETURN PrintBlockChar: ' PBlockChar$,PBlockX, PBlockY - in character size units ' PBlockChar$ is zero terminated ASCII String - max string length = 60 to prevent runaways ;-)) ' PBlockX is x location on screen, upper left is 0,0 CONST PBlockSize = 32 DIM PBlockBaseX, PBlockBaseY DIM PBlockASCII_Caps(26,8) ' 26 letters, basic 8x6 array PBlockASCII_Caps(0,0) = 0001000 PBlockASCII_Caps(0,1) = 0010100 PBlockASCII_Caps(0,2) = 0100010 PBlockASCII_Caps(0,3) = 1000001 PBlockASCII_Caps(0,4) = 1111111 PBlockASCII_Caps(0,5) = 1000001 PBlockASCII_Caps(0,6) = 1000001 PBlockASCII_Caps(0,7) = 1000001 DIM PBlockT1,PBlockT2,PBlockT3,PBlockT4,PBlockT5 DIM PBT$ 'holds character being processed. ' PBlockT1 is character counter in string ' PBlockT1 Return