/PATCHES TO FOCAL ITSELF! FIELD 1 *0 ECHOP, ECHO TABC, 0 /TAB COUNTER CNTRX, 0 ATSW, 0 RISZ, 0 /RANDOM RANDOM #'S *TELSW 0 /CLEAR IN-PROGRESS FLAG *PC PC0 *LASTV STVAR *37 GOK, GOKILL /TO KILL 'CURRENT PROGRAM SAVED' FLAG *BUFR LINE1 *73 LIST6, 214 /F.F. (^L) 207 /BELL LIST7=. *126 POPA=JMS I . XPOPA *COMBUF LIBN, LIBFIL LINE0 STVAR LINE1 *137 CFRSX, FLTZER /MOVED FOR ^L FUDGE *140 /REDEFINE SOME NEW INSTRUCTIONS PUSHJ=JMS I . XPUSHJ POPJ=JMP I . XPOPJ PUSHA=JMS I . XPUSHA PUSHF=JMS I . PD2 POPF=JMS I . PD3 *154 XGETLN /CHANGE POINTER *167 /8K SUBROUTINES DPC, 2564 /PC DTHIS, THISD /THISLN DPT1, PT1D /PT1 DXRT, XRTD /(TAD I XRT) DAXIN, AXIND /(DCA I AXIN) DAXOUT, AXOUTD /(TAD I AXOUT) SECRTV, STVAR /FOR SECRET VARIABLES, OF COURSE TELPCH *200 JMP I 176 /FUDGE FOR ?00.00 PRINTOUT *201 TAD C200 /INITIALIZE PC *206 TAD PUSHB /OVERFLOW PROTECTION *211 JMS I ECHOP /SHOULD WE PRINT A '*'? *212 TAD BUFR /COMMAND INPUT BUFFER *215 TAD BUFR /RUBOUT PROTECTION *221 LIST7-1 /MOVED DOWN ONE INLIST-LIST7 *226 PUSHB, RESTORE-1+13 /END FOR TEXT AND COMMAND INPUT *231 TAD BUFR /INITIALIZE FOR UNPACKING *235 TAD PUSHB1 /INIT STACK POINTER *255 JMS I DAXIN /DCA I AXIN *273 JMS I DPC /TAD I PC *302 FL100, 7 3100 0 FLP5, 0 2000 0 0 TEMP, ZBLOCK 4 XGETLN, 0 /COMPUTED LINE #'S SPNOR /IGNORE SPACES TAD CHAR /'A' IS SPECIAL TAD MINUSA SNA CLA JMP TESTA PUSHJ /EVALUATE NUMBER OR EXPRESSION EVAL FENT FPUT TEMP /SAVE IT FEXT INTEGER /GET GROUP PART TAD P7740 /CHECK IF TOO BIG SMA CLA ERROR2 /BAD GROUP # TAD FLAC+2 /GET GROUP AGAIN RTL6 RAL DCA LINENO /SAVE IT NEGATE FENT FADD TEMP /GET FRACTION FMUL FL100 FADD FLP5 /ROUND UP FEXT INTEGER TAD LINENO /ADD GROUP TESTA, DCA LINENO CLA CLL TAD LINENO /CHECK FOR ERROR AND P7600 SZA CLA CML TAD LINENO AND P177 SNL SZA ERROR2 /ILLEGAL GROUP ZERO USAGE SZA CLA /AND SET NAGSW TAD P2000 CML RAL DCA NAGSW JMP I XGETLN PUSHB1, 3576+13 *375 /PATCHES TO FUNCTION TABLE XSGN *400 FRAN *410 FIN FOUT *436 JMS I DXRT /TAD I XRT *445 JMS I DPC *455 JMS I DPT1 /TAD I PT1 *473 POPA *460 JMS I DPT1 /TAD I PT1 /PUSH DOWN LIST SUBROUTINES *477 PD2, 0 TAD I PD2 ISZ PD2 DCA .+3 CIF JMS I .+3 0 JMP I PD2 MPD2 PD3, 0 TAD I PD3 DCA .+4 ISZ PD3 CIF JMS I .+3 0 JMP I PD3 MPD3 XPOPA, 0 CIF JMS I .+2 JMP I XPOPA MPOPA *630 POPA *652 JMS I DTHIS /TAD I THISLN *661 JMS I DPT1 /TAD I PT1 *664 JMS I DPT1 /TAD I PT1 *1012 "O /ADD 'OPEN' COMMAND *1015 POPA *1140 FLTONE /MOVED FOR ^L FUDGE *1054 POPA *1115 POPA *1155 POPA *1200 RETRN /MOVE 'RETURN' FILER /ADD 'OPEN' *1203 DCA ATSW /ALL REFERENCES TO 'ATSW' MUST BE CHANGED *1206 ALIST-1 ATLIST-ALIST *1210 ISZ ATSW *1216 CLA CLL /DON'T PRINT COLON NOP *1223 POPA *1246 TAD P15 /PRINT CR ONLY PRINTC /(PRINTC HANDLES NULL FOR DELAY!) JMP .+3 *1255 P15, 15 *1265 JMS I DAXIN /DCA I AXIN *1277 LISTGO-LIST3 /LISTGO HAS MOVED *1310 LIST6-1 SRNLST-LIST6 *1354 XPUSHA, 0 CIF JMS I .+2 JMP I XPUSHA MPUSHA *1365 1302 /MOVE UP ONE TO ADD TAB 1271 LISTGO, 0261 1312 ALIST, ": *1433 POPA *1440 TAD SECRTV /VARIABLE SEARCH STARTS WITH SECRET VARIABLES *1464 TAD BOTTOM /CHECK FOR OVERFLOW *1530 /RESIDENT FOR LIBRARY GOSUB SP, 240 LIB+1 *1553 LGOSUB, CLA CLL PUSHJ /EXECUTE SUBROUTINE DO+1 TAD SP /LIBRARY 'SPACE' = LIBRARY RETURN! DCA CHAR JMP I SP+1 /SKIP 'SPNOR' RETRN, TAD C200 DCA PC XPOPJ, POPA DCA T2 JMP I T2 CLA CLL /FREE LOCATION!! ATLIST, XTAB *1626 JMP 1650 /'EVAL' FOUND A TERMINATOR WHICH WAS NOT AN OPERATOR - /END OF EXPRESSION (NOT ERROR!) *1705 POPA *1757 POPA *1766 POPA *2010 GOKILL, CDF DCA I LIBN /ZERO 'CURRENT PROGRAM SAVED' FLAG CDF 10 JMP START *2050 POPA *2052 POPA /REVERSE THESE TWO INSTRUCTIONS TAD 2034 *2105 CDF /CHANGE DATA FIELD FOR 'DELETE' *2201 1140 /FIN 2672 /FOUT *2216 CDF DCA I CFRS /ERASE ALL TEXT JMP I GOK *2231 JMS I DTHIS /TAD I THISLN TSTGRP /DONE ERASING GROUP? JMP I GOK /YES, ERASE 'CURRENT PROGRAM SAVED' FLAG JMS I DTHIS /TAD I THISLN *2237 TAD END /ZERO VARIABLES (BUT NOT SECRET VARIABLES!) *2253 JMS I DXRT /TAD I XRT *2262 JMS I DTHIS /TAD I THISLN *2345 JMS I DAXOUT /TAD I AXOUT *2361 CDF /CHANGE TO TEXT FIELD *2374 DCA I LIBN /WE'VE ADDED A NEW LINE CDF 10 /KILL 'CURRENT PROGRAM SAVED' FLAG *2405 INPUT+1 /^L IN ASK STATEMENT, IGNORE IT FLTONE, 0001 /ALL THIS MUST BE MOVED DOWN ONE 2000 FLTZER, 0000 0000 0000 0000 M12, -12 /CONSTANT FOR 'PRNT' XPUSHJ, 0 CLA CLL IAC TAD XPUSHJ /BUMP RETURN ADDRESS PUSHA /SAVE IT ON THE STACK TAD I XPUSHJ /GET THE ADDRESS DCA XPUSHJ /INDIRECT INDIRECT! JMP I XPUSHJ *2453 TAD M12 /PATCH 'PRNT' *OUT+3 CIF JMS I TAB /COUNT CHARACTERS JMP OUTCR /IT WAS A CR, PRINT CR/LF JMS I OUTDEV /PRINT NORMAL CHAR JMP I OUT OUTCR, TAD CCR JMS I OUTDEV TAD CLF JMP OUTCR-2 TAB, TABCNT *2530 /RESTORE FIELD AFTER 'PACKC' CDF 10 *2541 JMS I DAXIN /DCA I AXIN *2564 0 /PC CDF TAD I PC CDF 10 JMP I .-4 *2572 AXOUTD, 0 CDF TAD I AXOUT CDF 10 JMP I AXOUTD *2602 -220 /CHANGE BREAK CHAR /WE MOVED ITACTER TO ^P *2640 JMP RECOVR *2646 PCF /CLEAR COMMON FLAGS RRB CLA CLL TAD SAVLK CLL RAL TAD SAVAC CIF CDF /RETURN FROM INTERRUPT JMP I .+1 4 RANRAN, ISZ RISZ /BUMP RANDOM NUMBER JMP 2667 /WHILE WAITING FOR INPUT JMP RANRAN /DON'T LEAVE ZERO *2671 JMP RANRAN *2725 ERROR5, DCA .+1 ERR2, 0 ION TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA JMP .-2 CLA CLL CMA /PUT ERROR CODE IN 'LINENO' FOR 'PRNTLN' TAD ERR2 SKP RECOVR, TAD C200 /TELETYPE BREAK DCA LINENO IOF TAD M20 /CLEAR OUTPUT BUFFER DCA CNTR CMA TAD OPTR0 DCA 10 TAD OPTR0 DCA OPTRI TAD OPTR0 DCA OPTRO CDF 10 DCA I 10 ISZ CNTR JMP .-2 DCA INBUF /AND INPUT BUFFER RECOVX, CIF CDF /DO LOWER FIELD FIXES JMP I .+1 XRESTOR TAD P277 PRINTC /PRINT A '?'? PRNTLN ISZ PC JMS I DPC SNA JMP .+6 DCA LINENO TAD P7700 PRINTC PRINTC PRNTLN TAD CCR PRINTC JMP START *3015 JMS I ECHOP /SHALL WE ECHO A '\'? *3020 CDF /LOWER FIELD TO RUBOUT TEXT *3052 TAD END /INIT POINTER FOR DUMP (DON'T DUMP SECRET VARIABLES) *3062 JMP I 3116 /KLUDGE UP TDUMP *3115 PC0+3 TDUMPX *3120 ZBLOCK 20 /CLEAR OUTPUT BUFFER *3140 ECHO, 0 ION /MAKE SURE! DCA CHAR /SAVE IN CHAR TAD I C2163 /DO WE WANT TO PRINT? SNA CLA JMP I ECHO /NO PRINTC /YES JMP I ECHO C2163, 2163 ICHARF, 0 /INPUT A CHARACTER FROM A FILE CIF CDF JMS I CHARI /CALL LOWER FIELD JMP I ICHARF CHARI, ICHAR FILER, CIF /FILE COMMANDS ('OPEN') JMP I .+1 FILEST X133P, X133 TERMER, 0 /CHECK FOR TERMINATOR (;, CR, SPACE, OR ,) SORTC GLIST-1 ISZ TERMER CIF CDF JMP I TERMER EOF, 0 /TRYING TO READ FROM A FILE AFTER END TAD X133P /(SHAME ON YOU!) DCA INDEV /RESET POINTER TO TTY TAD P277 /PRINT A '?' JMS OUTL /ON THE TELETYPE JMS I INDEV /READ A CHARACTER JMP I EOF PAGE OCHAR, 0 /OUTPUT A CHARACTER DCA T2 OUTECH, SKP /ECHO ON TELETYPE? JMP .+5 TAD T2 /NO SNA /YES CLA CLL CML RAR /LET HIM PRINT NULLS! JMS I OUTLP TAD T2 CIF JMS I NOCARE /OUTPUT IT JMP I OCHAR OUTLP, OUTL NOCARE, NOCHAR IFNDEF FDIS < /FDIS FOR TEKTRONIX T-4002 AVAILABLE - IF USED, /PRINTX OVERLAYS OLD FDIS PRINTX, 0 JMS I OUTDEV CIF JMP I PRINTX STVAR=.> *5352 /AFTER EXTENDED FUNCTIONS XTAB, PUSHJ EVAL-1 FENT FADD I TRND /LET'S ROUND OFF FEXT INTEGER CIA TAD TABC IAC SMA JMP BACK DCA CNTRX TAD SPACE PRINTC ISZ CNTRX JMP .-3 BACK, CLA CLL JMP I .+1 TASK TRND, FLP5 SPACE, 240 *5774 MGETC, 0 /GETC FAKE FOR LOWER FIELD GETC CIF JMP I MGETC *6135 0240 /CHANGE '=' TO A SPACE *6160 THISD, 0 CDF TAD I THISLN CDF 10 JMP I THISD PT1D, 0 CDF TAD I PT1 CDF 10 JMP I PT1D *6311 XRAN, FENT /PSEUDO-RANDOM NUMBER FGET RNDM /X(1)=(2^17+3)*X(0) MOD 2^16 FPUT FLOP FEXT TAD M16 DCA T1S JMS I DOUBLE ISZ T1S JMP .-2 JMS I ADDR JMS I DOUBLE JMS I ADDR FINT FPUT RNDM FEXT DCA FLAC CLA CLL CMA RAR /=3777 AND FLAC+1 DCA FLAC+1 /BE POSITIVE IT'S POSITIVE JMP I EFUN3I M16, -16 ADDR, DUBLAD RNDM=. T1S, 0 4421 3040 0001 XRTD, 0 CDF TAD I XRT CDF 10 JMP I XRTD AXIND, 0 CDF DCA I AXIN CDF 10 JMP I AXIND TDUMPX, CDF DCA I .+3 CDF 10 JMP I .+2 PC0+4 3063 TELPCH, DCA TELSW /SETUP TO PRINTOUT JMP I .+1 RECOVR+1 *6545 FLTONE /MOVED DOWN ONE *7003 214 /^L IS IGNORED IN AN 'ASK' COMMAND /THIS IS THE "LIBRARY HEAD" *7503 LIB, SPNOR /IGNORE SPACES TAD TELSW /WAIT FOR OUTPUT TO FINISH SZA CLA /(DECTAPE SYSTEMS REALLY NEED THIS!) JMP .-2 IOF CIF CDF /CALL LOWER FIELD JMP I (LOWLIB TAD (JMP I GOSWITCH+1 /RETURN TO APPROPIATE ROUTINE TAD GOSWITCH DCA GOSWITCH GOSWITCH, JMP I .+1 PROC START LGOSUB GOTO+1 FIN, DCA FLAC+2 /SINGLE CHARACTER INPUT FUNCTION DCA FLAC+3 /CLEAR FLAC TAD SORTCN /SAVE SORTCN IN CASE OF RUBOUT OR LF DCA PGETLN READC /READ A CHAR TAD CHAR /FLOAT IT DCA FLAC+1 TAD PGETLN /RESTORE SORTCN DCA SORTCN TAD P13 DCA FLAC JMP I EFUN3I FOUT, INTEGER /SINGLE CHARACTER OUTPUT FUNCTION SNA TAD P4000 /IN CASE IT'S ZERO PRINTC JMP I EFUN3I CPRNT, 0 /CROSS FIELD FAKES! PRINTC CIF CDF JMP I CPRNT PGETLN, 0 GETLN CIF CDF JMP I PGETLN FRAN, TAD (XRAN /RANDOM RANDOM NUMBERS DCA I (400 /(FIRST CALL ONLY) TAD RISZ /INITIALIZE 'RNDM' DCA I (RNDM+1 JMP I (XRAN XSGN, TAD FLAC+1 /REAL SIGNUM FUNCTION!! SNA CLA JMP I EFUN3I PUSHF FLTONE POPF FLAC JMP XABS PAGE