/PATCHES TO FOCAL ITSELF ! FIELD 1 *0 SETUP, GETC /MOVE PAST THE COMMA TAD ONFLAG SORTJ /CHECK COMMAND CODE COMLST-1 SETGO-COMLST SETGO, SET /MULTIPLE SET COMMAND FINCR /STANDARD FOR COMMAND *PDLXR RESTOR-1 /INITIALIZE STACK POINTER *16 ZBLOCK 1 //FREE INDEX REGISTER *PC PC0 *PACKST RESTOR-1 RNDM //FRAN INITIALIZATION *34 ZBLOCK 4 //FREE LOCATIONS *FLAC 2 3110 /LOAD 'PI' 3755 2421 *FISW 0 /SET TO FLOATING OUTPUT *57 INBUF, 0 /MOVED TO SAVE A WORD LINE1 *INDEV XI33 /PATCHED FOR 'FRAN' GINC, WORDS+2 //INTERCHANGE GINC & NAGSW *70 NAGSW, 1 //FOR CONVENIENCE OF FSF'S *72 MCOM, -", //USEFUL CONSTANT ON PAGE ZERO NOW LIST6, 214 /F.F. (^L) 207 /BELL LIST7=. *102 M12, -12 /DECIMAL CONVERSION CONSTANT *110 //REPLACE 'P277', 'M2' & 'MINUSA' P13, 13 C100, 100 FLOAT=JMP I . /FOR USER FUNCTIONS FIN+2 *117 M4, -4 /USED BY 'GETARG','^',& 'FRAN' *126 M40, -40 /FOR 'GETLN', 'GETC', & 'RECOVR' *132 FP0, FLTZER /MOVED FOR ^L FUDGE LINE0 END, STVAR //PATCH THIS WHEN ADDING FUNCTIONS! LINE1 *137 POPA=JMS I . /REDEFINE SOME NEW INSTRUCTIONS XPOPA PUSHJ=JMS I . XPUSHJ POPJ=JMP I . XPOPJ PUSHA=JMS I . XPUSHA PUSHF=JMS I . PD2 POPF=JMS I . PD3 *146 PACKC=JMS I . PACBUF *151 OUT ECHO, CHIN /ENTRY POINT IS USED FOR 'INSUB' *154 GETLN=JMS I . XGETLN //MAY BE CALLED RECURSIVELY *166 TABCNT, ERR2 /ERROR ENTRY IS ALSO TAB COUNTER DPC, PCD /(TAD I PC) - 8K SUBROUTINES DTHIS, THISD /(TAD I THISLN) DPT1, PT1D /(TAD I PT1) DXRT, XRTD /(TAD I XRT) DAXIN, AXIND /(DCA I AXIN) FCHECK, TESTF //FOCAL STATEMENT FUNCTIONS TOP, FEXP-WORDS-2 /ADJUSTED BY THE INITIAL DIALOG RECOVR-2 /MANUAL RESTART ENTRY POINT *201 TAD C100 /INITIALIZE PC *211 JMS I ECHO /SHOULD WE PRINT A '*'? *212 TAD BUFR /COMMAND INPUT BUFFER *215 TAD BOTTOM /INPUT LIMIT DCA PACKST *221 LIST7-1 /MOVED DOWN ONE INLIST-LIST7 *226 BOTTOM, RESTORE-1 /(OR PCHK-1) - START OF PDL *231 TAD BUFR /INITIALIZE FOR UNPACKING *235 TAD TXTEND /THE LAST WORD! DCA PACKST *241 JMP GZERR /GROUP 0 ERROR *245 STL RAR /'TAD P4000' TAD NAGSW //NAGSW MOVED *255 JMS I DAXIN /DCA I AXIN *273 JMS I DPC /TAD I PC *302 TXTEND, 3576 /(OR 5576 W/O FILE COMMANDS) EJECT /ROUTINE TO EVALUATE A LINE NUMBER - "GETLN" XGETLN, 0 TAD .-1 /PERMIT RECURSIVE CALLS PUSHA /& DIFFERENT ENTRY POINT PUSHJ /EVALUATE ARGUMENT EVAL FIXIT /FIX FLAC AND SET AC TAD M40 /MINUS THIRTY-TWO SMA CLA ERROR2 /BAD GROUP NUMBER TAD LORD /GET GROUP AGAIN RTL6 /SHIFT INTO PLACE RAL DCA LINENO /FIRST PART IS DONE NEGATE /INTEGER PART FENT FADD I FLARGP /SUBTRACT INTEGER FMUL FL100 /INCREASE FRACTION FADD FLP5 /ROUND OFF BINARY ARITHMETIC FEXT FIXIT /FIX THIS PART NOW CLL SZA CLA JMP .+5 /NOT GROUP OR ALL TAD LINENO SNA CLA /WAS IT ALL ? STL IAC /YES: LINK & NAGSW = 1 JMP .+7 /GROUP: LINK & NAGSW = 0 TAD LINENO SNA GZERR, ERROR2 /GROUP ZERO IS ILLEGAL TAD LORD /COMBINE GROUP & STEP NUMBERS DCA LINENO STL RAR /SET NAGSW=4000 & CLEAR LINK DCA NAGSW POPJ /LINK=1 IF "ALL" FL100, 7 3100 0 FLP5, 0 2000 0 0 EJECT /LIST OF FUNCTION ADDRESSES (NAMES ARE IN "FNTABL") FNTABF=. ERROR5 /COM -COMMON STORAGE XSQRT /SQT -SQUARE ROOT FSGN /SGN -SIGN (OMSI VERSION) FABS /ABS -ABSOLUTE VALUE FITR /ITR -INTEGER VALUE FRAN /RAN -RANDOM NUMBER (OMSI) FSIN /SIN -TRIG FUNCTIONS FOR FCOS /COS -ANGLES IN RADIANS ARTN /ATN -USE PI TO CONVERT FLOG /LOG -LOGARITHM (BASE E) FEXP /EXP -EXPONENTIAL (BASE E) /END OF BASIC NUMERICAL FUNCTIONS - REMAINDER DO I/O FIN /IN -SINGLE CHARACTER INPUT FOUT /OUT -SINGLE CHARACTER OUTPUT FIND /IND -CHARACTER SEARCH FLEN /LEN -FILE LENGTH ERROR5 /ADC -ANALOG INPUT ERROR5 /DAC -ANALOG OUTPUT ERROR5 /DVM -DIGITAL VOLTMETER ERROR5 /DIS -OSCILLOSCOPE DISPLAY /ADDITIONAL FUNCTIONS - TABLE CROSSES PAGE BOUNDARY ERROR5 /CNT -FREQUENCY COUNTER ERROR5 /SYN -FREQUENCY SYNTHESIZER ERROR5 /REQ -FREQUENCY GENERATOR ERROR5 /TIM -TIME OF DAY (CLOCK) ERROR5 /TRG -SCHMITT TRIGGERS ERROR5 /POT -POTENTIOMETERS ERROR5 /SWS -SENSE SWITCHES ERROR5 /RLY -RELAY REGISTER ERROR5 /PSD -DIGITAL LOCK-IN ERROR5 /AVR -SIGNAL AVERAGER ERROR5 /FFX -FAST FOURIER TRANSFORM /NOTE: THE ORIGINAL CODE FOR 'FADC' AND 'FDIS' REMAINS AND /USERS WITH THE APPROPRIATE HARDWARE MAY PUT THE ADDRESSES /IN THE TABLE IN PLACE OF 'ERROR5': FADC=1343 & FDIS=1142. /CHANGES TO "DO" DUE TO MOVING NAGSW & GINC FOR F FUNCTIONS /ALSO HANDLES MULTIPLE CALLS IN ONE COMMAND: DO 5.1,4,12.9 *420 DO, TAD DOEXIT /SET UP NORMAL EXIT PUSHA GETLN *426 CHAR //SAVE CHAR,LINENO,NAGSW (AND T2) TAD NAGSW *436 JMS I DXRT /TAD I XRT *444 CHAR JMS I DPC *452 TAD NAGSW *460 JMS I DPT1 /TAD I PT1 *455 JMS I DPT1 /TAD I PT1 *470 CHAR *473 TAD CHAR /CHECK FOR ADDITIONAL CALLS TAD MCOM SZA CLA POPJ /EXIT "DO" GETC /MOVE PAST COMMA JMP DO+2 /'DO' ANOTHER ONE! DOEXIT, PROC EJECT /PUSH DOWN LIST SUBROUTINES - STACK IN FIELD 0 XPUSHA, 0 CDI JMP I .+2 JMP I XPUSHA APUSHX XPUSHJ, 0 CLA IAC TAD XPUSHJ /BUMP RETURN ADDRESS JMS XPUSHA /SAVE IT ON THE STACK TAD I XPUSHJ /GET THE ADDRESS DCA XPUSHJ /INDIRECT INDIRECT! JMP I XPUSHJ XPOPA, 0 CDF TAD I PDLXR CDF 10 JMP I XPOPA RETRN, TAD C100 /R COMMAND DCA PC XPOPJ, JMS XPOPA DCA XPOPA JMP I XPOPA PD2, 0 /PUSHF TAD PD2 CDI DCA I .+3 CDF 10 /RESET CALLING FIELD JMP I .+2 /FAKE A JMS MPD2 MPD2+1 PD3, 0 /POPF CLA CMA TAD I PD3 ISZ PD3 DCA XRT JMS XPOPA /DUMP FOUR WORDS DCA I XRT JMS XPOPA DCA I XRT JMS XPOPA DCA I XRT JMS XPOPA DCA I XRT JMP I PD3 EJECT INPUT, 0 /RELOCATED TO EXPAND COMMANDS TAD I ECHO /READS FROM KEYBOARD OR TEXT SZA CLA /WHICH ONE? JMP .+3 GETC /TEXT JMP I INPUT READC /KEYBOARD SORTJ SPECIAL-1 /_,RO,LF,ALT,^L INFIX-SPECIAL JMP I INPUT INLIST=. *575 FINFIN /; SHORT FORM FLIMIT-1 /CR SETUP /, CHECK S,F *622 DCA ONFLAG /SAVE CODE - CLEAR FLAG *630 TAD ONFLAG SORTJ /COMMAND BRANCH POINT COMLST-1 COMGO-COMLST WRITE=.+1 *652 JMS I DTHIS /TAD I THISD *657 TAD NAGSW //NAGSW MOVED *661 JMS I DPT1 /TAD I PT1 *664 JMS I DPT1 /TAD I PT1 *673 TAD NAGSW *756 GETC /X COMMAND - FOR I/O AND XECUTE, PUSHJ /FOCAL STATEMENT FUNCTIONS EVAL SORTJ GLIST ELIST-GLIST-1 JMP XECUTE ELIST, XECUTE-1 PROCESS PC1 /FOCAL COMMAND CODES: THERE ARE FOUR NEW COMMANDS! COMLST=. "S /SET "F /FOR "D /DO "I /IF "O /ON "G /GOTO "Z /ZERO "R /RETURN "X /XECUTE "C /COMMENT "L /LIBRARY "A /ASK "T /TYPE "W /WRITE "M /MODIFY "E /ERASE "Q /QUIT LF /STAR LF /STAR *1017 CMA CLL RAL /'TAD M2' *1027 JMS I MCR /PATCH "IF" *1032 ILIST-TLIST /ILIST MOVED *1045 TAD MEQ /MOVED *1054 POPA *1070 EVAL /ADD 1 /CHANGES TO "FOR" FOR NEGATIVE INCREMENTS & FASTER LOOPING: *1112 LIMIT, BUFFER /LEAVE FLARG ALONE POPF FLAC /LOAD INCREMENT POPA DCA PT1 /VARIABLE POINTER GETSGN DCA T3 /SAVE SIGN OF INCREMENT FENT FADD I PT1 /INCREMENT LOOP INDEX FPUT I PT1 /AND SAVE IT AGAIN FSUB I LIMIT /COMPARE WITH LIMIT FEXT TAD T3 /SET PROPER SIGN SPA CLA NEGATE GETSGN /NOW TEST IT SMA SZA CLA POPJ /END OF LOOP TAD M16 /EFFECTIVE PUSHDOWN FOR TAD PDLXR /PT1, INCREMENT, LIMIT, DCA PDLXR /TEXTP, AND PUSHJ PROC. JMP I FPROC /CONTINUE LOOP M16, -16 MEQ, -"= FDIS=. /ORIGINAL DISPLAY FUNCTION *1145 TAD MCOM /MCOM MOVED TO PAGE ZERO *1155 POPA *1157 RETURN /CLEARS AC IF NON-ZERO /COMMAND BRANCH POINTS: COMGO=. SET FOR DO IF ON GOTO ZERO RETRN XECUTE COMMENT LIB ASK TYPE WRITE MODIFY ERASE QUIT STAR STAR /CHANGES TO "ASK" "TYPE" & "MODIFY" *1203 PUSHJ /EVALUATE EXPRESSION EVAL JMS I FOUTPUT /PRINT RESULT TYPE, DCA ATSW /NEW ATSW TASK, SORTJ /!,",#,$,%,: ? ALIST-1 ATLIST-ALIST ISZ ATSW /"ASK" OR "TYPE" ? JMP TYPE-3 PUSHJ /LOOKUP VARIABLE GETARG TAD CHAR /SAVE NEXT CHARACTER DCA ATSW TAD ALIST /GET ":" ISZ I ECHO /'JMS I ECHO' TO PRINT IT CLA IAC JMS I FINPUT /READ A NUMBER TAD ATSW DCA CHAR /RESTORE CHARACTER ASK, CMA JMP TYPE /SET ATSW TCRLF, TAD CCR /'!'=CR AND LF PRINTC TASK4, DCA DEBGSW /RE-ENABLE TRACE GETC /MOVE ALONG JMP TASK FORMAT, GETC /MOVE PAST '%' GETLN /GET FORMAT TAD LINENO DCA FISW /SAVE FOR LATER JMP TASK SPLAT, TAD CCR /'#'=CR W/O LF JMS I OUTDEV DCA I TABCNT /RESET TAB COUNTER TAD C200 /GET NULL FOR DELAY JMP TCRLF+1 ATSW= ONFLAG EJECT /NEW MODIFY COMMAND - ALSO PERMITS 'MOVING' LINES: /IF A SECOND LINENO IS GIVEN (SEPARATED BY A COMMA) THE /MODIFIED LINE WILL BE SAVED WITH A NEW NUMBER, LEAVING /THE OLD LINE UNCHANGED. MODIFY, GETLN /READ THE FIRST LINENO SORTC /CHECK FOR A SECOND ONE COMMA-1 GETC /MOVE PAST COMMA PUSHJ /OTHERWISE 'EVAL' GIVES ZERO EVAL TAD BUFR /SET 'TEXTP' DCA AXIN FINDLN /LOOK UP OLD LINE ERROR2 /NOT THERE DCA XCTIN GETSGN SZA CLA /NEW LINENO? PUSHJ /YES: SET IT UP XGETLN+5 TAD LINENO JMS I DAXIN /PACK IT ISZ DEBGSW /DISABLE TRACE & PROTECT LINENO SCONT, JMS I INDEV /GET SEARCH CHARACTER (SILENTLY) DCA DMPSW *1277 LISTGO-LIST3 /LISTGO HAS MOVED *1310 LIST6-1 SRNLST-LIST6 *1354 QUOTE, ISZ DEBGSW /DISABLE TRACE GETC SORTJ /" OR CR TLIST2-1 TLIST3-TLIST2 PRINTC JMP QUOTE+1 SRNLST, 1273 SCONT 1302 /MOVE UP ONE TO ADD TAB SCONT+1 LISTGO, 0261 1312 ALIST, ": /ADDED FOR TAB /CHANGES TO GETARG FOR DOUBLE SUBSCRIPTING, FASTER LOOKUP, /THE ZERO COMMAND AND ZERO-VARIABLE REPLACEMENT. *1411 TAD ADD /SAVE NAME DCA EFOP /WHERE WE CAN PUSH IT GETLP, GETC /GET NEXT CHAR SORTC /END OF NAME? TERMS-1 JMP GSERCH /YES ISZ XCTIN /IS THIS THE SECOND CHAR JMP GETLP /IGNORE ADDITIONAL CHARS TAD CHAR /PACK SECOND CHAR AND P77 /MASK IT JMP GETLP-2 /ADD TO NAME GSERCH, TSTLPR /CHECK FOR SUBSCRIPT JMP GS1 JMS I GECALL /PICK IT UP JMS I LOOK42 /CHECK FOR SECOND SUBSCRIPT GS1, DCA SUBS /SAVE SUBSCRIPT TAD EFOP /INSERT NAME AT END OF TABLE DCA I LASTV /TO MAKE SURE THAT IT IS FOUND TAD .+2 /BEGIN WITH 'SECRET' VARIABLES JMP GLOOP+2 STVAR-1 CMA /BACKUP TO NAME GLOOP, TAD XRT TAD XINC /ADVANCE TO NEXT ONE DCA XRT TAD I XRT /COMPARE NAMES CIA TAD EFOP SZA CLA JMP GLOOP /TRY AGAIN TAD XRT /END OF TABLE ? CIA TAD LASTV SNA CLA JMP MAKVAR /YES: ADD NEW VARIABLE TAD I XRT /NO: CHECK FOR SUBSCRIPT MATCH CIA TAD SUBS SZA CLA JMP GLOOP-1 /NOT THIS ONE GEXIT, STL IAC /FOUND: POINT TO DATA TAD XRT DCA PT1 POPJ /LINK=1 EJECT ZLOOP, SNL CLA /ORGANIZED TO RETAIN ERROR CODE ERROR2 /STORAGE FULL TAD I XRT /IS THIS ONE ZERO? SNA CLA JMP ZFOUND /YES TAD XRT TAD XINC ZSERCH, DCA XRT /POINT TO MANTISSA TAD XRT /CHECKED THEM ALL YET? CLL CMA TAD LASTV JMP ZLOOP MAKVAR, TAD TOP /TEST FOR OVERFLOW CLL CIA TAD LASTV SZL CLA JMP ZINITL /REPLACE A ZERO VARIABLE TAD LASTV /UPDATE STORAGE LIMIT TAD GINC DCA LASTV TAD SUBS /INSERT SUBSCRIPT DCA I XRT SET20, DCA I XRT /ZERO DATA TAD XRT DCA PT1 /SET POINTER JMP ZEXIT SUBS=. *1527 ZEXIT, DCA I XRT DCA I XRT DCA I XRT /(POPJ) FOR 3 WORD VERSION POPJ /LINK=0 *1546 TAD SORTCN /SAME RESULT TAD M11 /WITHOUT M271 *1553 ZINITL, STL RTL TAD END /INITIALIZE X-REGISTER JMP ZSERCH ZFOUND, TAD M4 /POINT TO NAME TAD XRT DCA XRT TAD EFOP DCA I XRT /REPLACE THE NAME JMP SET20-2 /AND THE SUBSCRIPT XINC, WORDS+1 GECALL, ECALL LOOK42, TEST42 *1567 ATLIST, XTAB /FOR : ADDITION FORMAT /% QUOTE /" TCRLF /! SPLAT /# TDUMP /$ TASK4 /SP TASK4 /, PAGE *1626 /'EVAL' FOUND A TERMINATOR WHICH IS JMP 1650 /NOT AN OPERATOR->END OF EXPRESSION TAD FP0 /POINT TO 0 FOR MISSING OPERANDS DCA PT1 CMA CLL RAL /'TAD M2' *1705 POPA *1736 DCA I ECHO /CLEAR FLAG *1757 POPA *1757 JMS I FCHECK /CHECK FN NAME FOR ZERO SORTJ /FUNCTION FINDER - NEW TABLES FNTABL-1 FNTABF-FNTABL *2010 FIN, READC /SINGLE CHARACTER INPUT TAD CHAR DCA HORD /FLOAT ROUTINE DCA LORD TAD P13 /SET PROPER EXPONENT DCA FLAC DCA OVER2 EFUN3, FENT /END OF FUNCTION CALLS FNOR FLAC /LET NORMALIZE SAVE FLAC *2050 POPA *2053 POPA *2077 DCA T3 /NUMBER OF WORDS TO DELETE *2105 CDF /CHANGE DATA FIELD FOR 'DELETE' *2122 TAD T3 *2132 TAD T3 *2136 TAD T3 *2146 TAD T3 EJECT /LIST OF CODED FUNCTION NAMES (ADDRESSES ARE IN "FNTABF") *2155 FNTABL=. 2567 /COM 2702 /SQT 2650 /SGN 2533 /ABS 2636 /ITR 2630 /RAN 2654 /SIN "PLT"="SIN" 2575 /COS 2572 /ATN 2625 /LOG 2624 /EXP "INT"="EXP" 1140 /IN 2672 /OUT 2604 /IND "FCRT=FIND" 2610 /LEN 2517 /ADC 2525 /DAC 2611 /DVM 2565 /DIS "AVE"="DIS" 2574 /CNT 2714 /SYN 2643 /REQ 2657 /TIM "NUM"="TIM" 2673 /TRG 2662 /POT 2715 /SWS 2671 /RLY 2652 /PSD "SET"="PSD" 2602 /AVR 1144 /FFX "FFT"="FIN" /ERASE COMMAND IS ONLY FOR TEXT - USE ZERO FOR VARIABLES ERASE, PUSHF /GET NULL FOR HEADER FLTZER GETLN /WHICH LINE ? SNL /ALL ? JMP ERL /ERASE LINES OR GROUPS ERA, TAD ENDT /ERASE ALL DCA BUFR CDF /TEXT IS IN FIELD 0 DCA I CFRS /PLACE ZERO IN FIRST LINE CDI JMP NONAME /UPDATE HEADER ERL, TAD BUFR /PROTECT REST OF TEXT DCA AXIN ERG, DELETE /EXTRACT GIVEN LINE ISZ THISLN /ADVANCE ONE LINE TAD NAGSW /GROUP OPERATION? SMA CLA /SKIP IF SINGLE LINE JMS I DTHIS /TAD I THISLN TSTGRP /DONE ERASING GROUP? JMP ERA+4 /YES: ERASE PROGRAM FLAG JMS I DTHIS /UPDATE LINE NUMBER DCA LINENO JMP ERG /CONTINUE *2253 JMS I DXRT /TAD I XRT *2262 JMS I DTHIS /TAD I THISLN EJECT /CHANGES TO 'GETC' TO TURN "@" INTO A "SPACE". *2276 UTRA=.-2 UTE, SPA /DON'T CLEAR AC TAD C100 /300-377 & 340-376 TAD M77 /240-276 & 200-236 SNA JMP UTX /"?" FOUND UTQ, TAD P337 DCA CHAR TAD DEBGSW TAD DMPSW SNA CLA /PRINT ONLY IF BOTH ARE ZERO PRINTC JMP I UTRA /RETURN EXTR, JMS GET1 SMA /REVERSE TESTING AT 'UTE' JMP UTE+1 JMP UTE+2 UTX=. *2326 TAD M40 JMP UTQ GET1, 0 /UNPACK 6 BITS ISZ XCT /WHICH HALF ? JMP GET3 GEND=.+1 *2341 JMP EXTR TAD CHAR /BITS 6-11 ONLY SZA /ADD 40 IF ZERO TAD M40 JMP I GET1 /RETURNS TO UTE OR EXTR+1 GET3, CDF TAD I AXOUT CDF 10 DCA GTEM CMA DCA XCT TAD GTEM RTL6 /'BSW;NOP' FOR 8/E RAL JMP GEND *2361 CDF /CHANGE TO TEXT FIELD *2374 DCA I P77 /WE'VE ADDED A NEW LINE: KILL CDF 10 /'CURRENT PROGRAM SAVED' FLAG *2377 TLIST3, TASK4 *INFIX+1 INPUT+1 /RO INPUT+1 /LF *INFIX+4 INPUT+1 /^L FLTONE, 0001 /ALL THIS MUST BE MOVED DOWN ONE 2000 FLTZER, 0000 0000 0000 0000 ILIST, IF1 /, LIST MOVED TO EXPAND COMMANDS PROCESS /; PC1 /CR TERMER, 0 /COMMAND WORD SORT SORTC GLIST-1 ISZ TERMER /2ND EXIT = FOUND CDI JMP I TERMER *2432 CMA CLL RAL /GENERATE A "." JMS I ODG *2436 TAD M140 /PSEUDO SPACE *2453 TAD M12 /PATCH 'PRNT' *2466 OUT, 0 /"PRINTC" SNA /USE AC IF NON-ZERO TAD CHAR /OTHERWISE USE CHAR TAD MCR CIF JMS I .-1 /ADJUST TAB COUNTER JMS I OUTDEV /NORMAL RETURNS JMP I OUT JMS I OUTDEV /CARRIAGE RETURNS ! TAD CLF JMP .-4 ODG, OUTDG EJECT -"? PACBUF, 0 /CHANGES TO 'PACKC' TO SAVE FIVE WORDS TAD .-2 *2507 TAD P40 *2512 JMP I RUBIT TAD P377 *2516 P377, AND (140 /DOUBLE DUTY TAD M140 SZA TAD (140 M140, SZA CLA JMP PA1 TAD P77 /200-237 & 340-377 JMS PCK1 PA1, TAD T2 /240-337 AND P77 SZA /OMIT 300 JMS PCK1 PACX, CDF 10 JMP I PACBUF RUBIT, RUB1 PCK1=. *2541 JMS AXIND /DCA I AXIN P40, 40 DCA ADD TAD PACKST /CHECK LIMIT CLL CIA *2552 AXIND, 0 /8K PATCH CDF DCA I AXIN CDF 10 JMP I AXIND *2564 CHIN, 0 /'READC' (IF AC=0) SNA /'ECHO' IF AC NON-ZERO JMS I INDEV DCA CHAR SORTJ /PRESERVES 'SORTCN' ECHOLST-1 /FOR FUNCTION CALLS ECHOGO-ECHOLST IECHO, PRINTC /'ION' IF NOT ECHOING JMP I CHIN ECHOGO, .-1 /DON'T ECHO .-2 /LF OR R.O. PAGE /INTERRUPT PROCESSOR: CHANGES FOR ^F AND ^C M3, -3 /KEYBOARD KONSTANT INTRPT, DCA SAVAC /SAVE WORKING REGISTERS RAR DCA SAVLK TINT, TSF /CHECK OUTPUT FIRST WHILE DF=0 JMP KINT TCF DCA TELSW /TURN OFF THE IN-PROGRESS FLAG TAD I OPTRI /I/O BUFFER IS IN FIELD 0 NOW SNA JMP KINT /DONE TPC /TYPE NEXT CHARACTER DCA TELSW /CLEAR AC & TURN ON THE FLAG DCA I OPTRI /ZERO OUT THE DATA JUST USED TAD OPTRI /GET POINTER AND IAC /ADVANCE MODULO 16 AND P17 /(CIRCULAR BUFFER) TAD OPTR0 /ADD START DCA OPTRI /NEW POINTER KINT, KSF /NOW CHECK KEYBOARD JMP XINT KRS /READ BUFFER AND P177 /IGNORE PARITY SNA /LEADER/TRAILER ? JMP XINT-1 TAD M3 SNA /TEST FOR CTRL C JMP MINT TAD M3 SNA /TEST FOR CTRL F JMP RECOVR TAD CTRLF /RESTORE DCA XI33+1 /SAVE AND KILL ISZ TAD INBUF SZA CLA /TEST FOR OVERFLOW ERROR2 TAD XI33+1 /'ZBLOCK 2' FOR 8/E DCA INBUF KCC /CLEAR BUFFER XINT, JMP .+3 /CDI ?0 -PATCH FOR OTHER ZBLOCK 2 /JMP I .+1 -INTERRUPT SERVICE /?INT -IN ANY FIELD TAD SAVLK CLL RAL TAD SAVAC CDI JMP 4 /RE-ENABLE INTERRUPT SYSTEM MINT, CDI JMP I P7600 /MONITOR = 07600 /TTY INTERUPT I/O HANDLERS: /OUTPUT BUFFER HAS BEEN MOVED AND THE INPUT /IS MODIFIED SO AS TO INCREMENT A RANDOM NO. XI33, 0 /VIA (INDEV) ISZ I PT1 /BUMP RANDOM NUMBER TAD INBUF /ANY INPUT? SPA SNA /YES AND NON-ZERO RNDM NO. JMP .-3 /NO OR ZERO RANDOM NUMBER DCA XI33+1 /SAVE TEMPORARILY CTRLF, 206 /'KCC' FOR 8/E DCA INBUF /CLEAR INPUT BUFFER TAD XI33+1 /PLACE CHARACTER IN AC JMP I XI33 OPTR0, IOBUF OPTRI, IOBUF OPTRO, IOBUF XOUTL, 0 /VIA (OUTDEV) DCA XI33 /SAVE CURRENT CHARACTER CDF ION /BE SURE INTERRUPT IS ON TAD I OPTRO /ANY ROOM? SZA CLA /A CHARACTER IS NON-ZERO JMP .-2 /NO = WAIT IOF TAD TELSW /IN PROGRESS? SZA CLA JMP .+5 /YES TAD XI33 /NO TLS /TYPE CHARACTER DCA TELSW /SET IN-PROGRESS FLAG JMP .+10 /RETURN TAD XI33 /PUT DATA IN EXTRA DCA I OPTRO /BUFFER SPACE TAD OPTRO /ADVANCE POINTER IAC /MODULO 16 AND P17 /(CIRCULAR STORE) TAD OPTR0 /ADD BEGINNING DCA OPTRO /NEW VALUE ION CDF 10 JMP I XOUTL SAVAC, 0 SAVLK, 0 TELSW, 0 EJECT /ERROR RECOVERY ROUTINE - REWRITTEN TO PROVIDE FOR /PROPER RESTARTING OF LOW SPEED READER AS WELL AS /MANUAL RESTARTS. ERROR5, DCA ERR2 /TABLE ERROR ERR2, 0 /TAB COUNTER TOO ! ION TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA JMP .-2 CMA TAD ERR2 /PREPARE ERROR CODE JMP RECOVR+1 RECOVX, TAD M40 /CREATE A "?" PRINTC PRNTLN /FOLLOWED BY ERROR CODE ISZ PC JMS I DPC /GET PROGRAM STEP SNA JMP .+6 /DIRECT COMMAND ERROR DCA LINENO TAD P7700 PRINTC /ATSIGN PRINTC /SPACE PRNTLN /LINE NO. TAD CCR PRINTC JMP START DCA TELSW /CLEAR BUSY FLAG SKP CLA /MANUAL RESTART = ?00.00 RECOVR, TAD C200 /KEYBOARD BREAK = ?01.00 DCA LINENO CDI /DISABLE INTERRUPTS AND SET DF KCC DCA INBUF /CLEAR INPUT BUFFER TAD OPTR0 /RESET OUTPUT POINTERS DCA OPTRI TAD OPTR0 DCA OPTRO TAD M20 DCA I OPTR0 /LOOP COUNTER TAD OPTR0 DCA I P13 /FIELD 0 X-REG. IOF /PATCHED BY PLOT OVERLAY JMP I (REKOVR /RESTORE OUTPUT TO TTY RUB1, TAD XCTIN /REMOVE A CHARACTER SZA CLA /HALF-WORD? JMP .+7 TAD AXIN /CHECK POSITION CIA TAD BUFR /BEGINNING OF LINE TAD DEBGSW /PROTECT LINENO *3015 JMS I ECHO /SHALL WE ECHO A '\'? *3020 CDF /LOWER FIELD TO RUBOUT TEXT *3041 PACX /CORRECT POINTER *3044 TAD C100 /MOVED *3052 TDUMP, TAD DMPSW /CHANGES FOR LOWER-FIELD TEXT, DCA ATSW /TRACE PROTECTION, AND IMPROVED TAD END /SUBSCRIPT OUTPUT: -999 TO +999 DCA PT1 TAD LASTV CIA TAD PT1 SNA CLA /ALL DONE? POPJ /YES: END THIS LINE TAD P177 DCA AXOUT /SET 'TEXTP' DCA XCT DCA DMPSW /TURN ON TRACE TAD I PT1 CDF /RESET BY 'GETC' DCA I C200 /INSERT NAME GETC GETC /PRINT "XX(" GETC ISZ PT1 TAD I PT1 /GET THE SUBSCRIPT DCA T3 JMS I SDUMP /PRINT IT GETC /PRINT ")" TAD ATSW DCA DMPSW /RESET TRACE ISZ PT1 FENT FGET I PT1 /GET VALUE FEXT JMS I FOUTPUT /PRINT IT TAD CCR PRINTC CMA CLL RAL /'TAD M2' TAD GINC TAD PT1 JMP TDUMP+3 /NEXT ONE SDUMP, FGO6 /LIBRARY CALL AND FILE OPERATIONS: LGOSUB, PUSHJ /EXECUTE SUBROUTINE DO+3 CMA CLL RTL /LINE FEED = RETURN LIB, CIF /L COMMAND ENTRY JMP I 7 /LCMND = FPNT IN FIELD 0 ICHAR, 0 /FILE INPUT VIA (INDEV) CDI JMS I (ICHAR0 /CALL LOWER FIELD JMP I ICHAR OCHAR, 0 /FILE OUTPUT VIA (OUTDEV) CDI JMS I (OCHAR0 JMS I (XOUTL /ECHO RETURN JMP I OCHAR /NO ECHO RETURN EOF, 0 /TRYING TO READ FROM A FILE TAD (XI33 /AFTER THE END (SHAME ON YOU!) DCA INDEV /RESET POINTER TO TTY TAD CPRNT+1 /AND TURN ON THE ECHO DCA I (IECHO TAD (XOUTL /'EOF' IS ALSO USED BY 'RECOVR' DCA OUTDEV TAD P337 /RETURN A "_" TO CLEAR JMP I EOF /THE "^Z" PREVIOUSLY READ EJECT /CROSS-FIELD LINKS: CGET, 0 /'GETC' FOR DOWN BELOW GETC TAD CHAR CDI JMP I CGET CPRNT, 0 /FOR TAB AND LIST ROUTINES PRINTC CDI JMP I CPRNT PT1D, 0 /8K ROUTINES CDF TAD I PT1 CDF 10 JMP I PT1D THISD, 0 CDF TAD I THISLN CDF 10 JMP I THISD PAGE /THE ZERO COMMAND AND PROTECTED VARIABLES LIVE HERE: ZERO, TESTC /Z COMMAND: CHECK ARGUMENT JMP ZALL /T NO ARGUMENT = ALL VARIABLES GETC /N ILLEGAL (SLIGHT FUDGE) CLA /F IN CASE LINK=0 SORTJ /L NORMAL RETURN GLIST-1 /LOOK FOR SPACE, COMMA ZLIST-GLIST PUSHJ /NEITHER SPACE NOR COMMA, GETARG /SO MUST BE A NAME SZL PUSHJ /WRITE ZEROS SET20 JMP ZERO+3 /CHECK NEXT TERMINATOR ZALL, TAD END /PUT BEGINNING DCA LASTV /INTO END JMP ZERO+4 /AND RETURN ZLIST, ZERO+2 /SP ZERO+2 /, PROCESS /; PC1 /CR FNEW=. /USER FUNCTION AREA STVAR=. /SYMBOL TABLE BEGINS AFTER FUNCTIONS EXCLM=WORDS+2+. /USED FOR DOUBLE SUBSCRIPTING DUMMY=WORDS^3+6+. /USED FOR FOCAL STATEMENT FUNCTIONS *4400 UPDATE, CLA CMA /'ONCE-ONLY' CODE TAD END DCA I (GLOOP-2 /INITIALIZE VARIABLE SEARCH TAD END DCA LASTV TAD GLOOK /PI JMS GLOOK FENT FPUT I PT1 FEXT TAD (4100 /! JMS GLOOK TAD PT1 DCA I (DIMEN /DIMENSION CONSTANT TAD (4200 /" JMS GLOOK TAD (4300 /# JMS GLOOK TAD PT1 DCA I (ARG-1 /FIRST DUMMY VARIABLE TAD (4400 /$ JMS GLOOK TAD (4500 /% JMS GLOOK CMA CLL RAL TAD PT1 TAD GINC DCA END TAD END DCA LASTV /CLEAR THE SYMBOL TABLE TAD PACK2 /INITIALIZE THE DATE DCA AXIN DCA XCTIN TAD I (7666 /TODAY (IN CODE) SZA JMP .+3 TAD PACKIT /INSERT EARLY STOP JMP NODATE RTL6 RAR AND P17 JMS PACK2 TAD I (7666 RTR AND P77 CLL RAR JMS PACK2 TAD (7 /GOOD 'TILL 1980 ! JMS PACKIT TAD I (7666 AND (7 JMS PACKIT TAD ADD /GET HALF-WORD SZA /CHECK IF STORED JMS I DAXIN NODATE, CDI DCA I (NAMLOC TAD P177 DCA I (K177 /RESET POINTER AND JMP NONAME+2 /PUT DATE IN HEADER PACK2, NUDATE-1 DCA T1 DCA T2 TAD T1 SKP ISZ T2 TAD (-12 SMA JMP .-3 TAD (12 DCA T1 TAD T2 SZA JMS PACKIT TAD T1 JMS PACKIT CMA /"0"-1="/" JMS PACKIT JMP I PACK2 PACKIT, 7715 TAD C260 DCA CHAR PACKC JMP I PACKIT GLOOK, 2011 DCA EFOP PUSHJ GS1 JMP I GLOOK PAGE /EXTENDED PRECISION SIN & COS - REFERENCE DECUS FOCAL8-231 /ALGORITHM DUE TO DR. H.B. THOMPSON - UNIV. OF TOLEDO,OHIO *4675 FLARG /TEMPORARY FOR EXP XSQR *5034 EXIT2 /POINTERS FOR ATN FLARG PIOT *5065 TAD P13 /NEW LOCATION *5200 FCOS, NEGATE /COS(X)=SIN(PI/2-X) FENT FADD PIOT FEXT FSIN, GETSGN SNA /X=0 ? RETURN SMA CLA /X<0 ? JMP .+3 NEGATE /YES CMA DCA T3 /REMEMBER SIGN FENT FDIV TWOPI /CHANGE X TO REVOLUTIONS FEXT TESTQ, TAD FLAC /CHECK QUADRANT SPA JMP LTHALF /QUAD I & II SZA CLA JMP GTONE TAD T3 /QUAD III & IV CMA /REVERSE SIGN DCA T3 GTONE, TAD HORD /G.T. ONE REVOLUTION AND P1777 /REMOVE LEADING BIT & DCA HORD /NORMALIZE = SUBTRACT JMS I NORM /2^N REVOLUTIONS GETSGN SNA CLA /TEST FOR ZERO RESULT RETURN JMP TESTQ LTHALF, IAC SZA CLA /L.T. 1/4 ? JMP APPROX /YES: QUAD I NEGATE /NO: QUAD II FENT FADD I HALF /X->0.5-X FEXT APPROX, FENT /SIX TERM POLYNOMIAL FPUT I FLARGP /SAVE RESULT FMUL FLAC /SQUARE IT FPUT XSQR FMUL C11 FADD C9 FMUL XSQR FADD C7 FMUL XSQR FADD C5 FMUL XSQR FADD C3 FMUL XSQR FADD TWOPI FMUL I FLARGP /CONVERT TO ODD POWERS FEXT EXIT2, TAD T3 /CHECK SIGN JMP FABS+1 HALF, FLP5 P1777, 1777 PIOT, 1;3110;3755;2421 TWOPI, 3;3110;3755;2421 C11, 4;4313;0510 C9, 6;2500;3124 C7, 7;5464;5652;3636 C5, 7;2431;5360;3430 C3, 6;5325;0414;3220 XSQR, ZBLOCK 4 EJECT PCD, 0 /SYMBOL TABLE LIMIT CDF TAD I PC CDF 10 JMP I PCD VFN, 0 /GET VARIABLE FILE NAME PUSHJ EVAL-1 /EVALUATE THE EXPRESSION FIXIT /& TAKE THE INTEGER PART TAD HORD SZA CLA /LEAVE ZERO ALONE STL RAR DCA OVER2 /ROUND UP JMS I NORM CMA JMS I FOUTPUT /SET UP THE NUMERIC STRING CIF JMP I VFN /RETURN WITH STRING ADDRESS NORM, DNORM FINFIN, PUSHF /DEFAULT INCREMENT FP1, FLTONE JMP I .+1 FCONT /PERMANENT FUNCTIONS: FITR, FIXIT /SHORTEST FUNCTION RETURN /THAT THERE CAN BE FOUT, FIXIT /SINGLE CHARACTER OUTPUT SNA STL RAR /IN CASE IT'S ZERO PRINTC FSGN, GETSGN /REAL SIGNUM FUNCTION SNA CLA RETURN /ALSO USED BY FOUT FENT FGET I FP1 FEXT FABS, TAD I .+4 /CHECK ORIGINAL SIGN SPA CLA NEGATE RETURN FLARG+1 /THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO /INCLUDE NEGATIVE INTEGERS, I.E. %-N . N IS THE NUMBER /OF DIGITS TO BE OUTPUT IN FLOATING FORMAT. TYPE %, (=%0) /CONTINUES TO OUTPUT ALL SIGNIFICANT DIGITS IN THIS FORMAT /BUT ADDITIONALLY ONE CAN NOW SPECIFY ANY NUMBER (1-31) OF /DIGITS COMMEASUREATE WITH THE ACCURACY OF THE DATA. /OTHER CHANGES IMPLEMENTED HERE ARE THE FOLLOWING: FLOATING /FORMAT IS NOW IN STANDARD SCIENTIFIC NOTATION (ONE DIGIT /BEFORE THE DECIMAL POINT) AND THE ROUND-OFF CONSTANT HAS /BEEN CORRECTED (4 IS USED INSTEAD OF 5). THE SYMBOLS AND /COMMENTS ARE LARGELY THOSE FOUND ON PP 67-69 OF FOCAL-1969 DIGITS=12 /NUMBER OF DECIMAL DIGITS OUT *5400 TGO, 0 DCA FLTXR /SAVE BUFFER ADDRESS TAD FISW /GET FORMAT SAVED BY % TRAP STL RTR /SHIFT FIELD SIZE RTR /BACK INTO PLACE RTR /ARITHMETICALLY SNL /NEGATIVE FORMAT ? (OR >W.32) AND P77 /REMOVE STEP NO. IF POSITIVE RAR /FIELD SIZE IS ONLY 5 BITS SNA /ZERO IS SPECIAL TAD MD /MEANS SAME AS %-DIGITS DCA T1 /T1 IS NEGATIVE FOR FLOATING FORMAT TAD T1 CIA /INVERT SMA /- FIELD LENGTH FOR POS. FORMAT JMP R6-3 /E TYPE: CALCULATE ROUND-OFF DCA FLAC /F TYPE: SAVE -FIELD LENGTH TAD FISW /GET NUMBER OF DECIMAL PLACES AND P77 /LINE PART OF "LINENO" DCA DECP /OBVIOUSLY .DD IS LESS THAN .63 TAD FLAC TAD DECP SPA / F-D > 0 ? JMP .+5 /YES CLA CMA /NO TAD T1 DCA DECP /MAKE D = F-1 CMA TAD T3 /COMPARE DECIMAL EXPONENT SMA / F-D > E ? CLA /NO: ROUND OFF TO F PLACES TAD T1 /YES SPA / D+E < 0 ? JMP K4-1 /YES: NO ROUNDING NEEDED, PRINT! TAD MD /NO: ROUND TO D+E PLACES SMA /WITH A MAXIMUM OF D PLACES CLA R6, TAD P13 / *ROUND UP* 'TAD P7' - 3 WORDS DCA T2 /SAVE NUMBER+1 OF PLACES TO RND TO. TAD FLTXR /START OF BUFFER-1 TAD T2 /SET UP BUFFER ADDRESS AT WHICH DCA PLCE /ROUNDING OFF SHOULD START TAD T2 CIA /SETUP COUNT OF MAXIMUM NO. DCA T2 /OF CARRIES ALLOWABLE TAD K4 /LITTLE EXTRA ON FIRST DIGIT RET, ISZ I PLCE /ADD 1 TO DIGIT AT CURRENT POSITION TAD I PLCE TAD M12 /MINUS TEN SPA CLA /CARRY REQUIRED? JMP K4+1 /NO: GO TO OUTPUT DCA I PLCE /YES: MAKE CURRENT DIGIT ZERO ISZ T2 /BEGINNING OF BUFFER REACHED? JMP DECR /NO: DECREMENT BUF. ADR. AND REPEAT ISZ I PLCE /YES: SET MANTISSA TO 0.1 ISZ T3 /COMPENSATE BY INC. EXPONENT K4, 4 /'NOP' CLA CMA /SET SIGN COUNTER DCA T2 TAD FLAC / *PRINT* SNA /FLOATING OUTPUT ? JMP FLOUT /YES TAD T3 /COMPARE EXPONENT WITH FIELD SIZE SMA SZA / E > F ? JMP FLOUT+2 /YES: USE FLOATING FORMAT TAD DECP SMA / E < F-D ? CLA /NO: TAKE P = E CIA /YES: TAKE P = F-D TAD T3 CIA DCA T1 /SET UP MINUS P BACK, TAD T3 /PRINT DD.DDD TAD T1 SNA CLA / P = E ? JMP DIG /YES: PRINT DIGIT IAC /NO ('376' TO SUPPRESS 1ST ZERO) TAD T1 SPA CLA / P < 1 ? TAD M20 /YES: PRINT SPACE (240-260), NOT 0 IN, JMS OUTA /PRINT CHARACTER ISZ T1 /P CHARACTERS PRINTED? JMP BACK /NO CMA CLL RAL /YES ('TAD 376') JMS I OPUT /PRINT DECIMAL POINT JMP BACK DECR, CMA /BACKUP TO TOP OF BUFFER TAD PLCE DCA PLCE JMP RET FLOUT, TAD T1 /SET FIELD SIZE DCA FLAC CLA CMA /SET FLAG DCA PLCE ISZ TGO /SET SECOND RETURN DIG, CMA TAD T3 /REDUCE E BY 1 DCA T3 JMS GETD /GET NEXT DIGIT ISZ PLCE /TEST FLAG JMP IN /NORMAL RETURN JMS I OPUT /PRINT FIRST FLOATING DIGIT CMA CLL RAL /CREATE A PERIOD (256-260) SKP /DON'T FETCH & DON'T COUNT JMS GETD /FETCH NEXT DIGIT JMS OUTA /PRINT IT JMP .-2 /AND REPEAT DECP=. GETD, 0 /ROUTINE TO UNLOAD BUFFER TAD I FLTXR /AUTO-INDEX REG. SET UP UPON ENTRY ISZ FLOP /TEST FOR END OF SIGNIFICANT FIG. JMP I GETD CLA CMA /FORCE -1 IN ORDER TO DCA FLOP /OUTPUT EXTRA ZEROS JMP I GETD /LEAVE C(AC) = 0 PLCE=. OUTA, 0 JMS I OPUT /PRINT CHARACTER ISZ FLAC /F CHARACTERS PRINTED? JMP I OUTA /NO: RETURN JMP I TGO /YES: NUMBER FINISHED MD, -DIGITS OPUT, OUTDG ABSOLV=. /PATCHES TO REMOVE 'M2' AND 'MINUSA' FROM PAGE ZERO *5613 TAD M2 *5622 TAD M240 /ALREADY ON PAGE ZERO *5650 TAD MAT /SUBSTITUTE -"@ FOR -"A SPA SNA CLA *5665 M2, -2 INPUT /INPUT POINTER *5755 CLA STL TAD AC1H MAT, SMA /=-300 CLL *5774 ZBLOCK 4 /FOR CROSS-FIELD CALLS TO 'MULT10' /FLOATING OUTPUT CONVERSION ROUTINES: /REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING' /MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) AN /EXTENDED RANGE FOR THE SYMBOL TABLE DUMP SUBSCRIPT OUT- /PUT (+/-999); (3) A PROVISION FOR NON-PRINTING CALLS WHICH /JUST SET UP THE OUTPUT BUFFER. *6000 FLOUTP, 0 DCA T2 /SET NON-PRINT FLAG GETSGN /SAVE SIGN/ZERO INFO DCA FGO6 JMS I .+2 /NOW TAKE ABSOLUTE VALUE JMP FGO3 /INITIALIZE DECIMAL EXPONENT ABSOLV FGO1, FENT /NUMBER TOO SMALL FMUL I TENPT /MULTIPLY BY 10. FEXT CMA /REDUCE EXPONENT JMP .+5 FGO2, FENT /NUMBER TOO LARGE FMUL I PTTEN /MULTIPLY BY 0.1 FEXT IAC /INCREASE EXPONENT TAD T3 FGO3, DCA T3 /SAVE DECIMAL EXPONENT TAD FLAC /CHECK BINARY EXPONENT SPA JMP FGO1 /TOO SMALL TAD M5 SMA CLA /IS EXP 0 TO 4 ? JMP FGO2 /TOO LARGE FGO4, DCA I REMPT /CLEAR REMAINDER TAD SADR /INITIALIZE BUFFER POINTER DCA FLTXR TAD FLAC /COMPUTE FIRST DIGIT CMA DCA I DIGPT TAD DCOUNT DCA FLAC JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS ISZ I DIGPT /AND CLEAR DIGIT JMP .-2 TAD I REMPT /TEST FOR 0,1-9,10-15 SNA JMP FGO5 /IGNORE FIRST ZERO TAD M12 SPA CLA JMP SPACE+2 /1-9 IAC DCA I FLTXR /OUTPUT A "1" ISZ FLAC /COUNT THE DIGIT ISZ T3 /BUMP DECIMAL EXPONENT SPACE, 240 TAD M12 /CORRECT THE REMAINDER TAD I REMPT /COMPUTE RESULTANT OR SECOND DIGIT ISZ T3 JMP .+3 SKP FGO5, JMS I M10PT /IE. 0.672 X 10 = 6 + 0.72.. ETC. DCA I FLTXR ISZ FLAC /ALL DIGITS OUTPUT ?? JMP .-3 /NO: CONTINUE TAD DCOUNT DCA FLOP /SAVE NO. OF DIGITS TAD SADR /GET BUFFER POINTER ISZ T2 /TEST PRINT FLAG JMS I ROUND /OUTPUT MANTISSA JMP I FLOUTP /FIXED POINT DONE TAD CHRT /PRINT "E" PRINTC JMS FGO6 /OUTPUT THE EXPONENT JMP I FLOUTP /FLOATING POINT DONE FGO6, 0 /ALSO CALLED BY TDUMP TAD T3 /GET EXPONENT SPA CLA /TEST SIGN STL RTL /+2 -> -3 TAD M5 JMS OUTDG /PRINT SIGN DCA T2 /INITIALIZE HUNDREDS TAD T3 /NOW TAKE ABSOLUTE VALUE SPA CIA SKP /SUBSTITUTE EAE DIVIDE ISZ T2 TAD M144 /SUBTRACT ONE HUNDRED SMA /TEST FOR OVERDRAW JMP .-3 TAD C144 /RESTORE DCA T3 /SAVE TENS AND UNITS TAD T2 /PRINT HUNDREDS SZA /UNLESS ZERO JMS OUTDG TAD T3 /PRINT TWO DIGITS JMS I .+2 JMP I FGO6 PRNT C144, +144 M144, -144 "= OUTDG, 0 /MULTI-PURPOSE ROUTINE SMA /IGNORE SPACES AND THE LIKE OR ISZ T2 /DIGITS OTHER THAN THE FIRST ! JMP DGOUT DCA T2 /SAVE THE FIRST DIGIT TAD SPACE /OR 'TAD OUTDG-1' FOR AN "=" SIGN PRINTC /OR 'CLA' TO REMOVE EITHER TAD FGO6 /GET SIGN INFO SNA DCA T3 /CORRECT EXPONENT OF ZERO SPA CLA TAD C15 /"-" TAD SPACE /FOR POSITIVE NOS. ('SZA') PRINTC TAD T2 /RESTORE AC DGOUT, TAD C260 /FORM ASCII PRINTC JMP I OUTDG C15, 15 /255 CHRT, "E ROUND, TGO TENPT, TEN PTTEN, PTEN M10PT, MULT10 REMPT, REMAIN DIGPT, REMAIN+1 SADR, BUFFER-1 DCOUNT, -DIGITS-1 FLEN, CDI /COMPUTE REMAINING FILE LENGTH JMP I .+1 XLEN XRTD, 0 CDF TAD I XRT CDF 10 JMP I XRTD *6254 FMUL PTEN *6275 RNDM, 4421 /INCREMENTED AT RANDOM 3040 0001 0000 *6306 INPUT *6311 PTEN, -3 /INPUT-OUTPUT CONSTANT MOVED 3146 3146 /AND CORRECTED 3150 /DOUBLE SUBSCRIPTING FEATURE PERMITS VARIABLES OF THE FORM: /X(I,J). ALGORITHM COMPUTES SINGLE SUBSCRIPT BASED ON THE /MAXIMUM NUMBER OF ROWS OF A TWO-DIMENSION ARRAY, E.G. THE /MAXIMUM VALUE OF I. THIS VALUE MUST BE STORED IN THE /FIRST "SECRET VARIABLE" (!). THE FORMULA IS J*!-!+I. IT /WILL WORK NO MATTER WHAT THE VALUE OF ! IS, BUT THE SUB- /SCRIPTS ARE ONLY UNIQUE IF !=MAX(I). /WHILE THE NUMBER OF COLUMNS DOES NOT AFFECT THE INDEXING /IT IS SUGGESTED FOR CONSISTENCY THAT THIS DIMENSION BE /STORED IN THE SECOND "SECRET VARIABLE" (") SO THAT ALL /MATRIX ROUTINES CAN USE THESE VARIABLES FOR LOOP INDICES /THEREBY PERMITTING COMPLETELY GENERAL PROGRAMMING. TEST42, 0 /DOUBLE SUBSCRIPTING ROUTINE TAD CHAR /CHECK FOR SECOND SUBSCRIPT TAD MCOM SZA CLA JMP ONLY1 PUSHF /RECURSIVE CALLS LIKELY FLAC /SO SAVE FIRST SUBSCRIPT PUSHJ /EVALUATE THE SECOND (CAN EVEN EVAL-1 /HANDLE SUBSCRIPTED SUBSCRIPTS!) POPF /TEMPORARY STORAGE FLARG /FOR THE FIRST ONE FENT FMUL I DIMEN /DIMENSION (!) TIMES FSUB I DIMEN / (SECOND MINUS ONE) FADD I FLARGP /PLUS OFFSET OF FIRST FEXT ONLY1, POPA /GET VARIABLE NAME FROM PDL DCA EFOP /AND RESTORE FOR SEARCH JMS I .+3 /CHECK FOR PROPER RIGHT PAREN. FIXIT /FIX FLAC TO GET SUBSCRIPT JMP I TEST42 PARTEST DIMEN, EXCLM+2 /DATA POINTER FOR (!) /IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES TTY WAIT /LOOP TO INITIALLY SET A RANDOM VALUE. AFTER THE FIRST /INPUT SUCCESSIVE NUMBERS ARE GENERATED FROM THE POWER /RESIDUE ALGORITHM DUE TO P.T. BRADY (DECUS 5-25). SEE /ALSO THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1. DUBLAD /X(1)=(2^17+3)*X(0) MOD 2^35 FRAN, FENT FNOR RNDM-1 /LOAD FLOP FGET RNDM /SHIFT LEFT TWELVE FEXT TAD M4 DCA FLAC JMS I DOUBLE /SHIFT LEFT FOUR MORE & ISZ FLAC /LEAVE ZERO IN EXPONENT JMP .-2 JMS I FRAN-1 JMS I DOUBLE /ADD IN 3 TIMES ORIGINAL JMS I FRAN-1 FENT FPUT RNDM-1 /SAVE FOR NEXT CALL FEXT CMA CLL RAR /=3777 AND HORD DCA HORD /BE POSITIVE IT'S POSITIVE RETURN /THE TAB COMMAND FOR 'ASK/TYPE' STATEMENTS HAS BEEN EX- /TENDED TO PERMIT 'SKIPPING' CHARACTERS DURING INPUT. A /NEGATIVE COLUMN NUMBER SPECIFIES THE NUMBER OF CHARACTERS /TO IGNORE; IF THE INPUT ECHO IS ON THESE CHARACTERS WILL /BE SENT TO THE OUTPUT. THIS FEATURE PERMITS IGNORING /UNWANTED PARTS OF A FILE (LABELS, ETC.) DURING INPUT. XTAB, PUSHJ /EVALUTE COLUMN NO. EVAL-1 FIXIT /AND SET RESULT IN AC CIF JMP TAB /SAME PAGE, FIELD 0 SKIP1, READC /SKIP ONE CHARACTER CIF JMP POS /RETURN TO LOWER FIELD /MISCELLANEOUS CHANGES TO FLOATING POINT PACKAGE /MOST ARE STANDARD 4 WORD CHANGES BUT SOME ARE SUGGESTIONS /BY JIM CRAPUCHETTES (DECUS FOCAL8-269) TO SPEED THINGS UP. *6402 SKP /'DCA OVER1' FOR 3-WORD VERSION DCA OVER2 JUMP=SIGNF *6407 DCA JUMP /SAVE FP INSTRUCTION TAD JUMP RTL /MOVE "I" BIT TO LINK RTL / AND "Z" BIT TO AC0 SPA CLA /PAGE 0 ? TAD FPNT /NO, GET PAGE # AND P7600 DCA T1 /AND SAVE IT ('MQL') TAD JUMP /NOW GET RELATIVE LOCATION AND P177 TAD T1 /MERGE PAGE ADDRESS ('MQA') DCA T1 SNL /WAS IT INDIRECT ? JMP .+3 /NO TAD I T1 /YES DCA T1 ISZ FPNT /BUMP TO NEXT INSTRUCTION CMA TAD T1 DCA FLTXR2 /SET UP TRANSFER TAD JUMP /GET OP CODE CLL RTL RTL AND P17 SNA JMP FLGT /0 = "FGET" TAD OPTABL /POINT TO OPERATION DCA JUMP TAD I JUMP SNA JMP FLPT /0 = "FPUT" DCA JUMP TAD I FLTXR2 /MOVE OPERAND INTO FLOP DCA FLOP TAD I FLTXR2 DCA AC1H TAD I FLTXR2 DCA AC1L TAD I FLTXR2 /'JMP I JUMP' FOR 3 WORDS DCA OVER1 JMP I JUMP FLPT, TAD .+2 JMP XFER FLAC-1 FLGT, TAD .-1 DCA FLTXR2 CMA TAD T1 XFER, DCA FLTXR /AVOID LOOP OVERHEAD TAD I FLTXR DCA I FLTXR2 TAD I FLTXR DCA I FLTXR2 TAD I FLTXR DCA I FLTXR2 TAD I FLTXR /'JMP FPNT+1' FOR 3 WORDS DCA I FLTXR2 JMP FPNT+1 FIND, FIXIT /CHARACTER SEARCH FUNCTION CIA DCA FPNT JMP FINDER *6515 FINDER, JMS I INDEV /READ A CHARACTER INTO AC TAD FPNT SNA /FOUND IT ? RETURN /DON'T ECHO SEARCH CHAR. TAD LORD /NO: RESTORE CODE JMS I ECHO /& ECHO AS DIRECTED JMP FINDER COMMA, ", /'SORTA USEFUL' FLEX=. /"^" ENTRY POINT CHANGED *6537 DCA T1 NOP /PATCH FOR 3-WORD VERSION *6545 FLTONE /MOVED DOWN ONE *6550 JMP .+5 /IMPROVED "^" LOOP JMS I OPTABL+4 TAD M4 /PSEUDO PUSHF - SAME DATA TAD PDLXR DCA PDLXR POPF /RECALL ARGUMENT FLOP ISZ T1 JMP .-7 JMP FPNT+1 OPTABL, .+11 PAGE FLEX *TEST2 43 *7003 214 /^L IS IGNORED IN AN 'ASK' COMMAND *DMULT4 DCA DATUM-5 *7072 NOP /CHANGES TO THE SIGN-CHECKING ROUTINES FOR MULTIPLY/DIVIDE /IN ORDER TO SHORTEN THEM SOMEWHAT TO MAKE ROOM FOR "ZERO". *7102 JMS RESOLV /EXIT FROM 'FMUL' AND 'FDIV' JMS I .+2 /SET SIGN AND NORMALIZE JMP I .-3 DNORM *7127 STL RAR /SET 4000 *7132 DCA SIGNF /SIGN OF PRODUCT/QUOTIENT GETSGN SNA /TEST FOR ZERO RESULT JMP ZER0 SPA CLA /TAKE ABSOLUTE VALUE NEGATE TAD AC1H SZA /REVERSE THIS SKIP JMP I SIGN ZER0, DCA FLAC /QUICK EXIT IF RESULT IS ZERO DCA HORD DCA LORD DCA OVER2 JMP I SIGN-1 /FPNT+1 EJECT /CORRECTIONS TO THE DIVIDE ROUTINE FOR 3 WORD MANTISSAS *MIF -43 /SHIFT COUNT FOR DIVIDE *7271 /CORRECT THE DIVIDE ROUTINE TAD OVER1 TAD OVER2 DCA TEST4 RAL TAD AC1L /COMBINE ONE POSITION TAD LORD DCA MP2 /SAVE RESULT RAL TAD HORD /ADD OVERFLOW TAD AC1H SNL /SKIP IF OVERFLOW JMP .+6 DCA HORD /UPDATE FLAC TAD TEST4 DCA OVER2 TAD MP2 DCA LORD CLA /IF NO OVERFLOW TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY RAL DCA MP1 TAD MP4 RAL DCA MP4 TAD DNORM /FOCAL STATEMENT FUNCTIONS: F(N,ARG1,ARG2,...) /N IS A LINE OR GROUP NO. (CONVENIENTLY USE A VARIABLE /NAME WHICH IDENTIFIES THE FUNCTION!) AND THE ARG'S RE- /PLACE THE VALUE OF THE FIRST ENTRIES IN THE SYMBOL TABLE /BEGINNING WITH THE PROTECTED VARIABLE (#). THUS THE FIRST /THREE REPLACEABLE VARIABLES ARE #,$,%. NOTE THAT ! AND " /ARE USED FOR SUBSCRIPTING. FUNCTIONS REQUIRING MORE THAN /THREE ARGUMENTS WILL NEED TO DEFINE ADDITIONAL SYMBOLS AT /THE BEGINNING OF THE TABLE. AS AN EXAMPLE: Z;Z D1 D2 D3 /SETS UP THREE ADDITIONAL "DUMMY" VARIABLES. OF COURSE /THEY ARE PERFECTLY GOOD REGULAR VARIABLES TOO. *7502 TESTF, 0 /CHECK FOR FSF FUNCTION POPA /GET FUNCTION NAME SZA /CHECK FOR 0 = "F" JMP I TESTF /NORMAL FUNCTION FSF, PUSHJ /EVALUATE LINE NUMBER XGETLN+5 /(ARG. IS ALREADY IN FLAC) TAD ONFLAG /SAVE CURRENT POINTER PUSHA /FOR RECURSIVE CALLS PUSHF /SAVE RESULTS LINENO /AND NAGSW TAD .+2 /FIRST DUMMY VARIABLE JMP ARG+7 DUMMY+2 ARG, PUSHJ /EVALUATE REAL ARGUMENTS EVAL-1 FENT FPUT I ONFLAG /SAVE UNDER DUMMY NAME FEXT TAD ONFLAG TAD GINC /ADVANCE TO NEXT ONE DCA ONFLAG TAD CHAR TAD MCOM SNA CLA /ADDITIONAL ARGUMENTS ? JMP ARG DOF, POPF /RESTORE LINENO & NAGSW LINENO TAD SORTCN /SAVE SORTCN PUSHA PUSHJ /EXECUTE A DO BRANCH DO+3 POPA DCA SORTCN POPA /RESTORE POINTER DCA ONFLAG JMP I .+1 /LEAVE FLARG ALONE EFUN3+4 IFF, IF+1 *SPA SNA LGETLN, 0 /FOR LIBRARY COMMANDS GETLN CIF JMP I LGETLN /ON COMMAND: ON (EXPRESSION)-,0,+;CONTINUATION /THIS COMMAND WORKS JUST LIKE THE 'IF' COMMAND EXCEPT THAT /AFTER EXECUTING THE BRANCH THE PROGRAM RETURNS TO THE NEXT /COMMAND (WHICH MAY BE ON THE SAME LINE). ALSO, IT IS NOW /POSSIBLE TO INDICATE THE REST OF THE LINE AS THE SELECTED /BRANCH BY OMITTING THE LINE NUMBER. THUS: "IF (-1),X,Y;Z" /WILL ZERO THE VARIABLES AND "ON (X-Y)X,,Y" WILL CONTINUE /THE PROGRAM IF X=Y, OTHERWISE IT WILL FIRST CALL X OR Y /(WHICHEVER IS SMALLEST) AND THEN CONTINUE THE PROGRAM. OCMND ON, TESTC /O COMMAND CMA /T ON " DCA ONFLAG /N SET FLAG JMP I IFF /F CONTINUE CIF /L "O"THER JMP I ON-1 /"IF" PATCH TO CHECK FOR MISSING LINENO (=CONT. SAME LINE) /ALSO DECIDES BETWEEN "IF" (=GOTO) AND "ON" (=DO) BRANCHES. *-215 /VIA MCR ! ONTEST, 0 GETLN SZL /CHECK FOR BLANK JMP I ONTEST ISZ ONFLAG /TEST FLAG JMP I IFTEST /IF SORTC /ON COMMA-1 DCA CHAR /PREVENT MULTIPLE CALLS PUSHJ DO+3 JMP I ONTEST /CONTINUE IFTEST, GOTO+1