/ BASIC FOR PDP-4/X AND OTHER DEC 18-BIT COMPUTERS / WON'T ACTUALLY WORK ON A REAL PDP-4 / BECAUSE THE PDP-4 CONSOLE DID NOT USE ASCII / SHOULD WORK ON A REAL PDP-7, PDP-9, OR PDP-15 (BANK MODE) / COPYRIGHT (C) 2001 BY DAVID G. CONROY / PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS SOFTWARE AND ITS / DOCUMENTATION FOR ANY PURPOSE AND WITHOUT FEE IS HEREBY GRANTED, PROVIDED / THAT THE ABOVE COPYRIGHT NOTICE APPEARS IN ALL COPIES, THAT BOTH THE / ABOVE COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN SUPPORTING / DOCUMENTATION, AND THAT THE NAME OF DAVID G. CONROY NOT BE USED IN ADVERTISING / OR PUBLICITY PERTAINING TO DISTRIBUTION OF THE SOFTWARE WITHOUT SPECIFIC, / WRITTEN PRIOR PERMISSION. THIS SOFTWARE IS MADE AVAILABLE "AS IS", AND / DAVID G. CONROY DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, WITH REGARD TO / THIS SOFTWARE, INCLUDING WITHOUT LIMITATION ALL IMPLIED WARRANTIES OF / MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, AND IN NO EVENT SHALL / DAVID G. CONROY BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES / OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, / WHETHER IN AN ACTION OF CONTRACT, TORT (INCLUDING NEGLIGENCE) OR STRICT / LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF / THIS SOFTWARE. / 01 DGC 20-MAR-2001 / THE INITIAL VERSION WAS GENERATED BY / STARTING WITH PDP-1/X BASIC 03, AND TRANSLATING IT / INTO A PROGRAM WHICH WOULD RUN ON THE PDP-4/X / MOST OF THIS WAS LINE-BY-LINE, ALTHOUGH THERE WERE SECTONS / WHICH NEEDED A TOTAL UPDATE, LIKE MULTIPLY, DIVIDE, / AND THE CODE WHICH DID SIGNED COMPARES / 02 DGC 08-APR-2001 / THIS IS THE FIRST VERSION WHICH WORKS IN FLOATING / POINT, RATHER THAN IN FIXED POINT / USES MY 18-BIT NO-EAE FLOATING POINT CODE, BUT WILL NEED / TO HAVE THE CALLING SEQUENCES FOR FLDA, FLDO, AND / FSTA CHANGED TO TAKE THE ADDRESS IN AC, RATHER THAN IN THE / NEXT INSTRUCTION WORD, BECAUSE THAT SEEMS TO WORK OUT / BETTER IN ALL CASES / 03 DGC 21-MAY-2001 / ADDED SUPPORT FOR EXTENDED MEMORY. REWROTE THE WAY / THAT THE EXPRESSION READER DEALS WITH FUNCTIONS TO MAKE / THINGS SMALLER AND FASTER. REPLACED THE "ENC" CODE / WITH NEW "PACK" CODE (BASED ON THE CODE WHICH ENCODED BLANKS / WITH THE 400 BIT, WHICH TURNED OUT TO BE A BAD IDEA) / ADDED FIRST VERSION OF SIN(X) AND COS(X). FIXED A BUG IN TAB(X) / AND SPC(X) WHERE T9 WAS GETTING SMASHED BY THE EVALUATION / OF THE ARG, AND THE WRONG NUMBER OF BLANKS WERE SENT. / 04 DGC 28-MAY-2001 / REWORKED THE BASIC FLOATING POINT LOADS, STORES, / MOVES, PUSHES, AND POPS SO THAT THE NAMES WERE CONSISTANT / WITH ONE ANOTHER, AND TO ADD SOME FUNCTIONALITY / ADDED FPOW(X, Y), TAN(X), ATN(X), AND MADE ABS(X) FASTER / CHANGED INITIALIZATION CODE SO THAT IT SITS IN MEMORY WHICH / WILL BE OVERWRITTEN BY SOURCE CODE, AND ADDED CODE WHICH / PRINTS A GREETING AND THE SIZE OF FREE MEMORY / FIXED A TYPO WHICH CAUSED "PRINT 0.9+0.1" TO OUTPUT / "+0.:00000" (THE CODE WHICH WATCHED FOR OVERFLOW / DURING DECIMAL ROUNDING NOTICED THAT OVERFLOW HAD HAPPENED, / BUT IT BOTCHED THE DIVIDE BY 10.0 WHICH FIXES THINGS) / 05 DGC 02-JUN-2001 / ADDED FIRST VERSIONS OF EXP(X) AND LN(X) / SINCE EXP(X) NEEDS TO COMPUTE INTEGER POWERS, FPOW WAS SPLIT / INTO TWO SECTIONS, ONE OF WHICH ACTUALLY COMPUTES THE / INTEGER POWERS, AND THE OTHER WHICH LOOKS AT THE ARGUMENTS / AND SELECTS BETWEEM THE EXP/LOG ALGORITHM AND USING THE ROUTINE / WHICH COMPUTES INTEGER POWERS. / 06 DGC 24-JUN-2001 / ADDED A KRB AND A TLS OF A NUL CHARACTER AT THE START / SO THAT BASIC WILL RUN ON A REAL MACHINE (OR BOB SUPNIK'S EMULATOR) / WHICH DOES NOT HAVE A PANEL PROGRAM TO INITIALIZE THE FLAGS / NOTE THAT WHEN YOU RUN BASIC UNDER BOB'S EMULATOR YOU NEED TO MAKE / THE CONSOLE INTERFACE FULL DUPLEX (SET TTI FDX) OR EVERYTHING / YOU TYPE WILL BE ECHOED TWICE; WAS THE CONSOLE INTERFACE ON THE PDP-9 / AND PDP-15 REALLY HALF DUPLEX ? / ADD CONDITIONALS TO MAKE IT EASY TO BUILD A VERSION / HONORING THE OPERATE RESTRICTIONS ON A REAL DEC 18-BIT MACHINE / THESE COMMENTS DESCRIBE THE MAJOR DATA / STRUCTURES; IT WOULD BE NICE IF THESE THINGS COULD BE / SYMBOLIC, BUT A LOT OF CODE KNOWS WHAT FIELD / IS NEXT TO WHAT OTHER FIELD (THE PDP-4 HAS AUTOINCREMENT BUT / NO INDEX REGISTERS) SO IT'S HARD TO DO / AT THE VERY LEAST I SHOULD ADD AN ASSEMBLY DIRECTIVE TO / PAL-18/X WHICH DOES WHAT THE "ASSUME" MACRO IN THE / RSX-11/M SOURCES DOES, AND PUT THEM IN THE CODE AT ALL THE / PLACES WHERE ADJACENCY ASSUMPTIONS ARE MADE / LINE / 0 LEN / 1 LNO / 2 ... DATA / SIMPLE VAR / 0 LEN / 1 NAME ([17:16]=00, [15:14]=XX, [13:7]=CH1, [6:0]=CH0) / 2 ... DATA (2 WORDS) / DEFINED FUNCTION / 0 LEN / 1 NAME ([17:16]=01, [15:14]=XX, [13:7]=CH1, [6:0]=CH0) / 2 ADDR OF FORMAL PARAMETER / 3 LP / 4 CP / 5 C / SINGLE DIM ARRAY VAR / O LEN / 1 NAME ([17:16]=10, [15:14]=XX, [13:7]=CH1, [6:0]=CH0) / 2 ARRAY BOUND 1 / 3 ... DATA (2 WORDS PER ELEMENT) / DOUBLE DIM ARRAY VAR / 0 LEN / 1 NAME ([17:16]=11, [15:14]=XX, [13:7]=CH1, [6:0]=CH0) / 2 ARRAY BOUND 2 / 3 ARRAY BOUND 1 / 4 ... DATA (2 WORDS PER ELEMENT) / GSTK / 0 LP / 1 CP / 2 C / FSTK / 0 VAR / 1,2 LIMIT / 3,4 STEP / 5 LP / 6 CP / 7 C NSTK=100 / SIZES NGSTK=10 NCMDB=50 NGETB=40 GETBM=NGETB-1 NFSTK=10 TMEM=100000 / 32K RNDX=1 / DEFAULT SEED LOC 00000 JMP BMEM / HLT ON INTERRUPT; 00000 IS ALSO HLT / THE START LOCATION LOC 00010 X0, BSS 1 / AUTO INDEX LOCATIONS X1, BSS 1 / ALL OF THEM ARE USED IN A X2, BSS 1 / VERY TEMPORARY WAY X3, BSS 1 X4, BSS 1 X5, BSS 1 X6, BSS 1 X7, BSS 1 LOC 00020 0 / HLT IF A CAL HLT / INSTRUCTION HAPPENS / ERROR HANDLING / JUMP TO ERR WITH ERROR CODE IN AC / TYPE OUT ?XX, THEN LINE NUMBER IF NOT DIRECT MODE / FORCE DIRECT MODE, CLEAR PUSH/POP STACK ERRCC, LAC (103103 / ?CC CONTROL-C JMP ERR ERRLN, LAC (116114 / ?LN LINE NUMBER ERROR JMP ERR ERRMF, LAC (106115 / ?MF MEMORY FULL JMP ERR ERRSN, LAC (116123 / ?SN SYNTAX ERROR JMP ERR ERRNN, LAC (116116 / ?NN OPERATION NOT LEGAL NOW JMP ERR ERRPD, LAC (104120 / ?PD PUSHDOWN STACK ERROR JMP ERR ERRSS, LAC (123123 / ?SS STOP JMP ERR ERRZD, LAC (104132 / ?ZD DIVIDE BY ZERO JMP ERR ERRSR, LAC (122123 / ?SR SUBSCRIPT OUT OF RANGE JMP ERR ERRNY, LAC (131116 / ?NY CODE NOT YET WRITTEN JMP ERR ERRIR, LAC (122111 / ?IR INSUFFICIENT DATA FOR READ JMP ERR ERROV, LAC (126117 / ?OV EXPONENT OVERFLOW OR UNDERFLOW JMP ERR ERRDO, LAC (117104 / ?DO FUNCTION DOMAIN ERROR ERR, DAC T9 LAC COL / GET BACK TO LEFT MARGIN SNA / IF NOT THERE JMP ERR1 LAW LAW+15 JMS PUTC LAW LAW+12 JMS PUTC ERR1, LAW LAW+77 / "?" JMS PUTC LAC T9 AND (777 JMS PUTC LAC T9 RTR RTR RTR RTR RAR AND (777 JMS PUTC LAC LP / IF THERE IS A CURRENT SNA / LINE PRINT OUT ITS LINE NUMBER JMP ERR2 LAW LAW+40 JMS PUTC ISZ LP LAC I LP JMS PUTLNO DZM LP ERR2, LAW LAW+15 JMS PUTC LAW LAW+12 JMS PUTC JMS CSTK / COMMAND PROCESSOR / READ AND PACK COMMAND LINE / IF LNO, ADD LINE TO THE SAVED PROGRAM, DELETING / ANY OLD VERSION OF THE LINE / IF NO LNO, POINT THE EXECUTION MACHINERY AT / THE DIRECT LINE AND START IT UP CMD, LAC COL / GET BACK TO LEFT MARGIN SNA / IF NOT THERE JMP CMD0 LAW LAW+15 JMS PUTC LAW LAW+12 JMS PUTC CMD0, LAW LAW+76 / READ A COMMAND JMS PUTC LAW LAW+40 JMS PUTC LAC (CMDB JMS GETS JMS PACK / GET LINE NUMBER, PACK TEXT LAC LNO SNA JMP EXE / NO LINE NUMBER, EXECUTE IN DIRECT MODE SPA / MUST BE BETWEEN 1 AND 9999 JMP ERRLN TAD (-23420 / -10000 SMA JMP ERRLN LAC (BMEM CMD1, DAC T9 / LOOK FOR LINE SAD TTXT JMP CMD5 TAD (1 DAC T0 LAC LNO CMA TAD (1 TAD I T0 SNA JMP CMD2 SMA JMP CMD5 LAC T9 ADD I T9 JMP CMD1 CMD2, LAC T9 / DELETE LINE IF FOUND DAC T0 TAD I T9 DAC T1 CMD3, SAD TTXT JMP CMD4 LAC I T1 DAC I T0 ISZ T0 ISZ T1 LAC T1 JMP CMD3 CMD4, LAC T0 / RESET TOP OF TEXT DAC TTXT / WHICH CAUSES ALL VARIABLES TO BE LOST JMS CLR CMD5, LAC LLEN / IF THE LINE IS AN EMPTY SAD (1 / LINE DON'T ADD IT TO THE TEXT JMP CMD TAD (1 CLL RAR DAC LLEN LAC TTXT DAC T0 TAD LLEN TAD (2 DAC T1 TAD (-TMEM / CHECK IF ROOM SMA SZA JMP ERRMF / NO LAC T1 / RESET TOP OF TEXT DAC TTXT / WHICH CAUSES ALL VARIABLES TO BE LOST JMS CLR CMD6, LAC T0 / OPEN UP HOLE FOR THE SAD T9 / NEW LINE'S HEADER AND TEXT JMP CMD7 TAD (-1 DAC T0 LAC T1 TAD (-1 DAC T1 LAC I T0 DAC I T1 JMP CMD6 CMD7, LAC (2 / BUILD LINE HEADER TAD LLEN DAC I T9 ISZ T9 LAC LNO DAC I T9 LAC (CMDB-1 / COPY IN THE TEXT OF DAC T0 / THE NEW LINE LAC LLEN CMA TAD (1 DAC T1 CMD8, ISZ T0 ISZ T9 LAC I T0 DAC I T9 ISZ T1 JMP CMD8 JMP CMD / EXE JUMPED TO BY CMD TO EXECUTE DIRECT LINE / EXE1 JUMPED TO BY THINGS LIKE GOTO / EXE2 JUMPED TO BY IF ON TRUE CONDITION AND NOT A GOTO / EXE3 JUMPED TO BY END OF STANDARD COMMANDS / EXE4 JUMPED TO TO SKIP REST OF LINE / THERE ARE TWO COMMAND DISPATCH TABLES / THE TABLE AT EXE5 IS USED IN RUN MODE (LP NON-ZERO) / THE TABLE AT EXE6 IS USED IN EDITING MODE (LP ZERO) / THE TABLES ARE ONLY USED WHEN A STATEMENT / BEGINS WITH A TOKEN CODE, BUT THAT'S OK, BECAUSE IF IT / DOESN'T BEGIN WITH A TOKEN CODE THEN THE STATEMENT / IS AN (IMPLIED) LET, AND LET STATEMENTS ARE ALLOWED IN / BOTH RUN MODE AND EDITING MODE EXE, LAC (CMDB / RESET CP CLL RAL DAC CP JMS ADVNB / GRAB FIRST TOKEN AND SAD (15 / DUCK OUT FAST IF IT'S A BLANK LINE JMP CMD JMP EXE2 EXE1, DAC LP TAD (2 CLL RAL DAC CP EXE1A, JMS GETCC JMS ADVNB EXE2, TAD (-200 / TOKEN ? SPA JMP LET / NO, ASSUME LET STMT TAD (EXE5 DAC T9 JMS ADVNB LAC LP SZA JMP I T9 LAC T9 TAD (EXE6-EXE5 DAC T9 JMP I T9 EXE3, LAC C SAD (72 / ":" JMP EXE1A SAD (15 SKP JMP ERRSN EXE4, LAC LP SNA JMP CMD TAD I LP SAD TTXT SKP JMP EXE1 DZM LP JMP CMD EXE5, JMP DATA / 200 DATA JMP DEF / 201 DEF JMP ERRNN / 202 DELETE JMP DIM / 203 DIM JMP END / 204 END JMP FOR / 205 FOR JMP GOSUB / 206 GOSUB JMP GOTO / 207 GOTO JMP IF / 210 IF JMP INPUT / 211 INPUT JMP LET / 212 LET JMP ERRNN / 213 LIST JMP ERRNN / 214 NEW JMP NXT / 215 NEXT JMP PRINT / 216 PRINT JMP READ / 217 READ JMP REM / 220 REM JMP RSTOR / 221 RESTORE JMP RTRN / 222 RETURN JMP ERRNN / 223 RUN JMP ERRSN / 224 STEP JMP STOP / 225 STOP JMP ERRSN / 226 THEN JMP ERRSN / 227 TO JMP ERRSN / 230 >= JMP ERRSN / 231 <= JMP ERRSN / 232 <> JMP RNDMZ / 233 RANDOMIZE JMP ERRSN / 234 AND JMP ERRSN / 235 OR JMP ERRSN / 236 NOT JMP ERRSN / 237 FN JMP ERRSN / 240 TAB JMP ERRSN / 241 SPC JMP ERRSN / 242 SGN JMP ERRSN / 243 RND JMP ERRSN / 244 SQR JMP ERRSN / 245 ABS JMP ERRSN / 246 INT JMP ERRSN / 247 SIN JMP ERRSN / 250 COS JMP ERRSN / 251 ATN JMP ERRSN / 252 LOG JMP ERRSN / 253 EXP JMP ERRSN / 254 TAN EXE6, JMP ERRNN / 200 DATA JMP ERRNN / 201 DEF JMP DEL / 202 DELETE JMP ERRNN / 203 DIM JMP ERRNN / 204 END JMP ERRNN / 205 FOR JMP ERRNN / 206 GOSUB JMP ERRNN / 207 GOTO JMP ERRNN / 210 IF JMP ERRNN / 211 INPUT JMP LET / 212 LET JMP LIST / 213 LIST JMP NEW / 214 NEW JMP ERRNN / 215 NEXT JMP PRINT / 216 PRINT JMP ERRNN / 217 READ JMP ERRNN / 220 REM JMP ERRNN / 221 RESTORE JMP ERRNN / 222 RETURN JMP RUN / 223 RUN JMP ERRSN / 224 STEP JMP ERRNN / 225 STOP JMP ERRSN / 226 THEN JMP ERRSN / 227 TO JMP ERRSN / 230 >= JMP ERRSN / 231 <= JMP ERRSN / 232 <> JMP ERRNN / 233 RANDOMIZE JMP ERRSN / 234 AND JMP ERRSN / 235 OR JMP ERRSN / 236 NOT JMP ERRSN / 237 FN JMP ERRSN / 240 TAB JMP ERRSN / 241 SPC JMP ERRSN / 242 SGN JMP ERRSN / 243 RND JMP ERRSN / 244 SQR JMP ERRSN / 245 ABS JMP ERRSN / 246 INT JMP ERRSN / 247 SIN JMP ERRSN / 250 COS JMP ERRSN / 251 ATN JMP ERRSN / 252 LOG JMP ERRSN / 253 EXP JMP ERRSN / 254 TAN / DATA DATA=EXE4 / DEF DEF, LAC C / MUST BE FN SAD (TFN SKP JMP ERRSN JMS ADVNB LAC (1 / FOLLOWED BY JMS GETNAM / AN UNDEFINED SYMBOL JMS FNDSYM JMP ERRNN LAC SYM DAC T9 LAC C / FOLLOWED BY "(" NAME ")" SAD (40 JMS ADVNB SAD (50 / "(" SKP JMP ERRSN JMS ADVNB CLA JMS GETNAM JMS FNDSYM JMP DEF1 JMS ADDSYM DEF1, LAC C SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB SAD (40 / THEN BY "=" BODY JMS ADVNB SAD (75 / "=" SKP JMP ERRSN JMS ADVNB LAC TVAR / A DEFINED FUNCTION SYMBOL TAD (6-TMEM / IS 6 WORDS LONG SMA SZA JMP ERRMF LAC (6 / BUILD A SYMBOL TABLE DAC I TVAR / ENTRY FOR THE DEFINED FUNCTION ISZ TVAR LAC T9 DAC I TVAR ISZ TVAR LAC VAR / DATA WORD FOR A SIMPLE TAD (2 / VARIABLE IS 2 WORDS INTO THE DAC I TVAR / SYMBOL TABLE ENTRY ISZ TVAR LAC LP / LP, CP, AND C DESCRIBE DAC I TVAR / A PLACE IN THE SOURCE TEXT WHICH ISZ TVAR / WE SIMPLY ASSUME IS THE LAC CP / START OF A LEGIT FUNCTION BODY DAC I TVAR / ENDING AT ":" OR CR ISZ TVAR LAC C DAC I TVAR ISZ TVAR DEF2, LAC C SAD (72 / ":" JMP EXE3 SAD (15 JMP EXE3 JMS ADV JMP DEF2 / DELETE DEL, JMS GETLNO / GET LINE NUMBER LAC LNO SNA JMP ERRSN / SYNTAX ERROR IF NOT THERE DAC T9 / USE FOR BOTH LIMITS DAC T8 LAC C SAD (40 JMS ADVNB SAD (54 / "," SKP JMP DEL1 JMS ADVNB JMS GETLNO / GET SECOND LINE NUMBER LAC LNO SNA JMP ERRSN / SYNTAX ERROR IF NOT THERE DAC T8 CMA TAD (1 TAD T9 SMA SZA JMP ERRLN / HI < LO DEL1, LAC (BMEM DEL2, DAC T7 SAD TTXT JMP DEL8 DAC T0 ISZ T0 LAC I T0 CMA TAD (1 TAD T9 SPA SNA JMP DEL3 LAC T7 TAD I T7 JMP DEL2 DEL3, LAC T7 TAD I T7 DEL4, DAC T6 SAD TTXT JMP DEL5 DAC T0 ISZ T0 LAC I T0 CMA TAD (1 TAD T8 SPA JMP DEL5 LAC T6 TAD I T6 JMP DEL4 DEL5, LAC TTXT CMA TAD (1 TAD T6 SNA JMP DEL7 DAC T0 DEL6, LAC I T6 DAC I T7 ISZ T6 ISZ T7 ISZ T0 JMP DEL6 DEL7, LAC T7 DAC TTXT DEL8, JMS CLR JMP EXE3 / DIM DIM, JMS GETSYM / NEED AN ARRAY SYMBOL LAC SYM SMA JMP ERRSN JMS FNDSYM / WHICH HASN'T BEEN DEFINED YET JMP ERRNN LAC SYMSUB+0 / SUBSCRIPTS START AT TAD (1 / 0 AND END AT THE SPECIFIED BOUND, SO DAC SYMSIZ+0 / THE SIZE IS 1 ITEM BIGGER LAC SYMSUB+1 TAD (1 DAC SYMSIZ+1 JMS ADDSYM LAC C / KEEP GOING AS LONG AS IT SAD (40 / LOOKS LIKE A COMMA SEPARATED LIST JMS ADVNB SAD (54 / "," SKP JMP EXE3 JMS ADVNB JMP DIM / END END, LAC C / CHECK FOR END OF LINE SAD (15 SKP JMP ERRSN DZM LP / FORCE IMMEDIATE MODE AND GO BACK JMP CMD / TO THE COMMAND HANDLER / FOR FOR, CLA / VARIABLE JMS GETNAM JMS FNDSYM JMP FOR1 JMS ADDSYM FOR1, LAC VAR / FIX VAR SO IT POINTS TAD (2 / AT THE DATA WORD OF THE VARIABLE DAC VAR / 2 WORDS IN LAC FSTKP FOR2, SAD (FSTK / LOOK THROUGH THE JMP FOR4 / FOR STACK FOR AN ENTRY WHICH TAD (-10 / USES THE SAME VARIABLE, AND IF IT IS FOUND, DAC T0 / DELETE THAT ENTRY AND ANY LAC I T0 / ENTRIES WHICH LIE ABOVE IT ON THE STACK SAD VAR JMP FOR3 LAC T0 JMP FOR2 FOR3, LAC T0 DAC FSTKP FOR4, LAC FSTKP SAD (FSTK+[10*NFSTK] JMP ERRPD LAC VAR / MAKE NEW FOR STACK ENTRY DAC I FSTKP LAC C SAD (40 JMS ADVNB SAD (75 / "=" SKP JMP ERRSN JMS ADV JMS GETFAC LAC I FSTKP / SET VAR TO INITIAL VALUE JMS FSTA ISZ FSTKP LAC C SAD (40 JMS ADVNB SAD (TTO SKP JMP ERRSN JMS ADV JMS GETFAC LAC FSTKP / SET LOOP LIMIT JMS FSTA ISZ FSTKP ISZ FSTKP LAC FSTKP / SET DEFAULT STEP (1.0) DAC T0 LAC F1+0 DAC I T0 ISZ T0 LAC F1+1 DAC I T0 LAC C SAD (40 JMS ADVNB SAD (TSTEP SKP JMP FOR5 JMS ADV JMS GETFAC LAC FSTKP / SET ACTUAL STEP JMS FSTA FOR5, ISZ FSTKP ISZ FSTKP LAC LP / COPY THE INTERPRETER'S DAC I FSTKP / WORKING POINTERS ISZ FSTKP / INTO THE FOR ENTRY; THIS IS WHERE LAC CP / A NEXT GOES TO RUN ANOTHER DAC I FSTKP / ITERATION OF THE LOOP ISZ FSTKP LAC C DAC I FSTKP ISZ FSTKP JMP NXT4 / GOSUB, GOTO GOSUB, JMS GETLNO LAC C SAD (40 JMS ADVNB LAC GSTKP SAD (GSTK+[3*NGSTK] JMP ERRPD LAC LP DAC I GSTKP ISZ GSTKP LAC CP DAC I GSTKP ISZ GSTKP LAC C DAC I GSTKP ISZ GSTKP JMP GO1 GOTO, JMS GETLNO LAC C SAD (40 JMS ADVNB GO1, LAC (BMEM GO2, DAC T0 SAD TTXT JMP ERRLN TAD (1 DAC T1 LAC I T1 SAD LNO JMP GO3 LAC T0 TAD I T0 JMP GO2 GO3, LAC T0 JMP EXE1 / IF IF, JMS GETFAC JMS FTST / COMPARE TO 0.0 SNA JMP EXE4 / IF EQ, IF TEST FAILS LAC C SAD (40 JMS ADVNB LAC C SAD (TGOTO SKP JMP IF1 JMS ADVNB JMP GOTO IF1, SAD (TTHEN SKP JMP ERRSN JMS ADVNB LAC C TAD (-60 SPA JMP IF2 TAD (-12 SPA JMP GOTO IF2, LAC C JMP EXE2 / INPUT INPUT, LAC (15 DAC IC INPUT1, JMS GETVAR LAC IC INPUT2, SAD (15 / THIS CODE LOOKS LIKE JMP INPUT6 / IT COULD BE UNTWISTED AND WORK SAD (40 / BETTER WITH ONLY SAD SKP / SINCE THIS SKP IS A SAD+SKP = SAS JMP INPUT4 INPUT3, JMS IADV JMP INPUT2 INPUT4, LAC (IC DAC GCP LAC (IADV DAC GADVP JMS FGET / READ FLOATING JMP INPUT5 / NO DATA LAC IC SAD (54 / "," JMS IADV LAC VAR / SET VARIABLE TO THE JMS FSTA / TO VALUE READ FROM THE INPUT LAC C SAD (40 JMS ADVNB SAD (54 / "," SKP JMP EXE3 JMS ADV JMP INPUT1 INPUT5, LAW LAW+77 JMS PUTC LAW LAW+111 JMS PUTC LAW LAW+111 JMS PUTC LAW LAW+15 JMS PUTC LAW LAW+12 JMS PUTC INPUT6, LAW LAW+77 JMS PUTC LAW LAW+40 JMS PUTC LAC (CMDB JMS GETS LAC (CMDB CLL RAL DAC ICP JMP INPUT3 IADV, 0 LAC ICP CLL RAR DAC T0 ISZ ICP LAC I T0 SNL JMP IADV1 RTR RTR RTR RTR RAR IADV1, AND (777 DAC IC JMP I IADV / LET LET, JMS GETVAR LAC VAR JMS PSHA LAC C SAD (40 JMS ADVNB SAD (75 / "=" SKP JMP ERRSN JMS ADVNB JMS GETFAC JMS POPA JMS FSTA JMP EXE3 / LIST LIST, DZM T6 / T6 IS LO LIMIT, DEFAULT 0 LAC (23420 DAC T7 / T7 IS HI LIMIT, DEFAULT 10000 JMS GETLNO LAC LNO SNA JMP LIST1 DAC T6 / IF THERE IS A LINE NUMBER DAC T7 / USE IT FOR BOTH LIMITS LAC C SAD (40 JMS ADVNB SAD (54 / "," SKP JMP LIST1 JMS ADVNB JMS GETLNO LAC LNO / BETTER BE ONE SNA JMP ERRSN DAC T7 / USE IT FOR THE HI LIMIT CMA / NUMBER, USE IT FOR THE HI LIMIT, AND TAD (1 TAD T6 SMA SZA JMP ERRLN / HI < LO LIST1, LAC (BMEM LIST2, DAC T9 / T9 IS LINE SAD TTXT JMP EXE3 DAC T8 / T8 IS WORKING LINE ISZ T8 / T8 NOW POINTS AT THE LINE'S NUMBER LAC T6 / MUST BE >= LO CMA TAD (1 TAD I T8 SPA JMP LIST5 LAC I T8 / AND <= HI CMA TAD (1 TAD T7 SPA JMP LIST5 LAC I T8 / PRINT LINE NUMBER JMS PUTLNO LAW LAW+40 / AND A SPACE JMS PUTC LIST3, ISZ T8 / PRINT THE TEXT LAC I T8 AND (777 SAD (15 JMP LIST4 JMS LISTC LAC I T8 RTR RTR RTR RTR RAR AND (777 SAD (15 JMP LIST4 JMS LISTC JMP LIST3 LIST4, JMS PUTC / END OF LINE, PRINT CR THEN LF LAW LAW+12 JMS PUTC LIST5, LAC T9 / ADVANCE T9 TO POINT TAD I T9 / TO THE START OF THE NEXT LINE JMP LIST2 LISTC, 0 DAC T0 LAC (KTAB-1 DAC T1 LAC T0 TAD (-200 SPA JMP LISTC3 SNA JMP LISTC2 CMA TAD (1 DAC T2 LISTC1, ISZ T1 LAC I T1 SZA JMP LISTC1 ISZ T2 JMP LISTC1 LISTC2, ISZ T1 LAC I T1 SNA JMP LISTC4 JMS PUTC JMP LISTC2 LISTC3, LAC T0 JMS PUTC LISTC4, JMP I LISTC / NEW NEW, LAC C / CHECK FOR END OF LINE SAD (15 SKP JMP ERRSN LAC (BMEM / DELETE SOURCE DAC TTXT JMS CLR / DELETE VARIABLES JMP CMD / NEXT NXT, CLA / GET VARIABLE JMS GETNAM JMS FNDSYM JMP NXT1 JMS ADDSYM NXT1, LAC VAR / POINT VAR AT THE DATA ITEM TAD (2 / WHICH IS 2 WORDS INTO DAC VAR / THE SYMBOL LAC FSTKP NXT2, SAD (FSTK / LOOK FOR A MATCHING ENTRY JMP ERRPD / ON THE FOR STACK TAD (-10 / GIVE ERROR IF ENTRY NOT FOUND DAC T0 LAC I T0 SAD VAR JMP NXT3 LAC T0 DAC FSTKP JMP NXT2 NXT3, LAW 3-10 / STEP TAD FSTKP JMS FLDO / VAR = VAR + STEP LAC VAR JMS FLDA JMS FADD LAC VAR JMS FSTA NXT4, LAW 1-10 / LIMIT TAD FSTKP JMS FLDO / LOAD LIMIT INTO FOP LAW 3-10 / STEP TAD FSTKP JMS FLDA / I COULD CHEAT A LITTLE AND JMS FTST / JUST LOOK AT THE SIGN BIT OF THE SPA / FIRST WORD, I SUPPOSE JMP NXT6 LAC VAR / STEP>0, LOOP IF VAR<=LIMIT JMS FLDA JMS FCMP SMA SZA JMP EXE3 / NO LOOP JMP NXT8 / LOOP NXT6, LAC VAR / STEP<0, LOOP IF VAR>=LIMIT JMS FLDA JMS FCMP SPA JMP EXE3 / NO LOOP NXT8, LAW 5-10 / POINTERS TAD FSTKP DAC T0 LAC I T0 / RESET THE POINTERS TO DAC LP / MAKE CONTROL RESUME RIGHT AFTER ISZ T0 / TO FOR OF THE LOOP LAC I T0 DAC CP ISZ T0 LAC I T0 DAC C JMP EXE3 / PRINT PRINT, LAC C SAD (72 / ":" JMP PR8 SAD (15 JMP PR8 PR1, SAD (42 / """ SKP JMP PR4 PR2, JMS ADV SAD (42 / """ JMP PR3 SAD (15 JMP ERRSN JMS PUTC JMP PR2 PR3, JMS ADVNB JMP PR5 PR4, SAD (TTAB / TAB(X) SKP JMP PR4A LAC COL JMP PR4B PR4A, SAD (TSPC / SPC(X) SKP JMP PR4E CLA PR4B, JMS PSHA / SAVE COL (TAB) OR 0 (SPC) JMS ADVNB SAD (50 / "(" SKP JMP ERRSN JMS ADVNB JMS GETFAC LAC C SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB JMS POPA / THIS COMPUTES NEG(VAL-COL) FOR TAB(X) DAC T9 / AND NEG(VAL) FOR SPC(X) JMS FFIX CMA TAD (1 TAD T9 SNA JMP PR5 SPA JMP PR4C LAW LAW+15 / IF X" JMP GETV3 SAD (74 / "<" JMP GETV4 SAD (TLE / "<=" JMP GETV5 SAD (TGE / ">=" JMP GETV6 SAD (76 / ">" JMP GETV7 JMP GETV90 GETV2, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SNA JMP GETV9 / 1.0 JMP GETV8 / 0.0 GETV3, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SZA JMP GETV9 / 1.0 JMP GETV8 / 0.0 GETV4, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SPA JMP GETV9 / 1.0 JMP GETV8 / 0.0 GETV5, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SPA SNA JMP GETV9 / 1.0 JMP GETV8 / 0.0 GETV6, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SMA JMP GETV9 / 1.0 JMP GETV8 / 0.0 GETV7, JMS ADVNB JMS FPSHA JMS GETV10 JMS FMOVO JMS FPOPA JMS FCMP SMA SZA JMP GETV9 / 1.0 GETV8, LAC (F0 / 0.0 JMP GETV9A GETV9, LAC (F1 GETV9A, JMS FLDA JMP GETV1 GETV10, 0 LAC GETV10 JMS PSHA JMS GETV20 GETV11, LAC C SAD (40 JMS ADVNB SAD (53 / "+" JMP GETV12 SAD (55 / "-" JMP GETV13 JMP GETV90 GETV12, JMS ADVNB JMS FPSHA JMS GETV20 JMS FMOVO JMS FPOPA JMS FADD JMP GETV11 GETV13, JMS ADVNB JMS FPSHA JMS GETV20 JMS FMOVO JMS FPOPA JMS FSUB JMP GETV11 GETV20, 0 LAC GETV20 JMS PSHA JMS GETV30 GETV21, LAC C SAD (40 JMS ADVNB SAD (52 / "*" JMP GETV22 SAD (57 / "/" JMP GETV23 JMP GETV90 GETV22, JMS ADVNB JMS FPSHA JMS GETV30 JMS FMOVO JMS FPOPA JMS FMUL JMP GETV21 GETV23, JMS ADVNB JMS FPSHA JMS GETV30 JMS FMOVO JMS FPOPA JMS FDIV JMP GETV21 GETV30, 0 LAC GETV30 JMS PSHA JMS GETV40 GETV31, LAC C SAD (40 JMS ADVNB SAD (136 / "^" JMP GETV32 JMP GETV90 GETV32, JMS ADVNB JMS FPSHA JMS GETV40 JMS FMOVO JMS FPOPA JMS FPOW JMP GETV31 GETV40, 0 LAC GETV40 JMS PSHA LAC C SAD (40 JMS ADVNB SAD (50 / "(" JMP GETV42 SAD (53 / "+" (UNARY) JMP GETV43 SAD (55 / "-" (UNARY) JMP GETV44 SAD (TNOT / NOT JMP GETV49 SAD (TFN / FN JMP GETV52 TAD (-TSGN / BUILT IN FUNCTIONS ALL HAVE SMA / TOKEN CODES >= TSGN JMP GETV45 LAC (C / FLOATING POINT NUMBER ? DAC GCP LAC (ADV DAC GADVP JMS FGET JMP GETV41 / NO JMP GETV90 / YES GETV41, JMS GETVAR / LAST CHANCE, READ AND LAC VAR / EXTRACT THE VALUE OF A VARIABLE JMS FLDA JMP GETV90 GETV42, JMS ADVNB / "(" E ")" JMS GETFAC LAC C SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB JMP GETV90 GETV43, JMS ADVNB / "+" E JMS GETV40 JMP GETV90 GETV44, JMS ADVNB / "-" E JMS GETV40 JMS FNEG JMP GETV90 GETV45, JMS PSHA / SAVE FUNCTION INDEX JMS ADVNB SAD (50 / "(" SKP JMP ERRSN JMS ADVNB JMS GETFAC LAC C / " " SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB JMS POPA / RESTORE FUNCTION INDEX TAD (GETV46 / GET ADDRESS OF THE FUNCTION'S CODE DAC T0 LAC I T0 DAC T0 / CALL THE FUNCTION JMS I T0 JMP GETV90 GETV46, FSGN / MUST BE IN THE SAME ORDER AS THE TOKENS FRND FSQR FABS FINT FSIN FCOS FATN FLN FEXP FTAN GETV49, JMS ADVNB / "NOT" E JMS GETV40 JMS FTST SZA JMP GETV50 LAC (F1 JMP GETV51 GETV50, LAC (F0 GETV51, JMS FLDA JMP GETV90 GETV52, JMS ADVNB / "FN" N "(" E ")" LAC (1 JMS GETNAM JMS FNDSYM SKP JMP ERRNN / CALL OF UNDEFINED FUNCTION LAC VAR / ADR OF VAR JMS PSHA LAC C SAD (40 JMS ADVNB SAD (50 / "(" SKP JMP ERRSN JMS ADVNB JMS GETFAC / READ THE ARG LAC C SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB JMS POPA / AC IS ADR OF VAR TAD (2 / AC IS ADR OF ADR OF DATA OF FORMAL DAC T1 LAC I T1 / AC IS ADR OF DATA OF FORMAL DAC T0 LAC I T0 / SAVE DATA+0 JMS PSHA ISZ T0 LAC I T0 / SAVE DATA+1 JMS PSHA LAC T0 / SAVE ADR OF DATA+1 OF FORMAL JMS PSHA LAC I T1 / AC IS ADR OF DATA OF FORMAL JMS FSTA / ARG TO DATA OF FORMAL ISZ T1 LAC LP / SAVE LP, CP, C ON THE JMS PSHA / STACK, AND RESET THEM TO THE VALUES LAC I T1 / IN THE SYMBOL TABLE DAC LP ISZ T1 LAC CP JMS PSHA LAC I T1 DAC CP ISZ T1 LAC C JMS PSHA LAC I T1 DAC C JMS GETFAC / EVALUATE FUNCTION BODY EXPRESSION LAC C SAD (40 JMS ADVNB SAD (72 / ":" SKP SAD (15 / END OF LINE SKP JMP ERRSN JMS POPA / RESTORE C, CP, LP DAC C JMS POPA DAC CP JMS POPA DAC LP JMS POPA / ADR OF DATA+1 OF FORMAL DAC T0 JMS POPA / RESTORE DATA+1 DAC I T0 LAW -1 / ADR OF DATA+0 OF FORMAL TAD T0 DAC T0 JMS POPA / RESTORE DATA+0 DAC I T0 JMP GETV90 GETV90, JMS POPA / JUMP TO HERE TO DAC T0 / POPJ BACK TO THE CALLER JMP I T0 / READ VARIABLE, POSSIBLY SUBSCRIPTED / THE ADDRESS OF THE CELL HOLDING / THE VARIABLE'S DATA IS RETURNED IN THE / GLOBAL VARIABLE "VAR" / FOR 1 DIMENSION ARRAY, BASE + SUB1 / FOR 2 DIMENSION ARRAY, BASE + SIZ1*SUB2 + SUB1 / IN THE SYM, SIZ2 IS BEFORE SIZ1 / THIS IS A LITTLE ODD, BUT IT IMPROVES THE CODE GETVAR, 0 LAC GETVAR JMS PSHA JMS GETSYM JMS FNDSYM JMP GETVR1 LAC (13 DAC SYMSIZ+0 DAC SYMSIZ+1 JMS ADDSYM GETVR1, ISZ VAR / STEP OVER LENGTH ISZ VAR / STEP OVER NAME LAC SYM SMA JMP GETVR4 RAL SMA JMP GETVR2 LAC SYMSUB+1 / BOUND CHECK SPA / FOR THE SECOND SUBSCRIPT JMP ERRSR CMA TAD (1 TAD I VAR SPA SNA JMP ERRSR ISZ VAR / STEP OVER SECOND SUBSCRIPT GETVR2, LAC SYMSUB+0 / BOUND CHECK SPA / FOR THE FIRST SUBSCRIPT JMP ERRSR CMA TAD (1 TAD I VAR SPA SNA JMP ERRSR LAC SYM RAL SMA JMP GETVR3 LAC SYMSUB+1 DAC T0 LAC I VAR / STRIDE JMS IMUL CLL RAL / EACH ENTRY IS 2 WORDS TAD VAR DAC VAR GETVR3, LAC SYMSUB+0 CLL RAL / EACH ENTRY IS 2 WORDS TAD VAR DAC VAR ISZ VAR / STEP OVER THE FIRST SUBSCRIPT GETVR4, JMS POPA DAC T0 JMP I T0 / READ SYMBOL, POSSIBLY SUBSCRIPTED / THE SYMBOL'S NAME IS RETURNED IN SYM+0, A MASK / WHICH IS USED BY FNDSYM WHEN MATCHING NAMES IN SYM+1, / AND THE SUBSCRIPTS, IF PRESENT, IN SYMSUB+0 AND SYMSUB+1 / THE MASK IS 637777 FOR SIMPLE VARIABLES, AND / 437777 FOR SUBSCRIPTED VARIABLES GETSYM, 0 LAC GETSYM JMS PSHA CLA / READ SIMPLE NAME, SET JMS GETNAM / MASK TO 637777 LAC C SAD (40 JMS ADVNB SAD (50 / "(" SKP JMP GETSY5 JMS ADVNB LAC SYM / THERE IS NO NEED TO SAVE TAD (400000 / SYM+1 BECAUSE IT GETS JMS PSHA / ASSIGNED LATER ON IN THE ROUTINE JMS GETFAC JMS FFIX DAC T9 LAC C SAD (40 JMS ADVNB SAD (54 / "," SKP JMP GETSY4 JMS ADVNB JMS POPA TAD (200000 JMS PSHA LAC T9 JMS PSHA JMS GETFAC JMS FFIX DAC SYMSUB+1 JMS POPA DAC T9 GETSY4, LAC T9 DAC SYMSUB+0 JMS POPA DAC SYM LAC C SAD (40 JMS ADVNB SAD (51 / ")" SKP JMP ERRSN JMS ADVNB LAC (437777 DAC SYM+1 GETSY5, JMS POPA DAC T0 JMP I T0 / READ SIMPLE SYMBOL AND SET TYPE BITS / ON ENTRY AC [01..00] HOLDS THE VALUE WHICH WILL / END UP IN SYM [17..16] (00 IF NORMAL, 01 IF FUNCTION) / ON EXIT SYM+0 HOLDS THE SYMBOL, AND SYM+1 HOLDS 637777, / WHICH IS APPROPRIATE FOR SIMPLE SYMBOLS GETNAM, 0 DAC T1 LAC C SAD (40 JMS ADVNB TAD (-101 SPA JMP ERRSN TAD (-32 SMA JMP ERRSN LAC C DAC SYM GETNM1, JMS ADV TAD (-60 SPA JMP GETNM3 TAD (-12 SPA JMP GETNM2 TAD (-7 SPA JMP GETNM3 TAD (-32 SMA JMP GETNM3 GETNM2, LAC SYM AND (037600 SZA JMP GETNM1 LAC C CLL RTL RTL RTL RAL TAD SYM DAC SYM JMP GETNM1 GETNM3, LAC T1 / MERGE IN TYPE CLL RTR RAR TAD SYM DAC SYM LAC (637777 / AND SET SIMPLE MASK DAC SYM+1 JMP I GETNAM / LOOK UP THE SYMBOL WHOSE NAME / IS IN SYM+0 AND WHOSE MASK IS IN SYM+1; IF THE / SYMBOL IS FOUND RETURN CALL+1 WITH THE / ADDRESS OF THE SYMBOL IN THE GLOBAL / VARIABLE VAR, AND RETURN CALL+2 IF THE / SYMBOL IS NOT FOUND FNDSYM, 0 LAC TTXT FNDS1, DAC VAR SAD TVAR JMP FNDS2 TAD (1 DAC T0 LAC I T0 XOR SYM AND SYM+1 SNA JMP FNDS3 LAC VAR TAD I VAR JMP FNDS1 FNDS2, ISZ FNDSYM FNDS3, JMP I FNDSYM / ADD A NEW SYMBOL TO THE SYMBOL TABLE / THE NAME IS IN THE GLOBAL VARIABLE / "SYM" AND THE ARRAY SIZES, IF PRESENT, ARE / IN THE GLOBAL VARIABLES "SYMSIZ+0" AND / "SYMSIZ+1"; THE ADDRESS OF THE / NEW SYMBOL IS RETURNED IN THE GLOBAL "VAR" ADDSYM, 0 LAC (2 / 2 WORDS DAC T2 LAC (4 / 2 + 2 WORDS DAC T3 LAC SYM SMA JMP ADDS1 LAC SYMSIZ+0 / 2*DIM0 WORDS CLL RAL DAC T2 TAD (3 / 2 + 1 + 2*DIM0 WORDS DAC T3 LAC SYM RAL SMA JMP ADDS1 LAC SYMSIZ+1 / 2*DIM0*DIM1 WORDS DAC T0 LAC SYMSIZ+0 JMS IMUL CLL RAL DAC T2 TAD (4 / 2 + 2 + 2*DIM0*DIM1 WORDS DAC T3 ADDS1, LAC TVAR / ERRMF IF TVAR+T3 > TMEM TAD T3 CMA TAD (1+TMEM SPA JMP ERRMF LAC TVAR DAC VAR LAC T3 DAC I TVAR ISZ TVAR LAC SYM DAC I TVAR ISZ TVAR SMA JMP ADDS3 RAL SMA JMP ADDS2 LAC SYMSIZ+1 DAC I TVAR ISZ TVAR ADDS2, LAC SYMSIZ+0 DAC I TVAR ISZ TVAR ADDS3, LAC T2 CMA TAD (1 DAC T2 ADDS4, DZM I TVAR / 0.0 IS 2*000000 ISZ TVAR ISZ T2 JMP ADDS4 JMP I ADDSYM / AC = AC * T0 IMUL, 0 SMA CLL JMP IMUL1 CMA CML TAD (1 IMUL1, DAC T2 DZM T1 LAC T0 SNA JMP IMUL4 SMA JMP IMUL2 CMA CML TAD (1 DAC T0 IMUL2, LAW -22 DAC T3 IMUL3, LAC T2 RAR DAC T2 LAC T1 SZL TAD T0 CLL RAR DAC T1 ISZ T3 JMP IMUL3 LAC T2 RAR SNL JMP IMUL4 CLL CMA TAD (1 DAC T2 LAC T1 SZL CMA TAD (1 DAC T1 LAC T2 IMUL4, JMP I IMUL / GET LINE NUMBER / CP/C SHOULD DESCRIBE FIRST CHARACTER OF / THE POSSIBLE NUMBER (LEADING BLANKS WILL GET SKIPPED) / AT THE END, LNO HOLDS THE NUMBER, AND CP/C DESCRIBE / THE DELIMITER; LNO IS 0 IF NO NUMBER GETLNO, 0 LAC C SAD (40 JMS ADVNB DZM LNO TAD (-60 SPA JMP GETLN2 TAD (-12 SMA JMP GETLN2 GETLN1, LAC LNO CLL RTL TAD LNO RAL TAD C TAD (-60 DAC LNO JMS ADV TAD (-60 SPA JMP GETLN2 TAD (-12 SPA JMP GETLN1 GETLN2, JMP I GETLNO / PUTDEC / PUT DECIMAL NUMBER / PUTLNO / PUT DECIMAL LINE NUMBER (4 DIGITS, LEADING ZEROS) / DOES BAD THINGS IF N<0 OR N>9999 PUTDEC, 0 DAC T3 LAC (PUTD7 DAC T5 DZM T4 JMP PUTD1 PUTLNO, 0 DAC T3 LAC (PUTD8 DAC T5 DAC T4 LAC PUTLNO DAC PUTDEC PUTD1, LAC T3 SMA JMP PUTD2 CMA TAD (1 DAC T3 LAW LAW+55 JMS PUTC PUTD2, DZM T2 LAC T3 PUTD3, TAD I T5 SPA JMP PUTD4 DAC T3 ISZ T2 JMP PUTD3 PUTD4, LAC T2 / CHECK IF BOTH THE TAD T4 / DIGIT AND THE NON-ZERO SEEN SNA / FLAG ARE ZERO JMP PUTD5 DAC T4 LAW LAW+60 TAD T2 JMS PUTC PUTD5, ISZ T5 LAC T5 SAD (PUTD9+1 SKP JMP PUTD2 LAW LAW+60 TAD T3 JMS PUTC JMP I PUTDEC PUTD7, -303240 / -100000 -23420 / -10000 PUTD8, -1750 / -1000 -144 / -100 PUTD9, -12 / -10 / PACK TEXT, CMDB TO CMDB / LINE NUMBER STRIPPED AND RETURNED IN LNO (LNO IS 0 IF NO NUMBER) / LENGTH OF PACKED LINE IN CMDB IS RETURNED IN LLEN / PACKED TEXT IS LO THEN HI / TOKENS MUST HAPPEN AT THE BEGINNING OF A BLOCK OF ALPHA / CHARACTERS, AND MUST END ON A NON-ALPHA CHARACTER, SO THAT "XTOY" IS / XTOY, BUT "X TO Y" IS X+TO+Y PACK, 0 LAC (2*CMDB DAC CP / CP IS SRC DAC T9 / T9 IS DST JMS ADVNB JMS GETLNO LAC LNO / WAS THERE A LINE NUMBER ? SNA JMP PACK3 / NO LAC C / YES, SKIP BLANKS BETWEEN SAD (40 / THE LINE NUMBER AND JMS ADVNB / THE FIRST CHARACTER OF THE LINE PACK3, LAC C SAD (42 / STRING ? JMP PACK12 / YES LAC CP / MATCH LOOP DAC T7 / FIRST SAVE CP AND C SO THEY LAC C / CAN BE BACKED UP ON MATCH FAILURE DAC T6 LAC (KTAB-1 DAC T5 / T5 IS TOKEN TABLE POINTER LAC (200 DAC T4 / T4 IS TOKEN CODE LAW -NTOKEN DAC T3 / T3 IS OUTER LOOP CONTROL PACK6, ISZ T5 / GET CHAR FROM CURRENT TABLE ENTRY LAC I T5 SNA JMP PACK7 / END OF ENTRY, MIGHT MATCH SAD C / MATCH ? SKP JMP PACK8 / NO, FORGET THIS ENTRY JMS ADV JMP PACK6 PACK7, LAC T4 / SOME TOKENS ALWAYS MATCH SAD (TFN / "FN" JMP PACK11 SAD (TGE / ">=" JMP PACK11 SAD (TLE / "<=" JMP PACK11 SAD (TNE / "<>" JMP PACK11 JMS PACKA / ALPHA DELIMITER ? JMP PACK11 / NO, MATCH PACK8, LAC I T5 / SKIP OVER REST OF ENTRY SNA JMP PACK9 ISZ T5 JMP PACK8 PACK9, LAC T7 / BACK UP SCAN DAC CP LAC T6 DAC C ISZ T4 / NEXT TOKEN ISZ T3 / LOOP UNTIL ALL TRIED JMP PACK6 LAC C / NOT A MATCH, END OF LINE ? SAD (15 JMP PACK16 / YES JMS PACKC / NO, STORE CHARACTER JMS PACKA / ALPHA ? JMP PACK14 / NO, ADVANCE PACK10, JMS ADV / COPY FOLLOWING ALPHA JMS PACKA JMP PACK3 / DONE LAC C JMS PACKC JMP PACK10 PACK11, LAC T4 / STORE TOKEN CODE JMS PACKC JMP PACK3 PACK12, JMS PACKC / FLAG AND STORE STRING QUOTE PACK13, JMS ADV SAD (15 / END OF LINE ? JMP PACK16 / YES JMS PACKC LAC C SAD (42 / DID WE JUST STORE STRING QUOTE ? JMP PACK14 / YES JMP PACK13 / NO, KEEP COPYING STRING PACK14, JMS ADV JMP PACK3 PACK16, JMS PACKC / END OF LINE LAC T9 / WORK OUT LENGTH IN CHARACTERS TAD (-2*CMDB DAC LLEN JMP I PACK PACKA, 0 LAW -101 / "A" TAD C SPA JMP PACKA1 LAW -133 / "Z" + 1 TAD C SPA ISZ PACKA / RTN+2, ALPHA PACKA1, JMP I PACKA / RTN+1, NON-ALPHA PACKC, 0 DAC T0 LAC T9 CLL RAR DAC T1 SZL JMP PACKC1 LAC I T1 / LO 9 BITS AND (777000 JMP PACKC2 PACKC1, LAC T0 / HI 9 BITS CLL RTL RTL RTL RTL RAL DAC T0 LAC I T1 AND (777 PACKC2, TAD T0 DAC I T1 ISZ T9 JMP I PACKC / GET CHARACTER POINTED TO BY CP / ON RETURN CHARACTER IS IN AC AND IN C / CP HOLDS 2*ADDRESS+POS, WHERE POS IS 0 FOR LOW / HALF AND 1 FOR HIGH HALF ADV, 0 LAC CP CLL RAR DAC T0 ISZ CP LAC I T0 SNL JMP ADV1 RTR RTR RTR RTR RAR ADV1, AND (777 DAC C JMP I ADV / GET CHARACTER POINTED TO BY CP, SKIPPING BLANKS / ON RETURN CHARACTER IS IN AC AND IN C / CP HOLDS 2*ADDRESS+POS, WHERE POS IS 0 FOR LOW / HALF AND 1 FOR HIGH HALF ADVNB, 0 ADVNB1, LAC CP CLL RAR DAC T0 ISZ CP LAC I T0 SNL JMP ADVNB2 RTR RTR RTR RTR RAR ADVNB2, AND (777 SAD (40 JMP ADVNB1 DAC C JMP I ADVNB / GET STRING, WITH ERASE AND KILL PROCESSING / ON ENTRY AC = ADDRESS OF BUFFER / THE STRING WILL BE TERMINATED BY A CR / BYTES ARE PACKED LITTLE-ENDIAN, SO THE LOW HALF / OF THE WORD CONTAINS THE FIRST CHARACTER / THIS ROUTINE ECHOS ERASE AS BS-SP-BS (OR 2 X BS-SP-BS, IF / THE CHARACTER BEING DELETED IS A CONTROL CHARACTER) / AND KILL AS ENOUGH BS-SP-BS TO WIPE OUT THE ENTILE OLD LINE, / SO THE TERMINAL HAS TO BE A SCOPE / NOTE THAT THIS ROUTINE IS ONLY CALLED WITH GETB AS AN / ARGUMENT, SO IT WOULD BE EASY TO MAKE THE CLAIN / THAT IT COULD BE CALLED WITH A JMS AND ALWAYS USE CMDB GETS, 0 CLL RAL DAC T9 DAC T8 GETS1, JMS GETC SAD (177 / ERASE JMP GETS3 SAD (25 / KILL JMP GETS4 DAC T7 LAC T8 CLL RAR DAC T0 ISZ T8 LAC (777000 SZL LAC (777 AND I T0 DAC I T0 LAC T7 SNL JMP GETS2 CLL RTL RTL RTL RTL RAL GETS2, TAD I T0 DAC I T0 LAC T7 JMS PUTC LAC T7 SAD (15 SKP JMP GETS1 LAW LAW+12 JMS PUTC JMP I GETS GETS3, LAC T8 SAD T9 JMP GETS1 JMS GETS5 JMP GETS1 GETS4, LAC T8 SAD T9 JMP GETS1 JMS GETS5 JMP GETS4 GETS5, 0 LAW -1 TAD T8 DAC T8 CLL RAR DAC T0 LAC I T0 SNL JMP GETS6 CLL RTR RTR RTR RTR RAR GETS6, AND (777 TAD (-40 SPA JMS GETS7 JMS GETS7 JMP I GETS5 GETS7, 0 LAW LAW+10 JMS PUTC LAW LAW+40 JMS PUTC LAW LAW+10 JMS PUTC JMP I GETS7 / GET CHARACTER FROM CONSOLE / ON RETURN AC = CHARACTER / EVERY TIME GETC WAITS FOR A CHARACTER TO / BE TYPED THE RNDS COUNTER IS INCREMENTED; THE VALUE / OF RNDS IS USED BY RANDOMIZE TO SET THE / CURRENT RANDOM NUMBER TO A VALUE WHICH IS, FOR / ALL PRACTICAL PURPOSES, UNKNOWN GETC, 0 GETC1, LAC GETOX SAD GETIX JMP GETC2 TAD (1 AND (GETBM DAC GETOX TAD (GETB DAC T0 LAC I T0 JMP I GETC GETC2, ISZ RNDS NOP JMS GETCC JMP GETC1 / POLL FOR ^C CHARACTERS / IF ^C, JUMP DIRECTLY TO ERRCC / IF NOT, STASH CHARACTER INTO RING BUFFER FOR / FUTURE USE BY GETC GETCC, 0 KSF JMP GETCC1 KRB AND (177 DAC T0 SAD (3 JMP ERRCC LAC GETIX TAD (1 AND (GETBM SAD GETOX JMP GETCC1 DAC GETIX TAD (GETB DAC T1 LAC T0 DAC I T1 GETCC1, JMP I GETCC / PUT CHARACTER ONTO CONSOLE / AC = CHARACTER / THROW AWAY CONTROL CHARACTERS EXCEPT FOR / BACKSPACE, CARRIAGE RETURN, LINEFEED / ALSO UPDATE THE CURRENT HORIZONTAL POSITION / FOR USE BY PRINT FIELDS AND SUCH / THE SUPPLIED CHARACTER IS MASKED WITH / 777 TO ALLOW "LAW CH; JMS PUTC" TO WORK PUTC, 0 AND (777 SAD (10 JMP PUTC1 SAD (15 JMP PUTC2 SAD (12 JMP PUTC3 TAD (-40 SPA JMP PUTC4 TAD (40 ISZ COL JMP PUTC3 PUTC1, LAC COL SNA JMP PUTC4 TAD (-1 DAC COL LAW LAW+10 JMP PUTC3 PUTC2, DZM COL PUTC3, TSF JMP PUTC3 TLS PUTC4, JMP I PUTC / ABSVAL / FAC = FABS(FAC) FABS, 0 DZM FAC+0 / FORCE SIGN POSITIVE JMP I FABS / SIGNUM / FAC = FSGN(FAC) FSGN, 0 JMS FTST SPA CLA CMA / -1 SMA SZA LAC (1 / +1 JMS FFLT JMP I FSGN / SQUARE ROOT / FAC = SQRT(FAC) / ?DO IF FAC<0 ON CALL FSQR, 0 JMS FTST / ERROR IF FAC<0 SPA JMP ERRDO LAC (T6 JMS FSTA LAC FAC+1 / INITIAL X(I) IS 0.F*2^(E/2) SPA CLL CML RAR DAC FAC+1 FSQR1, LAC (T8 / UPDATE C(I) JMS FSTA JMS FMOVO / X(I+1) = (ARG/X(I)+X(I))/2 LAC (T6 JMS FLDA JMS FDIV LAC (T8 JMS FLDO JMS FADD LAC (F2 JMS FLDO JMS FDIV LAC (T8 JMS FLDO / X(I+1) = X(I) ? JMS FCMP SZA JMP FSQR1 / NO, AGAIN JMP I FSQR / LAGGED FIBONACCI RANDOM NUMBER USING ROTATES / THEORY CLAIMS TO BE AT WWW.AGNER.ORG/RANDOM/RANROT.HTM / FORMULA IS X[N] = (ROTL(X[N-10], 5)+ROTL(X[N-17], 3)) MOD 2**18 / FRNDP2 IS N-10, FRNDP1 IS N AND N-17 / THIS WORKS BECAUSE FRNDB IS 17 WORDS LONG / THE (UNSIGNED) INT 0 <= N < 2**18 IS THEN CONVERTED INTO A / FLOAT IN THE RANGE 0 <= F < 1 BY SIMPLE SCALING; NOTE THAT THE / CONVERSION FROM INT TO FLOAT IS DONE BY HAND BECAUSE / FFIX DEALS WITH SIGNED (NOT UNSIGNED) INTS / SFRND IS CALLED TO SEED THE GENERATOR WITH A SEED IN AC FRND, 0 DZM FAC+0 LAC (21 / 17 DAC FAC+1 LAC I FRNDP2 / A = ROTL(FRNDB[FRNDP2], 5) SPA CLL CML RTL RTL RAL DAC T0 LAC I FRNDP1 / B = ROTL(FRNDB[FRNDP1], 3) SPA CLL CML RTL RAL TAD T0 / FRNDB[FRNDP1] = (A+B) MOD 2**18 DAC I FRNDP1 DAC FAC+2 DZM FAC+3 LAW -1 / DECREMENT FRANP1 AND FRANP2, TAD FRNDP1 / WRAPPING THEM AROUND WHEN THEY FALL SAD (FRNDB-1 / OFF THE FRONT OF FRANB TAD (21 DAC FRNDP1 LAW -1 TAD FRNDP2 SAD (FRNDB-1 TAD (21 DAC FRNDP2 JMS FNAR / 0 <= FAC < 2**18 LAC (FRNDSF JMS FLDO JMS FMUL / 0 <= FAC < 1 JMP I FRND SFRND, 0 DAC T0 LAC (FRNDB-1 DAC X0 LAW -21 DAC T1 LAC T0 SFRND1, DAC I X0 SPA CLL / ROTL(AC, 5) + 97 CML RTL RTL RAL TAD (141 ISZ T1 JMP SFRND1 LAC (FRNDB DAC FRNDP1 LAC (FRNDB+12 DAC FRNDP2 JMP I SFRND FRNDB, BSS 21 FRNDP1, BSS 1 FRNDP2, BSS 1 FRNDSF, 200000 / 1 / 2**18 000357 / POWERS, PART 1 / FAC = FPOW(FAC, FOP) / COMPUTE FAC^FOP FOR ARBITRARY FOP; IF FOP IS / AN INTEGER PASS THE WORK OFF TO FIPOW AND COMPUTE FAC^FOP / BY REPEATED MULTIPLICATIONS, OTHERWISE COMPUTE FAC^FOP / AS EXP(FOP*LN(FAC)), WHICH RESTRICTS FAC TO VALUES GREATER THAN / ZERO, BECAUSE THAT'S WHERE LN(X) IS ACTUALLY DEFINED. FPOW, 0 JMS FPSHA / SAVE X JMS FMOVA / IS Y AN INTEGER ? JMS FINT JMS FCMP SNA JMP FPOW1 / YES JMS FPOPA / NO, EXP(Y*LN(X)) JMS FPSHO JMS FLN JMS FPOPO JMS FMUL JMS FEXP JMP FPOW2 FPOW1, JMS FPOPA / YES, FIPOW(X, Y) JMS FIPOW FPOW2, JMP I FPOW / POWERS, PART 2 / FAC = FIPOW(FAC, FOP) / COMPUTE FAC^FOP, IGNORING ANY FRACTIONAL BITS IN / FOP (THE ASSUMPTION IS THAT THE CALLER HAS ALREADY CHECKED / THAT THIS IS THE CASE), USING REPEATED MULTIPLICATION, / WHICH MEANS IT WORKS EVEN IF FAC IS LESS THAN ZERO. FIPOW, 0 LAC FOP+2 / CHECK FOR Y=0.0 SZA / NOT HAVING TO HANDLE 0.0 MAKES JMP FIPOW1 / THE REST OF THE CODE NICER LAC (F1 JMS FLDA JMP FIPOW8 FIPOW1, LAC FOP+0 / SAVE SIGN OF Y JMS PSHA JMS FPSHA / SAVE X LAC FOP+2 / SIG BITS OF Y DAC T6 LAC FOP+3 DAC T7 LAC FOP+1 / EXP OF Y DAC T8 LAC (F1 / RESULT BEGINS AT 1.0 JMS FLDA LAC T8 TAD (-32 SPA JMP FIPOW2 TAD FAC+1 / >=26, Y LSB IN T7 & 1000 DAC FAC+1 / BUT SCALE INITIAL 1.0 IF NECESSARY JMP FIPOW4 FIPOW2, DAC T8 / POSITION LSB OF Y FIPOW3, LAC T6 CLL RAR DAC T6 LAC T7 RAR DAC T7 ISZ T8 JMP FIPOW3 FIPOW4, LAC (T8 / RETVAL IN T8/T9 JMS FSTA JMS FPOPA FIPOW5, LAC (T10 / X IN T10/T11 JMS FSTA LAC T7 / IF LSB OF Y SET A MULTIPLY IS NEEDED AND (1000 SNA JMP FIPOW6 / NO LAC (T8 / R = R*X JMS FLDO JMS FMUL LAC (T8 JMS FSTA FIPOW6, LAC T6 / EAT LSB CLL RAR DAC T6 LAC T7 RAR AND (777000 DAC T7 SAD T6 / CHECK IF DONE; NOTE THAT IF SZA / T6/T7=0 THEN WE MUST HAVE JUST EATEN SKP / THE LAST NZ BIT, SO A MULTIPLY HAS JMP FIPOW7 / JUST BEEN DONE, AND FAC IS VALID LAC (T10 JMS FLDA JMS FMOVO JMS FMUL / AVOID FALSE OVERFLOW JMP FIPOW5 FIPOW7, JMS POPA / IF Y<0, R = 1/R SMA JMP FIPOW8 JMS FMOVO LAC (F1 JMS FLDA JMS FDIV FIPOW8, JMP I FIPOW / TANGENT / FAC = FTAN(FAC) / EVALUATED USING THE IDENTITY / TAN(X) = SIN(X)/COS(X), WITH A CHECK FOR / COS(X)=0 SO THE ERROR IS ?DO, RATHER / THAT THE CONFUSING ?ZD FTAN, 0 JMS FPSHA JMS FCOS JMS FTST / COS(X) = 0 ? SNA JMP ERRDO / YES, ?DO JMS FMOVO / THIS LITTLE DANCE GETS X BACK JMS FPOPA / IN FAC, AND COS(X) ON TOS JMS FPSHO JMS FSIN JMS FPOPO JMS FDIV / SIN(X)/COS(X) JMP I FTAN / COSINE / FAC = FCOS(FAC) / EVALUATED USING THE IDENTITY / COS(X) = SIN(X + PI/2) FCOS, 0 LAC (FPID2 JMS FLDO JMS FADD JMS FSIN JMP I FCOS FPID2, 311037 / 1.570796327 (PI/2) 552401 / SINE / FAC = FSIN(FAC) / IF ARG<0 THEN SIN(ARG) = -SIN(-ARG) / YOU CAN MAKE THE BASIC ALGORITHM DEAL WITH NEGATIVE / ANGLES, BUT THIS IS EASIER AND FASTER / IF ARG>=0 THE ALGORITHM IS / 1) Q = INT(X / (PI/2)) / DETERMINE WHICH QUADRANT THE ANGLE IS IN / 2) X = X - Q*(PI/2) / REDUCE X TO THE RANGE [0, PI/2] / 3) DETERMINE ARG FOR SERIES BASED ON QUADRANT / IF (Q%4)=0 OR (Q%4)=0 THEN ARG = X / IF (Q%4)=1 OR (Q%4)=3 THEN ARG = (PI/2)-X / 4) EVALUATE SINE, ARG [0, PI/2] / THE FUNCTION IS COMPUTED USING A TRUNCATED MACLAURIN SERIES / Y = X - X^3/3! + X^5/5! - X^7/7! + X^9/9! / EVALUATED USING HORNER'S RULE, WITH Z = X^2 / Y = ((((S4*Z - 1)*S3*Z + 1)*S2*Z - 1)*S1*Z + 1) * X / S4 = 1/(8*9), S3 = 1/(6*7), S2 = 1/(4*5), S1 = 1/(2*3) / 5) CORRECT SIGN / IF (Q%4)=0 OR (Q%4)=1 THEN RESULT = Y / IF (Q%4)=2 OR (Q%4)=3 THEN RESULT = -Y / NOTE THAT THE NEGATE NEEDED TO HANDLE NEGATIVE / ARGS AND THE NEGATE IN STEP 5 ARE MERGED INTO ONE IN / THIS CODE BECAUSE IT'S EASY TO DO SO FSIN, 0 LAC FAC+0 / SAVE SIGN OF X DAC T6 DZM FAC+0 / THEN TAKE ABSOLUTE VALUE LAC (T10 / SAVE IN T10/T11 JMS FSTA LAC (FPID2 / Q = INT(X / (PI/2)) JMS FLDO JMS FDIV JMS FINT LAC FAC+3 / WE ARE NOW GOING TO DAC T7 / COMPUTE Q%4 IN BITS 3000 OF T6 LAC FAC+2 / WHICH IS JUST AN "AND" SNA / IN TWOS-COMPLEMENT NOTATION JMP FSIN2 / Q = 0, Q%4 = 0 DAC T8 LAC FAC+1 TAD (-32 SNA JMP FSIN2 / =26, DONE SMA JMP ERRDO / >26, DOMAIN ERROR (Q%4 UNKNOWN) DAC T9 FSIN1, LAC T8 / SLIDE LOW 2 BITS RAR / DOWN TO THE PROPER PLACE DAC T8 LAC T7 RAR DAC T7 ISZ T9 JMP FSIN1 FSIN2, LAC (FPID2 / X = X - Q*(PI/2) JMS FLDO / WHICH LEAVES X IN THE RANGE JMS FMUL / [-PI/2, +PI/2] JMS FMOVO LAC (T10 JMS FLDA JMS FSUB LAC T7 / FIRST QUADRANT CHECK AND (1000 SNA JMP FSIN3 / 0, 2 JMS FMOVO / 1, 3; X = (PI/2) - X LAC (FPID2 JMS FLDA JMS FSUB FSIN3, LAC (T8 / T8/T9 IS X JMS FSTA JMS FMOVO JMS FMUL LAC (T10 / T10/T11 IS Z (X^2) JMS FSTA LAC (FS4 / EVALUATE THE MACLAURIN SERIES JMS FLDO / FOR SIN(X) JMS FMUL LAC (F1 JMS FLDO JMS FSUB LAC (T10 JMS FLDO JMS FMUL LAC (FS3 JMS FLDO JMS FMUL LAC (F1 JMS FLDO JMS FADD LAC (T10 JMS FLDO JMS FMUL LAC (FS2 JMS FLDO JMS FMUL LAC (F1 JMS FLDO JMS FSUB LAC (T10 JMS FLDO JMS FMUL LAC (FS1 JMS FLDO JMS FMUL LAC (F1 JMS FLDO JMS FADD LAC (T8 JMS FLDO JMS FMUL LAC T6 / SET LINK IF ARG<0, NEG NEEDED RAL LAC T7 / SECOND QUADRANT CHECK AND (2000 SZA CML / 2, 3; ANOTHER NEG NEEDED SZL JMS FNEG / FINAL NEGATE JMP I FSIN FS4, 343434 / 0.013888888 (1/(8*9)) 337372 FS3, 303030 / 0.023809523 (1/(6*7)) 301373 FS2, 314631 / 0.050000000 (1/(4*5)) 463374 FS1, 252525 / 0.166666666 (1/(2*3)) 252376 / ARCTANGET / FAC = FATN(FAC) / 1) CHECK IF X<0, AND IF IT IS, MAKE X>=0 BY USING / THE FORMULA ATN(X) = -ATN(-X) / 2) CHECK IF X>1, AND IF IT IS, MAKE X<=1 BY USING / THE FORMULA ATN(X) = PI/2 - ATN(1/X) / 3) WE NOW HAVE X IN THE RANGE [0, 1], SO THE ATN IS / KNOWN TO BE IN THE RANGE [0, PI/4] / ATN(X) IS APPROXIMATED BY A MINIMAX 5TH-ORDER RATIO / OF POLYNOMIALS (CRENSHAW, PAGE 179), WHICH IS ACCURATE ENOUGH / IF X IS IN THE RANGE [TAN(-PI/12), TAN(+PI/12)] / ATN(X) = X * ((A+B*X^2)/(1+C*X^2)) / A = 0.999999020, B = 0.257977658, C = 0.591204505 / IF THE ORIGINAL X IS IN THE RANGE [0, +PI/12] THEN THIS / APPROXIMATION CAN BE USED DIRECTLY / IF THE ORIGINAL X IS IN THE RANGE [PI/12, 3*PI/12] THE / FORMULA ATN(X) = ATN(K)+ATN(Z), WHERE Z=(X-K)/(1+K*X), AND / K IS CHOSEN TO BE TAN(2*PI/12) IS USED TO CONVERT / THE ORIGINAL RANGE INTO A NEW RANGE [-PI/12, +PI/12] / K0 = TAN(PI/12), B1 = 2*PI/12, K1 = TAN(2*PI/12) / THE VARIABLE T6 KEEPS TRACK OF THE / SIGN, RECIPROCAL, AND OFFSET TRANSFORMS ON THE WAY IN / SO THAT THEY CAN BE FINISHED UP ON THE WAY OUT FATN, 0 LAC FAC+0 / REMEMBER SIGN OF X DAC T6 DZM FAC+0 / X = ABS(X) LAC (F1 / X>1 ? JMS FLDO JMS FCMP SNA SPA CLL JMP FATN1 / NO JMS FMOVO / X = 1/X LAC (F1 JMS FLDA JMS FDIV CLL CML FATN1, LAC T6 / REMEMBER IF WE DID 1/X RAR DAC T6 LAC (FATK0 / X>K0 JMS FLDO JMS FCMP SNA SPA CLL JMP FATN2 / NO JMS FPSHA / X = (X-K1)/(1+K1*X) LAC (FATK1 JMS FLDO JMS FMUL LAC (F1 JMS FLDO JMS FADD JMS FMOVO JMS FPOPA JMS FPSHO LAC (FATK1 JMS FLDO JMS FSUB JMS FPOPO JMS FDIV CLL CML FATN2, LAC T6 / REMEMBER WE DID (X-K1)/(1+X*K1) RAR DAC T6 JMS FPSHA / APPROX ATN(X) JMS FMOVO JMS FMUL JMS FPSHA / X^2 LAC (FATC JMS FLDO JMS FMUL LAC (F1 JMS FLDO JMS FADD / 1+C*X^2 JMS FMOVO JMS FPOPA / X^2 JMS FPSHO / 1+C*X^2 LAC (FATB JMS FLDO JMS FMUL LAC (FATA JMS FLDO JMS FADD / A+B*X^2 JMS FPOPO / 1+C*X^2 JMS FDIV / (A+B*X^2)/(1+C*X^2) JMS FPOPO / X JMS FMUL LAC T6 / FINISH ATN(K+X) = ATN(K)+ATN(Z) SMA JMP FATN3 LAC (FATB1 JMS FLDO JMS FADD FATN3, LAC T6 / FINISH ATN(X) = PI/2-ATN(1/X) RAL SMA JMP FATN4 JMS FMOVO LAC (FPID2 JMS FLDA JMS FSUB FATN4, LAC T6 / FINISH ATN(X) = -ATN(-X) RTL SPA JMS FNEG FATN5, JMP I FATN FATK0, 211141 / 0.267949192 213377 FATB1, 206025 / 0.523598775 106400 FATK1, 223632 / 0.577350269 350400 FATA, 377777 / 0.999999020 676400 FATB, 204053 / 0.257977659 227377 FATC, 227262 / 0.591204505 266400 / NATURAL LOG / FAC = FLN(FAC) / 1) IF X<=0 GIVE ?DO / 2) X IS A FLOATING POINT NUMBER OF THE FORM (2^E)*F, SO / LN(X) CAN BE COMPUTED AS LN(2^E)+LN(F), WHICH CAN BE REWRITTEN / AS LN(2)*E+LN(F); THIS REDUCES THE RANGE OVER WHICH LN(X) / NEEDS TO BE EVALUATED TO 0.5<=X<1.0 / 3) LN(X) IS COMPUTED USING A CONTINUOUS FRACTION APPROXIMATION / LN(X) = 2*Z/(1-Z^2/(3-4*Z^2/(5-9*Z^2/(7-16*Z^2/...; Z = (X-1)/(X+1) / IF 0.5<=X<1.0, AN 11TH ORDER APPROXIMATION IS NEEDED! / 4) IF 0.7937<=X<1.0 LN(X) IS APPROXIMATED DIRECTLY, AND OVER / THIS RANGE OF X WE HAVE -0.1150<=Z<0 / 5) IF 0.5<=X<0.7937 WE DIVIDE X BY 0.6300, SO 0.7937<=X<1.2598, / AND OVER THIS (NEW) RANGE OF X WE HAVE -0.1150<=Z<0.1150 / SINCE LN(X/K) = LN(X)-LN(K), LN(X) = LN(X/K)+LN(K) / 6) WITH -0.1150<=Z<0.1150, LN(X) CAN BE COMPUTED (BARELY) / BY A 5TH ORDER APPROXIMATION, WHICH CAN BE WRITTEN IN RATIO OF / POLYNOMIALS FORM AS LN(X) = 2*Z*(15-4*Z^2)/(15-9*Z^2) FLN, 0 JMS FTST / X<=0 ? SNA SPA JMP ERRDO / YES, ?DO JMS FPSHA LAC FAC+1 / E JMS FFLT LAC (FLNG / LN(2.0) JMS FLDO JMS FMUL JMS FMOVO / X TO FAC, LN(2.0)*E TO TOS JMS FPOPA JMS FPSHO DZM FAC+1 / 0.5<=X<1.0 LAC (FLNA JMS FLDO JMS FCMP SPA JMP FLN1 JMS FLN3 / 0.7937<=X<1.0, NO SCALING JMP FLN2 FLN1, LAC (FLNB / 0.5<=X<0.7937, SCALING JMS FLDO JMS FDIV JMS FLN3 LAC (FLNC JMS FLDO JMS FADD FLN2, JMS FPOPO / LN(X) = LN(F) + E*LN(2.0) JMS FADD JMP I FLN FLN3, 0 JMS FPSHA / Z = (X-1)/(X+1) LAC (F1 JMS FLDO JMS FADD JMS FMOVO JMS FPOPA JMS FPSHO LAC (F1 JMS FLDO JMS FSUB JMS FPOPO JMS FDIV JMS FPSHA / Z TO TOS JMS FMOVO JMS FMUL JMS FPSHA / Z^2 TO TOS LAC (FLND / 15-9*Z^2 JMS FLDO JMS FMUL LAC (FLNE JMS FLDO JMS FADD JMS FMOVO / Z^2 TO FAC, 15-9*Z^2 TO TOS JMS FPOPA JMS FPSHO LAC (FLNF / 15-4*Z^2 JMS FLDO JMS FMUL LAC (FLNE JMS FLDO JMS FADD JMS FPOPO JMS FDIV / (15-4*Z^2)/(15-9*Z^2) JMS FPOPO JMS FMUL / Z*((15-4*Z^2)/(15-9*Z^2)) LAC (F2 JMS FLDO JMS FMUL / 2*Z*((15-4*Z^2)/(15-9*Z^2)) JMP I FLN3 FLNA, 313137 / 0.793700525 724400 FLNB, 241212 / 0.629960525 137400 FLNC, 754460 / -0.462098120 (LN(FLNB)) 177377 FLND, 620000 / -9.0 000404 FLNE, 360000 / 15.0 000404 FLNF, 600000 / -4.0 000403 FLNG, 261344 / 0.693147181 (LN(2.0)) 137400 / EXPONENTIAL / FAC = FEXP(FAC) / 1) FORCE X>=0 USING THE EXP(X) = -1/EXP(-X) / 2) EXP(X) CAN BE EVALUATED USING A POWER SERIES OF THE FORM / EXP(X) = 1 + X + X^2/2! + X^3/3! + X^4/4! + X^5/5! + ... / BUT THIS SERIES IS VERY SLOW TO CONVERGE IF X ISN'T VERY SMALL / 3) THE RANGE OF X CAN BE LIMITED BY REWRITING X AS X1+X2, / WHERE X1 IS AN INTEGER AND 0.0<=X2<1.0, WHICH ALLOWS EXP(X) TO / BE REWRITTEN AS EXP(X1)*EXP(X2); NOTE THAT SINCE X1 IS AN / INTEGER EXP(X1) IS JUST A BUNCH OF MULTIPLICATIONS / SADLY, IF 0.0<=X2<1.0, WE NEED AN 11TH ORDER POLYNOMIAL TO / EVALUATE EXP(X2) WITH ENOUGH ACCURACY! / 4) REWRITE X AS X1/N+X2, WHERE X1 IS AN INTEGER, AND 0.0<=X2<1/N / WHICH ALLOWS EXP(X) TO BE REWRITTEN AS EXP(X1/N)*EXP(X2), OR / EXP(1/N)^X1*EXP(X2), AND CAN MAKE X2 AS SMALL AS DESIRED, AT THE / COST OF A FEW EXTRA MULTIPLICATIONS COMPUTING EXP(1/N)^X1 / THE SWEET SPOT SEEMS TO BE N=4, WHICH MAKES 0.0<=X2<0.25, AND / TURNS EXP(X2)= 1+X2(1+X2/2(1+X2/3(1+X2/4(1+X2/5(1+X2/6))))) FEXP, 0 LAC FAC+0 / SAVE SIGN, MAKE POSITIVE JMS PSHA DZM FAC+0 LAC (F4 / COMPUTE X1 JMS FLDO JMS FMUL JMS FPSHA JMS FINT JMS FMOVO / COMPUTE X2, X1 TO TOS JMS FPOPA JMS FPSHO JMS FSUB LAC (F4 JMS FLDO JMS FDIV LAC (T6 / T6 IS X2 JMS FSTA LAC (FEXA / 1/6 JMS FEXP2 LAC (FEXB / 1/5 JMS FEXP2 LAC (FEXC / 1/4 JMS FEXP2 LAC (FEXD / 1/3 JMS FEXP2 LAC (FEXE / 1/2 JMS FEXP2 LAC (F1 JMS FLDO JMS FADD JMS FPOPO / COMPUTE EXP(0.25)^X1, EXP(X2) TO TOS JMS FPSHA LAC (FEXF JMS FLDA JMS FIPOW JMS FPOPO / EXP(1/N)^X1 * EXP(X2) JMS FMUL JMS POPA / DO FINAL 1/X IF NECESSARY SMA JMP FEXP1 JMS FMOVO LAC (F1 JMS FLDA JMS FDIV FEXP1, JMP I FEXP FEXP2, 0 / THIS IS A LOCAL ROUTINE JMS FLDO / WHICH EVALUATES A SINGLE TERM OF THE JMS FMUL / SERIES; IT'S CALLED WITH LAC (F1 / THE ADDRESS OF A COEFFICIENT IN AC JMS FLDO / AND X IN T6/T7 JMS FADD LAC (T6 JMS FLDO JMS FMUL JMP I FEXP2 FEXA, 252525 / 0.166666667 252376 FEXB, 314631 / 0.200000000 463376 FEXC, 200000 / 0.250000000 000377 FEXD, 252525 / 0.333333333 252377 FEXE, 200000 / 0.500000000 000400 FEXF, 244265 / 1.284025417 (EXP(1/4)) 707401 / FLOATING POINT INPUT CONVERSION / GCP CONTAINS THE ADDRESS OF C, WHICH HOLDS THE CURRENT / CHARACTER, AND GADVP CONTAINS THE ADDRESS OF ADV, WHICH IS A / ROUTINE WHICH ADVANCES THE CURRENT CHARACTER / RETURN JMS+1 IF NO NUMBER, AND RETURN JMS+2 IF THERE IS / A NUMBER, WHICH HAS BEEN READ INTO FAC FGET, 0 DZM FAC+2 / FAC+2/FAC+3 HOLD THE NUMBER DZM FAC+3 DZM T9 / T9 HOLDS DECIMAL EXPONENT DZM T8 / T8 NZ IF DIGITS NO LONGER SIGNIFICANT DZM T7 / T7 NZ IF DIGITS SEEN DZM T6 / T6 NZ IF DOT SEEN LAC I GCP / SKIP LEADING BLANKS SKP FGET1, JMS I GADVP SAD (40 JMP FGET1 DZM FAC+0 / LEADING SIGN SAD (53 / "+" JMP FGET2 SAD (55 / "-" SKP JMP FGET4 CMA / ANYTHING WITH BIT[0]=1 DAC FAC+0 / WILL DO FGET2, JMS I GADVP FGET4, SAD (56 / "." JMP FGET7 SAD (105 / "E" JMP FGET8 JMS FISDIG / DIGIT ? JMP FGET13 / NO ISZ T7 LAC T8 / IS DIGIT STILL SIGNIFICANT ? SZA JMP FGET5 / NO LAC FAC+3 / T4:T5 = 10*FAC+2:FAC+3 + C - "0" CLL RAL DAC T5 LAC FAC+2 RAL DAC T4 LAC T5 CLL RAL DAC T5 LAC T4 RAL DAC T4 LAC T5 CLL TAD FAC+3 DAC T5 CLA RAL TAD T4 TAD FAC+2 DAC T4 LAC T5 CLL RAL DAC T5 LAC T4 RAL DAC T4 LAW -60 / "0" TAD I GCP CLL TAD T5 DAC T5 CLA RAL TAD T4 DAC T4 AND (777400 / SPILLED BEYOND 26 BITS ? SZA JMP FGET5 / YES LAC T5 / FAC+2:FAC+3 GETS T4:T5 DAC FAC+3 LAC T4 DAC FAC+2 JMP FGET6 FGET5, ISZ T8 / NO LONGER SIGNIFICANT ISZ T9 / SO JUST INCREMENT DECIMAL EXPONENT NOP FGET6, LAC T6 / IF AFTER A "." SZA / DECREMENT DECIMAL EXPONENT CLA CMA TAD T9 DAC T9 JMP FGET2 FGET7, LAC T6 / SECOND "." ? SZA JMP FGET13 / YES, END ISZ T6 JMP FGET2 FGET8, LAC T7 / DIGITS BEFORE THE "E" ? SNA JMP FGET13 / NO, END JMS I GADVP DZM T8 / T8 HOLDS EXPONENT SIGN DZM T6 / T6 HOLDS EXPONENT SAD (53 / "+" JMP FGET9 SAD (55 / "-" SKP JMP FGET10 ISZ T8 FGET9, JMS I GADVP FGET10, LAC I GCP JMS FISDIG / DIGIT ? JMP FGET11 / NO LAC T6 CLL RTL TAD T6 RAL TAD I GCP TAD (-60 DAC T6 JMP FGET9 FGET11, LAC T8 / UPDATE DECIMAL EXPONENT RAR LAC T6 SNL JMP FGET12 CMA TAD (1 FGET12, TAD T9 DAC T9 FGET13, LAC T7 / END, TAKE ERROR RETURN SNA / IF NO DIGITS JMP I FGET / WERE ACTUALLY SEEN LAC (43 / 17+18 DAC FAC+1 JMS FNAR LAC T9 / DECIMAL EXPONENT ? SNA JMP FGET14 / NO LAC (T7 / MULTIPLY NUMBER BY 10^T9 JMS FSTA LAC T9 JMS FP10 / SMASHES T0 THROUGH T6 LAC (T7 JMS FLDO JMS FMUL FGET14, ISZ FGET JMP I FGET FISDIG, 0 TAD (-60 SPA / SKIP IF >= "0" JMP FISDG1 TAD (-12 SPA / SKIP IF >= "9"+1 ISZ FISDIG FISDG1, JMP I FISDIG / FLOATING POINT OUTPUT CONVERSION / A FLOATING POINT NUMBER IS OF THE FORM / F * 2^E, WHERE 0.5<=F<1.0, AND -256<=E<256 / THIS CAN ALSO BE WRITTEN AS / F * 10^D.D, WHERE D.D IS E/LOG2(10) (3.321928095) / WHICH CAN BE REARRANGED INTO THE FORM / F * 10^.D * 10*D / SINCE 0.5<=F<1.0, AND 1.0<=10^.D<10.0, IT FOLLOWS / THAT 0.5<=F*10^.D<10.0 / THEN, IF IT'S >=1.0, DIVIDE BY 10.0 AND INCREMENT / THE DECIMAL EXPONENT, WHICH BRINGS THE FRACTION INTO / THE RANGE 0.1<=F<1.0 / THINGS GET MORE COMPLEX WHEN E<0, WHICH / MAKES D.D<0, WHICH MAKES D<0 AND -1.0<.D<=0.0 (BECAUSE / OF HOW FFIX WORKS) BUT WE WANT 0<=.D<1.0 / THIS IS FIXED BY WATCHING FOR D.D<0, AND IF IT IS, / REPLACING D WITH D-1 AND .D BY .D+1.0, AS LONG AS WE / ARE PREPARED TO DEAL WITH THE FACT THAT / 0.5<=F*10^(.D+1.0)<=10.0 (AN "IF" IN A CORRECTION / LOOP NEEDS TO BE A "WHILE" BECAUSE TWO LOOPS / ARE NEEDED FOR NUMBERS LIKE -3.0) FPUT, 0 LAC (T7 JMS FSTA DZM T9 / MORTALS EXPECT 0.0 TO BE LAC FAC+2 / +0.00000E+00 SNA JMP FPUT1 LAC FAC+1 / E JMS FFLT LAC (FL210 JMS FLDO JMS FDIV / D.D = E/LOG2(10) JMS FTST SPA JMP FPUTA JMS FFIX JMP FPUTB FPUTA, JMS FFIX / MAKE THINGS ROUND IN THE CORRECT TAD (-1 / DIRECTION WHEN D.D<0 FPUTB, DAC T9 JMS FP10 / 10^D (SMASHES T0 TO T6) JMS FMOVO LAC (T7 JMS FLDA DZM FAC+0 JMS FDIV / ABS(F) * 10^.D FPUTC, LAC (F1 JMS FLDO JMS FCMP / IF 1.0<=ABS(F)*10^.D<10.0 SPA / DIVIDE IT BY 10.0 (AND FIX THE JMP FPUT0 / DECIMAL EXPONENT) TO BRING LAC (F10 / IT INTO THE RANGE 0.1<=ABS(F)*10^.D<1.0 JMS FLDO JMS FDIV ISZ T9 NOP JMP FPUTC FPUT0, LAC (FRN5 / WE ARE GOINT TO GENERATE JMS FLDO / 6 DIGITS JMS FADD / SO ROUND BY ADDING 0.0000005 LAC (F1 / THIS CAN CAUSE JMS FLDO / THE FRACTION TO NO LONGER JMS FCMP / BE 0.1<=F<1.0, SO CHECK, AND SPA / REPAIR IF NECESSARY JMP FPUT1 LAC (F10 / WAS T7! GAK! JMS FLDO JMS FDIV ISZ T9 NOP FPUT1, LAC T7 / SIGN RAL CLA RTL / 0 IF POS, 2 IF NEG TAD (53 / "+" IF POS, "-" IF NEG JMS PUTC LAW LAW+60 / "0" JMS PUTC LAW LAW+56 / "." JMS PUTC LAW -6 DAC T4 FPUT2, LAC (F10 / EXTRACT A DIGIT JMS FLDO JMS FMUL JMS FMOVO JMS FFIX DAC T5 TAD (60 / TYPE DIGIT JMS PUTC LAC T5 / RETAIN THE FRACTIONAL PART CMA / FOR THE NEXT TIME TAD (1 JMS FFLT JMS FADD ISZ T4 JMP FPUT2 LAW LAW+105 / "E" JMS PUTC LAC T9 / PRINT EXPONENT RAL LAW LAW+53 / "+" SNL JMP FPUT2A LAC T9 CMA TAD (1 DAC T9 LAW LAW+55 / "-" FPUT2A, JMS PUTC LAC T9 / DIVIDE BY 10 DZM T4 FPUT3, TAD (-12 SPA JMP FPUT4 ISZ T4 JMP FPUT3 FPUT4, DAC T9 LAW LAW+60 / DIGIT 1 TAD T4 JMS PUTC LAC T9 TAD (12+60 / DIGIT 2 JMS PUTC JMP I FPUT F0, 000000 / 0.0 000000 F1, 200000 / 1.0 000401 F2, 200000 / 2.0 000402 F4, 200000 / 4.0 000403 F10, 240000 / 10.0 000404 FL210, 324464 / 3.321928095 741402 FRN5, 206157 / 0.0000005 365354 / COMPUTE 10.0^AC, -128 0.0) / +3 [0..8]=F, [9..17]=0 / ERROR JUMPS / ERROV - EXPONENT OVERFLOW/UNDERFLOW / ERRZD - ZERO DIVIDE / THERE ARE TWO REGISTERS / FAC, FOP / FAC CAN BE LOADED/STORED FROM/TO MEMORY / FOP CAN BE LOADED FROM MEMORY / FAC AND FOP CAN BE PUSHED/POPPED TO/FROM THE STACK / FAC CAN BE LOADED FROM FOP / FOP CAN BE LOADED FROM FAC / UNARY OPERATIONS GO FAC = OP FAC / BINARY OPERATIONS GO FAC = FAC OP FOP FAC, BSS 4 FOP, BSS 4 / LOAD (2 WORD) MEM AT (AC) TO FAC FLDA, 0 DAC T0 LAC I T0 / WORD 0 IS DAC FAC+0 / SIGN AND MS FRAC AND (377777 DAC FAC+2 ISZ T0 LAC I T0 / WORD 1 IS AND (777000 / LS FRAC AND EXCESS 400 DAC FAC+3 / EXPONENT LAC I T0 AND (777 TAD (-400 DAC FAC+1 JMP I FLDA / STORE FAC AT (2 WORD) MEM AT (AC) FSTA, 0 DAC T0 LAC FAC+0 / SIGN AND MS FRAC AND (400000 / IN WORD 0 TAD FAC+2 DAC I T0 ISZ T0 LAC FAC+1 / LS FRAC AND EXCESS 400 EXPONENT TAD (400 / IN WORD 1 TAD FAC+3 DAC I T0 JMP I FSTA / PUSH FAC ONTO STACK FPSHA, 0 LAC FAC+0 JMS PSHA LAC FAC+1 JMS PSHA LAC FAC+2 JMS PSHA LAC FAC+3 JMS PSHA JMP I FPSHA / POP STACK INTO FAC FPOPA, 0 JMS POPA DAC FAC+3 JMS POPA DAC FAC+2 JMS POPA DAC FAC+1 JMS POPA DAC FAC+0 JMP I FPOPA / MOVE FOP TO FAC FMOVA, 0 LAC FOP+0 DAC FAC+0 LAC FOP+1 DAC FAC+1 LAC FOP+2 DAC FAC+2 LAC FOP+3 DAC FAC+3 JMP I FMOVA / LOAD (2 WORD) MEM AT (AC) TO FOP FLDO, 0 DAC T0 LAC I T0 / WORD 0 IS DAC FOP+0 / SIGN AND MS FRAC AND (377777 DAC FOP+2 ISZ T0 LAC I T0 / WORD 1 IS AND (777000 / LS FRAC AND EXCESS 400 DAC FOP+3 / EXPONENT LAC I T0 AND (777 TAD (-400 / MAKE 2'S COMPLEMENT DAC FOP+1 JMP I FLDO / PUSH FOP ONTO STACK FPSHO, 0 LAC FOP+0 JMS PSHA LAC FOP+1 JMS PSHA LAC FOP+2 JMS PSHA LAC FOP+3 JMS PSHA JMP I FPSHO / POP STACK INTO FOP FPOPO, 0 JMS POPA DAC FOP+3 JMS POPA DAC FOP+2 JMS POPA DAC FOP+1 JMS POPA DAC FOP+0 JMP I FPOPO / MOVE FAC TO FOP FMOVO, 0 LAC FAC+0 DAC FOP+0 LAC FAC+1 DAC FOP+1 LAC FAC+2 DAC FOP+2 LAC FAC+3 DAC FOP+3 JMP I FMOVO / NEGATE FAC FNEG, 0 LAC FAC+2 / AVOID -0 SNA JMP FNEG1 LAC FAC+0 / FLIP SIGN XOR (400000 DAC FAC+0 FNEG1, JMP I FNEG / FLOAT AC TO FAC FFLT, 0 DAC FAC+0 / SAVE SIGN SMA / THEN FORCE POSITIVE JMP FFLT1 CMA TAD (1 FFLT1, DAC FAC+2 / CONS UP A DENORMALIZED DZM FAC+3 / FLOATING POINT NUMBER WITH THE LAC (21 / RIGHT VALUE DAC FAC+1 JMS FNAR / NORMALIZE, ROUND JMP I FFLT / FIX FAC TO AC FFIX, 0 LAC FAC+1 SPA SNA / IF EXP LE 0, THEN THERE ARE JMP FFIX3 / NO INTEGER BITS TAD (-21 SMA SZA / IF GT, DOESN'T FIT IN AN INTEGER JMP ERROV SMA JMP FFIX2 DAC T0 LAC FAC+2 FFIX1, CLL RAR / MOVE THE FRACTION BITS ISZ T0 / TO THE CORRECT SPOT IN THE JMP FFIX1 / INTEGER DAC FAC+2 FFIX2, LAC FAC+0 / GIVE THE INTEGER THE RAL / CORRECT SIGN LAC FAC+2 SNL JMP FFIX4 CMA TAD (1 JMP FFIX4 FFIX3, CLA FFIX4, JMP I FFIX / INTEGER PART OF FAC / LIKE FFIX, BUT DOES NOT DEMAND THAT THE / INTEGER PART FIT IN 18 BITS FINT, 0 LAC FAC+1 / EXP-26 TAD (-32 SMA JMP FINT2 / EXP>=26, ALL BITS SURVIVE DAC T0 / EXP<26, T0 IS ISZ COUNT FOR MASK LAC (777000 DAC T1 LAC (377777 DAC T2 FINT1, LAC T1 / SHIFT MASK LEFT BY CLL RAL / THE APPROPRIATE NUMBER OF BITS DAC T1 LAC T2 RAL DAC T2 ISZ T0 JMP FINT1 LAC T1 / FIX LO FRACTION AND FAC+3 DAC FAC+3 LAC T2 / FIX HI FRACTION AND (377777 / KILL OFF SPILL INTO SIGN AND FAC+2 DAC FAC+2 SZA JMP FINT2 DZM FAC+0 / MAKE SURE 0.0 IS POSITIVE AND LAW -400 / HAS THE CORRECT EXPONENT DAC FAC+1 FINT2, JMP I FINT / ADD FOP TO FAC FADD, 0 LAC FAC+1 / COMPUTE NEG OF DIFFERENCE CMA / BETWEEN EXPONENTS TAD (1 TAD FOP+1 SNA / IF EQ, ALIGNED JMP FADD4 DAC T0 SPA / IF GT, MISALIGNED, AND THE JMP FADD2 / NUMBER IN FAC IS THE CMA / ONE WHICH NEEDS TO SHIFT RIGHT, SO FLIP TAD (1 / FAC AND FOP DAC T0 LAC FAC+0 DAC T1 LAC FOP+0 DAC FAC+0 LAC T1 DAC FOP+0 LAC FAC+1 DAC T1 LAC FOP+1 DAC FAC+1 LAC T1 DAC FOP+1 LAC FAC+2 DAC T1 LAC FOP+2 DAC FAC+2 LAC T1 DAC FOP+2 LAC FAC+3 DAC T1 LAC FOP+3 DAC FAC+3 LAC T1 DAC FOP+3 FADD2, LAC T0 / IF CLEAR MISS, ALL DONE TAD (32 SPA JMP FADD7 FADD3, LAC FOP+2 / SHIFT FOP RIGHT BY ENOUGH CLL RAR / BITS TO ALIGN IT'S BINARY POINT WITH DAC FOP+2 / THAT OF FAC LAC FOP+3 RAR DAC FOP+3 ISZ T0 JMP FADD3 FADD4, LAC FAC+0 / SIGN-MAGNITUDE ADDITION IS XOR FOP+0 / A LITTLE UGLY SPA CLL JMP FADD5 LAC FOP+3 / IF SAME SIGNS, COMPUTE FAC+FOP TAD FAC+3 DAC FAC+3 CLA RAL TAD FOP+2 TAD FAC+2 DAC FAC+2 JMP FADD6 FADD5, LAC FOP+3 / IF DIFFERENT SIGNS, COMPUTE FAC-FOP CMA CLL TAD (1 TAD FAC+3 DAC FAC+3 LAC FOP+2 SZL CMA TAD (1 TAD FAC+2 DAC FAC+2 SMA / IF LT, FOP WAS ACTUALLY THE JMP FADD6 / LARGER NUMBER, SO NEGATE THE DIFFERENCE, LAC FAC+3 / WHICH GENERATES FOP-FAC CMA CLL TAD (1 DAC FAC+3 LAC FAC+2 SZL CMA TAD (1 DAC FAC+2 LAC FOP+0 / RESULT HAS FOP'S SIGN DAC FAC+0 FADD6, JMS FNAR / NORMALIZE, ROUND FADD7, JMP I FADD / SUBTRACT FOP FROM FAC FSUB, 0 LAC FOP+2 / AVOID MAKING -0 AND SNA / CONFUSING FAD JMP FSUB1 LAC FOP+0 / FLIP SIGN XOR (400000 DAC FOP+0 JMS FADD / ADD DOES ALL OF THE WORK FSUB1, JMP I FSUB / MULTIPLY FAC BY FOP FMUL, 0 LAC FAC+0 / RESULT SIGN XOR FOP+0 DAC FAC+0 LAC FAC+1 / RESULT EXPONENT TAD FOP+1 DAC FAC+1 LAW -32 DAC T0 LAC FAC+2 / MOVE MULTIPLICAND TO T1/T2 DAC T1 LAC FAC+3 DAC T2 DZM FAC+2 / AND CLEAR PRODUCT DZM FAC+3 FMUL1, LAC T1 / SHIFT MULTIPLICAND RIGHT CLL RAR DAC T1 LAC T2 RAR DAC T2 LAC FOP+3 / SHIFT MULTIPLIER LEFT RAL DAC FOP+3 LAC FOP+2 RAL DAC FOP+2 SMA CLL / IF LT, AN ADD IS NEEDED JMP FMUL2 LAC FAC+3 / ADD MULTIPLICAND INTO PRODUCT TAD T2 DAC FAC+3 CLA RAL TAD FAC+2 TAD T1 DAC FAC+2 FMUL2, ISZ T0 JMP FMUL1 JMS FNAR / NORMALIZE, ROUND JMP I FMUL / DIVIDE FDIV, 0 LAC FOP+3 / NEGATE DIVISOR OUTSIDE OF THE CMA CLL / DIVIDE LOOP TAD (1 DAC FOP+3 LAC FOP+2 SNA JMP ERRZD / DIVIDE BY 0 SZL CMA TAD (1 DAC FOP+2 LAC FOP+0 / RESULT SIGN XOR FAC+0 DAC FAC+0 LAC FOP+1 / RESULT EXPONENT CMA TAD (1 TAD FAC+1 DAC FAC+1 LAW -33 / 27 BITS DAC T0 LAC FAC+2 / MOVE DIVIDEND TO T1/T2 DAC T1 LAC FAC+3 DAC T2 DZM FAC+2 / AND CLEAR QUOTIENT DZM FAC+3 FDIV2, LAC FAC+3 / SHIFT QUOTIENT LEFT CLL RAL DAC FAC+3 LAC FAC+2 RAL DAC FAC+2 LAC T2 / SUBTRACT DIVISOR FROM DIVIDEND CLL TAD FOP+3 DAC T3 CLA RAL TAD T1 TAD FOP+2 SPA / GE MEANS IT GOES IN JMP FDIV3 DAC T1 / SO UPDATE DIVIDEND LAC T3 DAC T2 LAC FAC+3 / AND ADD A 1 TO THE QUOTIENT TAD (1000 DAC FAC+3 FDIV3, LAC FOP+2 / SHIFT DIVISOR RIGHT CLL CML RAR DAC FOP+2 LAC FOP+3 RAR DAC FOP+3 ISZ T0 JMP FDIV2 JMS FNAR / NORMALIZE, ROUND JMP I FDIV / COMPARE / AC<0 IF FAC0 IF FAC>FOP / IF SIGNS DIFFERENT / FAC<0 AND FOP>=0 MEANS FAC=0 AND FOP<0 MEANS FAC>FOP, FAC.SIGN =0, NEED >0 / IF SIGNS SAME / COMPARE EXPONENTS / THEN MS FRAC / THEN LS FRAC (AS UNSIGNED) FCMP, 0 LAC FAC+0 / CHECK SIGNS XOR FOP+0 SMA / IF MI, SIGNS DIFFERENT JMP FCMP1 LAC FAC+0 / GET RESULT, AVOIDING SMA / 0 IN THE TRICKY CASE NOTED ABOVE LAC (1 JMP I FCMP FCMP1, LAC FOP+1 / SIGNED COMPARE EXP CMA TAD (1 TAD FAC+1 SZA / IF EQ, NO CONCLUSION JMP I FCMP LAC FOP+2 / SIGNED COMPARE MS FRAC CMA TAD (1 TAD FAC+2 SZA CLL / IF EQ, NO CONCLUSION JMP I FCMP LAC FOP+3 / UNSIGNED COMPARE LS FRAC CMA CML TAD (1 TAD FAC+3 RAR JMP I FCMP / TEST / AC<0 IF FAC<0, AC=0 IF FAC=0, AC>0 IF FAC>0 / A LOT MORE EFFICIENT THAN FCMP / KNOWS THAT / 0.0 IS ALWAYS POSITIVE / 0.0 IS THE ONLY NUMBER WITH FAC+2 = 0 FTST, 0 LAC FAC+0 AND (400000 TAD FAC+2 JMP I FTST / NORMALIZE AND ROUND THE / NUMBER IN FAC, WHICH MAY HAVE A DATA / BIT IN [0] DUE TO OVERFLOW FNAR, 0 LAC FAC+2 / CHECK FOR 0 SAD FAC+3 SZA JMP FNAR1 DZM FAC+0 / YES, FORCE POSITIVE, AND LAW -400 / FORCE THE SMALLEST POSSIBLE EXPONENT DAC FAC+1 JMP I FNAR FNAR1, SMA / IF LT, NUMBER IS GE 1.0 JMP FNAR2 CLL RAR / SO A SINGLE RIGHT SHIFT IS ALL THAT DAC FAC+2 / IS NEEDED TO FINISH THE LAC FAC+3 / NORMALIZATION RAR DAC FAC+3 ISZ FAC+1 NOP JMP FNAR3 FNAR2, RAL / OTHERWISE SHIFT FAC LEFT UNTIL SPA / BIT [1] IS A 1 JMP FNAR3 LAW -1 TAD FAC+1 DAC FAC+1 LAC FAC+3 CLL RAL DAC FAC+3 LAC FAC+2 RAL DAC FAC+2 JMP FNAR2 FNAR3, LAC FAC+3 / ROUND BY ADDING A 1 CLL / JUST BELOW TAD (400 / THE LOWEST BIT WE ACTUALLY AND (777000 / RETAIN IN THE RESULT DAC FAC+3 CLA RAL TAD FAC+2 DAC FAC+2 SMA / IF LT, THE ROUND DENORMALIZED JMP FNAR4 / THE RESULT, BUT A SINGLE CLL RAR / RIGHT SHIFT IS ALL THAT IS NEEDED DAC FAC+2 / TO FIX THINGS LAC FAC+3 RAR AND (777000 DAC FAC+3 ISZ FAC+1 NOP FNAR4, LAC FAC+1 / [-256, 255] IS THE LEGAL RANGE TAD (400 / FOR THE EXPONENT AND (777000 SZA JMP ERROV / USED FOR UNDERFLOW TOO JMP I FNAR / VARIABLES TTXT, BSS 1 / TOP OF TEXT TVAR, BSS 1 / TOP OF VARIABLES COL, BSS 1 / CURRENT OUTPUT COLUMN LNO, BSS 1 / LINE NUMBER, GENERATED BY ENC LLEN, BSS 1 / LINE LENGTH, GENERATED BY ENC T0, BSS 1 / GENERAL TEMPORARIES T1, BSS 1 T2, BSS 1 T3, BSS 1 T4, BSS 1 T5, BSS 1 T6, BSS 1 T7, BSS 1 T8, BSS 1 T9, BSS 1 T10, BSS 1 T11, BSS 1 LP, BSS 1 / CURRENT LINE, 0 IF DIRECT MODE CP, BSS 1 / CURRENT CHARACTER POINTER (2*ADDRESS) C, BSS 1 / CURRENT CHARACTER VAR, BSS 1 / POINTER TO CURRENT VARIABLE SYM, BSS 2 / CURRENT SYMBOL SYMSUB, BSS 2 / 2 WORDS, SUBSCRIPTS FOR CURRENT SYMBOL SYMSIZ, BSS 2 / 2 WORDS, SIZES FOR CURRENT SYMBOL RNDS, BSS 1 / RANDOMIZE SEED GETIX, BSS 1 / KBD RING POINTERS GETOX, BSS 1 GETB, BSS NGETB / KBD BUFFER CMDB, BSS NCMDB / COMMAND LINE BUFFER (ALSO USED FOR INPUT) GSTKP, BSS 1 / GOSUB STACK POINTER GSTK, BSS 3*NGSTK / GOSUB STACK STKP, BSS 1 / PUSH/POP STACK POINTER STK, BSS 1+NSTK / PUSH/POP STACK GCP, BSS 1 / LINKS TO C AND ADV FOR FGET GADVP, BSS 1 IC, BSS 1 / FOR INPUT ICP, BSS 1 RLP, BSS 1 / FOR READ RCP, BSS 1 RC, BSS 1 FSTKP, BSS 1 / FOR STACK POINTER FSTK, BSS 10*NFSTK / FOR STACK / KEYWORD TABLE TDATA=200 TGOTO=207 TTHEN=226 TGE=230 TLE=231 TNE=232 TTO=227 TSTEP=224 TAND=234 TOR=235 TNOT=236 TFN=237 TTAB=240 TSPC=241 TSGN=242 TRND=243 TSQR=244 TABS=245 TINT=246 TSIN=247 TCOS=250 TATN=251 TLOG=252 TEXP=253 TTAN=254 KTAB, 104 / 200 DATA 101 124 101 0 104 / 201 DEF 105 106 0 104 / 202 DELETE 105 114 105 124 105 0 104 / 203 DIM 111 115 0 105 / 204 END 116 104 0 106 / 205 FOR 117 122 0 107 / 206 GOSUB 117 123 125 102 0 107 / 207 GOTO 117 124 117 0 111 / 210 IF 106 0 111 / 211 INPUT 116 120 125 124 0 114 / 212 LET 105 124 0 114 / 213 LIST 111 123 124 0 116 / 214 NEW 105 127 0 116 / 215 NEXT 105 130 124 0 120 / 216 PRINT 122 111 116 124 0 122 / 217 READ 105 101 104 0 122 / 220 REM 105 115 0 122 / 221 RESTORE 105 123 124 117 122 105 0 122 / 222 RETURN 105 124 125 122 116 0 122 / 223 RUN 125 116 0 123 / 224 STEP 124 105 120 0 123 / 225 STOP 124 117 120 0 124 / 226 THEN 110 105 116 0 124 / 227 TO 117 0 76 / 230 >= 75 0 74 / 231 <= 75 0 74 / 232 <> 76 0 122 / 233 RANDOMIZE 101 116 104 117 115 111 132 105 0 101 / 234 AND 116 104 0 117 / 235 OR 122 0 116 / 236 NOT 117 124 0 106 / 237 FN 116 0 124 / 240 TAB 101 102 0 123 / 241 SPC 120 103 0 123 / 242 SGN 107 116 0 122 / 243 RND 116 104 0 123 / 244 SQR 121 122 0 101 / 245 ABS 102 123 0 111 / 246 INT 116 124 0 123 / 247 SIN 111 116 0 103 / 250 COS 117 123 0 101 / 251 ATN 124 116 0 114 / 252 LOG 117 107 0 105 / 253 EXP 130 120 0 124 / 254 TAN 101 116 0 NTOKEN=55 LIT / THE SOURCE PROGRAM BEGINS AT LOCATION BMEM / THE INITIALIZATION CODE ALSO BEGINS AT LOCATION BMEM / WHERE IT IS OVERWRITTEN BY THE SOURCE PROGRAM / BASIC CANNOT BE RESTARTED, JUST RELOADED BMEM, IOF / JUST TO BE VERY SAFE EEM / ENABLE EXTEND (NOP IF NOT INSTALLED) KRB / KBD FLAG = 0 CLA / TTY FLAG = 1 TLS DZM GETIX / CLEAR GLOBALS DZM GETOX DZM COL DZM LP DZM RNDS LAC (BMEM / CLEAR TEXT BUFFER DAC TTXT JMS CLR / CLEAR GOTO STACK, FOR STACK, VARIABLES JMS CSTK / CLEAR PUSH/POP STACK LAC (RNDX / IN CASE RND() GETS CALLED BEFORE JMS SFRND / THE FIRST RUN COMMAND LAC (BMSG1-1 / SAY HELLO DAC X0 BMEM1, LAC I X0 SNA JMP BMEM2 JMS PUTC JMP BMEM1 BMEM2, LAC (TMEM-BMEM / SAY FREE MEMORY SIZE JMS PUTDEC LAC (BMSG2-1 DAC X0 BMEM3, LAC I X0 SNA JMP BMEM4 JMS PUTC JMP BMEM3 BMEM4, JMP CMD BMSG1, "P / HELLO MESSAGE "D "P "- "4 "/ "X 40 "B "A "S "I "C 40 "0 "6 40 "D "G "C 40 "2 "4 "- "J "U "N "- "2 "0 "0 "1 15 12 0 BMSG2, 40 / FREE MEMORY SIZE MESSAGE "W "O "R "D "S 40 "F "R "E "E 15 12 0 LIT / END