/EDU-20 / /DEC-08-EDU20A-C-LA / /COPYRIGHT 1972,1973 / /DIGITAL EQUIPMENT CORPORATION /MAYNARD, MASSACHUSETTS 01754 /EDUSYSTEM 20 BASIC /EDUSYSTEM 20 BASIC /MARK BRAMHALL /DIGITAL EQUIPMENT CORP. /JOHN O'DONNELL /YALE UNIVERSITY /MARK ROSENTHAL /DIGITAL EQUIPMENT CORP. /VERSION AS OF: /24 MAY 73 /@33 -- THIS VERSION HAS BEEN RE-CREATED FROM EDU20S.PA /@34 -- TOGETHER WITH AN OLD PAPER COPY OF THE ORIGINAL /@35 -- EDU20C LISTING OUT OF PAL10 & CREF. A SERIOUS /@36 -- ATTEMPT HAS BEEN MADE TO MAKE THIS AN EXACT AS /@37 -- POSSIBLE REPRODUCTION (WITH THE EXCEPTION OF THESE /@38 -- TWO PAGES), INCLUDING ALL ORIGINAL TYPOS. THIS /@39 -- RECONSTRUCTION, BY STEVE TOCKEY, IS DATED /@40 -- 13-OCT-2019 /@41 -- LINES ON THESE 2 PAGES WITH "/@" /@42 -- CAN'T BE RELIABLY RECONSTRUCTED FROM THE PAL10 & /@43 -- CREF LISTING BECAUSE OF A MISSING LISTING PAGE. /@44 -- EVERYTHING IN THIS RANGE HAS BEEN RECONSTRUCTED /@45 -- FROM THE SYMBOL TABLE AND CREF LISTING. /@46 -- SEE THE EDUSYSTEM HANDBOOK FOR HOW TO USE EDU20C /@47 -- HTTP://BITSAVERS.TRAILING-EDGE.COM/PDF/DEC/PDP8/ /@48 -- TSS8/EduSystemHandbookJan73.pdf /@49 -- /@50 -- ASSEMBLE IN OS/8: .R PAL8 /@51 -- *EDU20C,EDU20C 1 MAKES A PROGRAM THAT /@66 -- LETS YOU RE-CONFIGURE EDU20C WITHOUT RE-LOADING THE /@67 -- ENTIRE PAPER TAPE FROM SCRATCH. THIS WAS USEFUL IN /@68 -- THE PUNCHED PAPER TAPE ERA, PARTICULARLY @ 110 BAUD. FOURTY=0 /@69 -- CREF SAYS FOURTY IS REFERENCED HERE /@70 -- ASSEMBLING WITH FOURTY <> 0 RELATES TO EDU 40. SEE /@71 -- CHAPTER 8 OF ABOVE EDUSYSTEM HANDBOOK FOR DETAIL. /@72 /@73 -- CREF SAYS CONFIG IS REFERENCED ON THIS LINE /@74 /@75 /@76 DTCA=6762 /@77 -- PAL-8 IS MISSING PRE-DEFINED DTXA=6764 /@78 -- DEC TAPE IOTS WHICH APPEAR TO DTSF=6771 /@79 -- BE PRE-DEFINED IN PAL10, SO DEFINE /@80 /@81 /@82 /@83 -- PROBABLY "/DEFINITIONS" /@84 FINT=JMS I 7 /@85 /@86 FEXT=0000 /@87 FXIT=0000 /@88 FNOR=6010 /@89 FSKP=6000 /@90 FSNE=6040 /@91 FSEQ=6050 /@92 FSGE=6100 /@93 FSLT=6110 /@94 FSGT=6140 /@95 FSLE=6150 /@96 /@97 /@98 CAF=6007 /@99 BSW=7002 /@100 /@101 /@102 MQA=7501 /@103 MQL=7421 /@104 SPL=6102 /@105 MTLS=6126 /@106 MTKF=6123 /@107 MTPF=6113 /@108 MTON=6117 /@109 MINT=6115 /@110 MINS=6125 /@111 MKSF=6111 /@112 MKRB=6116 /@113 MTSF=6121 /@114 MTCF=6122 /@115 /@116 /@117 /@118 L0001=CLL CLA IAC /@119 L0002=CLL CLA CML RTL /@120 L7777=CLL CLA CMA /@121 L7776=CLL CLA CMA RAL /@122 L7775=CLL CLA CMA RTL /@123 L3777=CLL CLA CMA RAR /@124 L5777=CLL CLA CMA RTR /@125 L4000=CLL CLA CML RAR /@126 L2000=CLL CLA CML RTR /@127 /@128 /@129 /@130 SWAP=10 LMULT=L7775 LAL1=L7776 LFXUP=L7777 LNFIX=CLA LHIGH=L0001 /PAGE ZERO FIELD 0 PAGE 0 0 JMP I .+1 /INTERRUPT HANDLER INTR8E USER, 0 /INTERRUPT USER COUNTER SIN, 0 /INTERRUPT TEMPORARY TEMP1, 0 /INTERRUPT TEMP TEMP2, USER0 /INTERRUPT TEMP ZFPNT /FLOATING POINT XREG, 0 /INTERRUPT XREG XREG2, 0 /INTERRUPT XREG XREG3, 0 /GENERAL XREG FLTXR, 0 /FLOATING XREG FLTXR2, 0 /FLOATING XREG /USER SWAP AREA STSWAP=. /START OF SWAP PDLXR, TOP /PUSH-DOWN XREG AXIN, 0 /PACKING XREG TEXTP=. /TEXT POINTERS AXOUT, 0 /UNPACK XREG GTEM, 0 /UNPACK SWITCH XCT, 0 /UNPACK SWITCH PC, READY /PROGRAM RESTART ADD, 0 /PACK TEMPORARY XCTIN, 0 /PACK SWITCH SUBS=XCTIN /SUBSCRIPT PT1, 0 /FLOATING POINTER CHAR, 0 /CHARACTER LINEPC, 0 /LINE POINTER LINENO, CIF CDF 10 /LINE NUMBER LASTLN, JMP I .+1 /LAST LINE POINTER MODE=LASTLN SPACSW, TAPEM /0 IS IGNORE SPACES DINPUT, -1 /-1 FOR BREAK ON CR ONLY /0 FOR BREAK ON ANY AND NO ECHO OUTPUT, 0 /0 IS ECHO XIOT, KRB /INPUT IOT XFIELD, 0 /USER FIELD DATAPC, 0 /LINE NUMBER OF DATA STATEMENT CIF CDF 10 /DATA POINTER JMP I .+1 /DATA TEMPORARY DISKM /DATA UNPACK SWITCH 0 /DATA CHARACTER IPTRI, BUFFER /INPUT BUFFER FILL IPTRO, BUFFER /INPUT BUFFER EMPTY IPTR0, BUFFER /START OF BUFFER OPTRI, BUFFER-40 /OUTPUT BUFFER FILL OPTRO, BUFFER-40 /OUTPUT BUFFER EMPTY TELSW, 0 /TTY BUSY SWITCH PACKST, 0 /START OF PACKING PACKND, 0 /POINTER TO END OF PACKING BUFR, LINE1 /NEXT FREE SPACE STARTV=BUFR /START OF VARIABLES LASTV, LINE1 /LAST DEFINED VARIABLE PDLST, TOP /START OF PUSH-DOWN ALINE0, LINE0 /POINTER TO DUMMY LINE COMBUF, BUFCOM /COMMAND BUFFER PRNTC1, 0 /PRINT ZONE COUNT ERLINE, 0 /ERROR LINE FRNDX, 1 /3 WORD 203 /RANDOM INTEGER 5555 ENSWAP=.-1 DECK=XFIELD /USER ON DECK ACSIGN, 0 /FLAC SIGN ACEXP, 0 /FLAC EXPONENT AC3, 0 /FLAC AC2, 0 AC1, 0 SORTCN, 0 /SORT CONSTANT T1, 0 /THREE TEMPS T2, 0 T3, 0 CNTR, 0 /COUNTER THISOP, 0 /CURRENT OP LASTOP, 0 /LAST OP EFOP=CNTR /FUNCTION OP AREADY, READY FLOUTP, FLOUT /FLOATING OUTPUT FLINTP, FLIN /FLOATING INPUT LOOK, USER0-1 /USER BEING RUN OR LOOKED AT /USER0*#USERS-1 (SEE BEG750) LOOKST, USER0 /TO RESET LOOKING FLARGP, FLARG /POINTER TO TEMP FLAC INTEGE, FIX /FIX THE FLAC ROUTINE IFNZRO PDLXR-15 VPDLXR, CCR, 15 /CR C7, 7 /BELL C177, 177 /RUBOUT C137, 137 /BACK ARROW LSTMOD, -1 /SET BY *INPUT* IFNZRO STSWAP-15 STSWM1, C14, 14 /FORM FEED CLF, 12 /LINE FEED M12, -12 /-10 DECIMAL C40, 40 /BUFFER SIZE C77, 77 /RIGHT MASK M10, -10 C10, 10 M40, -40 /-BUFFER SIZE M6, -6 /-MESSAGE LENGTH M100, -100 /CHARACTER TEST C7700=M100 /LEFT MASK M4, -4 /CHARACTER COUNT C100, 100 C4, 4 C3, 3 /NEW INSTRUCTIONS PRINTC=JMS I . /PRINT AC OR CHAR XPRNTC GETC=JMS I . /UNPACK A CHAR APGETC, XGETC SORTJ=JMS I . /SORT JUMP XSORTJ SORTC=JMS I . /SORT ASORTC, XSORTC PUSHA=JMS I . /SAVE AC XPUSHA PUSHJ=JMS I . /PUSH JUMP XPUSHJ PUSHF=JMS I . /SAVE FLOATING DATA XPUSHF POPA=JMS I . /RESTORE AC XPOPA POPJ=JMP I . /POP JUMP XPOPJ POPF=JMS I . /RESTORE FLOATING DATA XPOPF FLGET=JMS I . /FLOATING GET XFLGET FLPUT=JMS I . /FLOATING PUT XFLPUT PRINTX=JMS I . /DO OUTPUT XOUTL ERROR=JMS I . /ERROR XERROR UDF=JMS I . /USER DATA FIELD AUDF, XUDF RTL6=JMS I . /SIX RAL*S XRTL6 TESTN=JMS I . /TEST NUMERIC XTESTN TESTC=JMS I . /TEST CHAR XTESTC PACKC=JMS I . /PACK A CHAR XPACKC GETLN=JMS I . /GET A LINE NUMBER XGETLN TSTCCR=JMS I . /SKIP IF CR CCRTST TSTCOM=JMS I . /SKIP IF COMMA COMTST TSTALP=JMS I . /SKIP IF LETTER ALPTST COMMAN=JMS I . /DETERMINE COMMAND MANCOM FIND=JMS I . /FIND A STATEMENT XFIND GETNXT=JMS I . /GET NEXT LINE NXTGET FINDLN=JMS I . /FIND A LINE XFINDL FREE13=JMS I . /FREE 14 OUTPUT SPACES XFREE3 FREE2=JMS I . /FREE 3 OUTPUT SPACES XFREE2 READC=JMS I . /READ A CHAR XREADC TSTEND=JMS I . /TEST FOR END OF LINE ENDTST TSTLPR=JMS I . /SKIP IF L-PAREN LPRTST CALLF1=JMS I . /CALL SUBR IN FIELD 1 F1CALL GETSGN=TAD I FLARGP /MAINLINE BASIC /WHENEVER THERE IS NOTHING BETTER TO DO OR A JOB WANTS TO /DISMISS ITSELF SO OTHERS CAN TRY THIS ROUTINE IS ENTERED /IT KEEPS LOOKING FOR A JOB WITH BITS 0 AND 1 OFF WHICH /SAYS THAT THE JOB IS NOT WAITING FOR INPUT OR OUTPUT /RESPECTIVELY *177 NULL, ION CDF ISZ I (INTCNT /COUNT FOR RANDOMIZE C60, 60 /PROTECT THE ISZ TAD LOOK TAD MLOOKE /CHECK POSITION OF POINTER SPA CLA JMP .+4 /O.K. TO LOOK AT NEXT /IF PDP 8E, AND NOT DC02 = ASSUME KL8E, NEXT THREE WORDS ARE / CIF / JMP I .+1 / KL8FIX0 /SEE BEG002 AND BEG540 FOR DETAILS. KL8JM0, TAD LOOKST DCA LOOK /RESET POINTER SKP ISZ LOOK /LOOK AT NEXT KL8LF0, TAD I LOOK /GET STATUS CLL RAL SZL SPA CLA JMP NULL /NO GO TAD I LOOK /GET STATUS IOF /NO INTERRUPTS JMS DECKON /PUT HIM ONDECK TAD PC DCA 0 /RESTART LOCATION L7775 /NUMBER OF COMMANDS BEFORE RETURNING DCA PC ION JMP I 0 /GO TO IT... MLOOKE, -USER7+10 /LAST STATUS WORD : SUBTRACT NUMBER OF USERS /MINUS NUMBER OF USERS - SEE BEG750 /*PRNTIT* ROUTINE /ENTER WITH THE AC CONTAINING THE VALUE TO BE PRINTED AS /A DECIMAL NUMBER BETWEEN 1 AND 2047 /IF PRNT5 IS NOT 0 THEN LEADING SPACES ARE NOT PRINTED /PRNT5 IS SET TO 0 AT THE END OF THE ROUTINE ITPRNT, 0 DCA T1 DCA FLTXR /SIGNIFICANCE TESTER L7775 DCA CNTR /DO 3 LOOPS TAD (PRNTLL DCA T2 /LIST OF SUBTRACTIONS PRNT1, DCA T3 /HOLDS DIGIT JMP .+3 ISZ T3 /BUMP DIGIT DCA T1 TAD T1 TAD I T2 /SUBTRACT SMA JMP .-5 CLA ISZ T2 /POINT TO NEXT TAD T3 /GET DIGIT SZA JMP PRNT2 /NON-ZERO TAD FLTXR /SIG YET SNA CLA JMP PRNT3 /NO PRNT2, ISZ FLTXR /NOW SIG TAD C60 PRNT4, PRINTC /PRINT IT PRNT7, ISZ CNTR JMP PRNT1 /LOOP TAD T1 TAD C60 PRINTC /UNITS DIGIT TAD PRNT5 /FORMATTING SZA CLA JMP PRNT6 /NO TAD C40 PRINTC /PRINT SPACE AFTER PRNT6, DCA PRNT5 /RESET FOR LATER JMP I ITPRNT PRNT5, 0 PRNT3, TAD PRNT5 /FORMATTING SZA CLA JMP PRNT7 /NO TAD C40 JMP PRNT4 /*ONDECK* ROUTINE /ROUTINE TO PUT A USER "ON DECK" /ENTER WITH HIS NUMBER ON AC BITS 9-11 DECKON, NULL+1 AND C7 /USER NUMBER ONLY DCA SIN /SAVE NEW TAD DECK CIA TAD SIN SNA CLA JMP I DECKON /FAST EXIT TAD DECK JMS DFIND /LOCATE OLD TAD LSTMOD DCA DINPUT TAD I (XUDF+1 DCA XFIELD TAD I XREG2 CDF SWAP DCA I XREG /SWAP OUT OLD CDF ISZ TEMP2 JMP .-5 TAD SIN JMS DFIND /LOCATE NEW ENTRY1, CDF SWAP TAD I XREG CDF DCA I XREG2 /SWAP IN NEW ISZ TEMP2 JMP .-5 TAD DINPUT DCA LSTMOD TAD XFIELD DCA I (XUDF+1 TAD SIN DCA DECK /NEW USER ONDECK TAD LOOKST TAD DECK DCA TEMP2 /POINT TO STATUS JMP I DECKON DFIND, ENTRY1 ENTRY, CMA DCA TEMP2 TAD (ORG-1 SKP TAD STARTP /SPACE BETWEEN ISZ TEMP2 JMP .-2 DCA XREG /POINT TO USER TAD STSWM1 DCA XREG2 /POINT TO SWAP AREA TAD (STSWAP-ENSWAP-1 DCA TEMP2 /SWAP COUNT JMP I DFIND STARTP, ENSWAP-STSWAP+1 /SPACE BETWEEN PAGE /ERROR ROUTINE /HERE IS WHERE ERROR MESSAGES ARE PRINTED /IT IS CALLED BY A DISMISSAL WITH THE PC SET TO /ERRORX AND THE ERROR ADDRESS IN LSTMOD ERRORX, FREE13 /GET ROOM TAD M40 DCA T3 /BUFFER IS 40 LONG TAD (6007 AND I LOOK DCA I LOOK /DEASSIGN ANY DEVICES L7777 TAD IPTR0 DCA XREG3 /POINT TO I BUFFER UDF DCA I XREG3 /CLEAR BUFFER ISZ T3 JMP .-2 CDF TAD IPTRI DCA IPTRO /NO INPUT IN BUFFER DCA OUTPUT /HAVE ECHO TAD (CDF SWAP DCA I (CSORTC /TABLE IS IN FIELD 1 TAD LSTMOD /GET ERROR CODE SORTC ERRLST-1 TAD M4 TAD SORTCN SMA SZA JMP ERROR2 /TRUE ERROR SZA CLA L7775 /WHAT? TAD C16 /STOP SKP ERROR2, L7777 JMS I (READY1 /PRINT ERROR MESSAGE TAD M4 TAD SORTCN SPA SNA JMP ERROR3 /NO NUMBER WITH THESE JMS I PITPRNT /PRINT ERROR NUMBER TAD ERLINE /WERE WE RUNNING DEFERRED? SPA SNA CLA JMP ERROR1 /NO FREE13 GETC PRINTC /I GETC PRINTC /N TAD C40 PRINTC TAD ERLINE JMS I PITPRNT /PRINT LINE IN ERROR ERROR1, ERROR3, CLA /*READY* ROUTINE /ROUTINE TO PRINT "READY" AND RESET POINTERS /ENTER THE ROUTINE AT START TO OMIT READY MESSAGE READY, FREE13 TAD C3 JMS I (READY1 /PRINT "READY" GETC PRINTC PRINTC TAD (6007 AND I LOOK DCA I LOOK /DEASSIGN DEVICES START, TAD PDLST DCA PDLXR /RESET PUSH-DOWN L7777 DCA LSTMOD /SHORT LIST DCA ERLINE /IMMEDIATE MODE DCA MODE /CLEAR STRING MODE FLAG TAD (ERR330 PUSHA /TRAP TOO MANY *RETURN*S PUSHJ PAKLIN /GET COMMAND LINE /INSERT LINE OR DO COMMAND /AFTER A COMMAND OR LINE IS PACKED INTO THE COMMAND BUFFER /THIS ROUTINE LOOKS AT IT AND EITHER STORES THE LINE OR /GOES TO THE PROPER COMMAND DECODE, TESTN PITPRNT, ITPRNT /A HARMLESS POINTER JMP I PINPUTX /COMMAND GETLN /GET LINE NUMBER SRETN, TAD BUFR DCA AXIN /SET TO REPACK DCA XCTIN TAD LINENO UDF DCA I AXIN /SET LINE NUMBER CDF TSTCCR /JUST LINE NUMBER JMP .+3 /NO JMS I PXDELET /DELETE THIS LINE JMP VARSET ISZ SPACSW /KEEP SPACES SKP GETC PACKC /REPACK LINE TSTCCR JMP .-3 JMS I PXDELET /DELETE OLD LINE UDF IOF TAD I LASTLN /POINTER TO NEXT DCA I BUFR /POINT TO NEXT TAD BUFR DCA I LASTLN /OLD POINTS TO NEW TAD ADD SZA DCA I AXIN /FINISH PACKING TO AN EVEN BOUNDARY FINDLN /FIND THE LINE C16, 16 PUSHJ ENDFND /GET LAST COMMAND ON LINE--IS IT *NEXT*? SNA CLA TAD C10 /8 EXTRA FOR *NEXT* IAC TAD AXIN DCA BUFR /NEW FREE POSITION VARSET, TAD STARTV /RESET VARIABLES AFTER TEXT IS TOUCHED DCA LASTV ION JMP START PINPUTX, INPUTX PXDELET, XDELET PAGE KEY, 0 TAD USER JMS I VDECKON /PUT HIM ONDECK TAD XIOT DCA .+1 /SET READ IOT HLT KEYMSK, AND C177 /IGNORE PARITY SNA JMP KEX /IGNORE 0 AND 200 DCA SIN /SAVE INPUT L7775 TAD SIN M140, SZA CLA JMP KEY7 /NOT CTRL/C ERR004, JMS I PIERROR /IMMEDIATE RECOVERY JMP I KEY /NO RFC IF HE HAS READER THIS TIME KEY7, TAD LSTMOD SNA CLA JMP KEY6 /NO ECHO - BREAK TAD SIN SORTC /CHECK BREAK CCR-1 JMP KEY5 /BREAK TAD SIN SORTC ALT-1 JMP KEY6 /FOUND AN ALTMODE TAD SIN TAD M12 SNA CLA JMP KEX /IGNORE LINE FEED IF NOT BREAK TAD SIN AND P140 SNA JMP KEY3 /ILLEGAL CHAR TAD M140 SNA CLA JMP KEY3 /ILLEGAL CHAR TAD SIN PRINTX /ECHO THE CHAR JMS KEY4 /STORE THE CHAR TAD IPTRO CIA TAD IPTRI /FILLED YET? SPA SNA TAD C40 TAD M12 SPA SNA CLA JMP KEX ANYINP, L3777 AND I TEMP2 /CLEAR I WAIT DCA I TEMP2 KEX, UDF TAD I IPTRI CDF SNA CLA /NO RFC IF BUFFER IS FULL TAD P20 AND I TEMP2 /NOPE, NOW, DOES HE HAVE THE PTR? SZA CLA RFC /SURE NUFF JMP I KEY VDECKON,DECKON PIERROR,IERROR P20, 20 P140, 140 KEY5, L7777 TAD SORTCN SMA SZA CLA JMP .+3 /NO ECHO HERE TAD SIN PRINTX /ECHO BREAK CHAR - CR AND BELL KEY6, JMS KEY4 /STORE CHAR JMP ANYINP /BREAK HERE KEY3, TAD C7 PRINTX /2 BELLS FOR ILLEGAL CHAR TAD C7 PRINTX JMP I KEY KEY4, 0 UDF TAD I IPTRI SZA CLA JMP ERR070 TAD SIN DCA I IPTRI CDF ISZ IPTRI TAD IPTRI CIA TAD C40 TAD IPTR0 SZA CLA /OK? JMP I KEY4 TAD IPTR0 DCA IPTRI /NO-RESET JMP I KEY4 ERR070, JMS I PIERROR JMP I KEY /*FLPUT* ROUTINE XFLPUT, 0 SZA JMP XFLPT2 XFLPT1, L7777 /USE PT1 TAD PT1 XFLPT2, DCA FLTXR L7777 TAD I XFLPUT DCA FLTXR2 L7775 DCA T3 TAD I FLTXR2 /PUT VARIABLE UDF DCA I FLTXR CDF ISZ T3 JMP .-5 ISZ XFLPUT JMP I XFLPUT USER0, 0 USER1, 1 USER2, 2 USER3, 3 USER4, 4 USER5, 5 USER6, 6 USER7, 7 /SORRY THIS IS TO CHOPPED UP-PAGE BOUNDARY YOU KNOW INPUT, PUSHF TEXTP /CURSE YOU GH! PUSHF DATAPC+1 TAD DATAPC+4 PUSHA TAD CCR DCA DATAPC+4 JMS INREAD /SET THOSE VARIABLES JMP INPUT1 /DONE INPUT2, FREE13 TAD C77 PRINTC TAD C40 PRINTC PUSHJ PAKLIN L7777 JMP INPUT2-2 INREAD, 0 SZA CLA JMP INREA3 /RE-ENTRY PUSHJ PRIN10 DCA MODE PUSHJ GETVAR SZA CLA JMP ERR500 /WAS FUNCTION TAD MODE DCA SPACSW PUSHF /SAVE PT1;CHAR;LINEPC PT1 PUSHF /SAVE TEXT TEXTP PUSHF DATAPC+1 POPF /GET POINTERS TEXTP TAD DATAPC+4 DCA CHAR TSTEND /DO WE NEED TO PUT IN MORE? JMP INREA1 /YES INREA4, ISZ INREAD /NO-DONE JMP I INREAD INREA1, TSTCOM /MORE? ERR490, ERROR /JUNK GETC TSTEND /COMMA FOLLOWED BY CR OR '? SKP JMP INREA4 /YES - ASK FOR MORE INREA3, TAD MODE SNA CLA JMP .+4 PUSHJ QINP JMP .+3 PUSHJ EVAL /EVALUATE INPUT PUSHF TEXTP POPF DATAPC+1 TAD CHAR DCA DATAPC+4 /SAVE POINTERS POPF TEXTP POPF PT1 FLPUT /SET VARIABLE FLARG TSTCOM JMP INREA2 GETC JMP INREAD+3 INREA2, TSTEND ERR500, ERROR /JUNK JMP I INREAD L7777 READ, JMS INREAD /SET THOSE VARIABLES POPJ READ1, TAD MODE PUSHA TAD DATAPC FIND 3 ERR510, ERROR /OUT OF DATA DCA DATAPC POPA DCA MODE JMP READ-1 INPUT1, TAD DATAPC+4 /FINISH UP INPUT DCA CHAR TSTEND JMP ERR490 POPA DCA DATAPC+4 POPF /RESTORE POINTERS--THIS WAS INPUT, NOT *READ*; DONT MOVE /DATA POINTERS DATAPC+1 POPF TEXTP DCA CHAR POPJ VLIN0, ALINE0 /TEXT INITIALIZATION ROUTINES INPACK, 0 TAD COMBUF DCA AXIN DCA XCTIN TAD COMBUF DCA PACKST TAD VLIN0 DCA PACKND JMP I INPACK OTPACK, 0 TAD COMBUF DCA AXOUT DCA XCT DCA SPACSW TAD VPDLXR DCA PACKND GETC JMP I OTPACK PAKLIN, JMS INPACK READC PACKC TSTCCR JMP .-3 PACKC /FINISH PACKING CR JMS OTPACK POPJ /*IF* COMMAND IF, PUSHJ /GET FIRST VALUE EVAL PUSHF /AND SAVE IT FLARG TAD MODE PUSHA TAD SORTCN TAD M12 SPA ERR390, ERROR /NO RELATION OR BAD RELATION CLL CML RTL DCA IF1 /SAVE REL OP GETC SORTC /ANOTHER OP? TERMS-1 JMP IF2 /MIGHT BE... IF3, CLA TAD IF1 SORTC /CHECK OP IF4-1 SKP JMP IF+7 /BAD OP TAD SORTCN TAD PIF5 DCA IF1 TAD I IF1 /GET FLOATING SKIP WORD DCA IF6 PUSHJ /GET 2ND VALUE EVAL L7775 COMMAN /GET THEN SNA CLA ERR400, ERROR /NOT THEN POPA TAD MODE SZA CLA JMP IFSTR POPF FLARG FINT FCMP I FLARGP /GET DIFFERENCE FPUT I FLARGP /AND SAVE IT FEXT IF7, GETSGN IF6, HLT /SKIP IF FALSE TESTN POPJ /NOT TRUE (NOTICE WIERD NOP--IF (EXP) (REL) (EXP) THEN .) JMP I PRUNIN /NON-DIGIT--MUST BE COMMAND GOTO, GETLN /DIGIT--ASSUME GOTO TSTEND ERR270, ERROR TAD LINENO /TRANSFER TO THE LINE POPJ PRUNIN, RUN8 IF2, TAD SORTCN TAD M12 SPA JMP IF3 /NO 2ND OP IAC TAD IF1 DCA IF1 GETC JMP IF3+1 PIF5, IF5 LXOUTL2, XOUTL2 TTY, 0 TAD USER JMS I PDECKON /PUT HIM ONDECK DCA TELSW /CLEAR BUSY UDF TTY3, TAD I OPTRO /MORE SNA JMP TTY2 /NO JMS I LXOUTL2 /OUTPUT IT UDF DCA I OPTRO /CLEAR BUFFER ISZ OPTRO /BUMP BUFFER TAD OPTRO CIA TAD IPTR0 SZA CLA JMP TTY2 /OK TAD IPTR0 TAD M40 DCA OPTRO /RESET BUFFER TTY2, JMS I AXFREE /ROOM AVAILABLE NOP JMP I TTY /NOT ENOUGH ROOM L5777 AND I TEMP2 /CLEAR O WAIT DCA I TEMP2 JMP I TTY PDECKON, DECKON AXFREE, XFREE VIF1, IF1-1 IFSTR, POPF /STRING *IF* IF1 /SAVE FIRST STRING TAD FLARGP /POINT TO THE STRINGS DCA MODE TAD VIF1 DCA FLTXR L7775 /DO AN INTEGER COMPARE ON 3 WORDS DCA T3 IFSTR1, TAD I FLTXR /SUBTRACT WORDS, GET SIGN OF DIFFERENCE CMA /THIS GARBAGE CONVERTS CR'S TO ZEROES DCA T1 /AND ADDS ONE TO EACH CHARACTER TAD T1 /SO COMPARES OF DIFFERENT LENGTHS COME OUT OK AND C77 SZA CLA TAD C7700 TAD T1 DCA T1 TAD I MODE IAC AND C77 DCA T2 TAD I MODE TAD C100 AND C7700 TAD T2 TAD T1 SZA /IF DIFFERENCE ZERO, TRY ANOTHER PAIR JMP IF6 /NON ZERO DIFFERENCE, COMPARE THEM ISZ MODE ISZ T3 JMP IFSTR1 JMP IF6 /IF DONE, COMPARE THEM IF1, 0 0 0 TERMS, 40 /SPACE 0 53 /+ 1 55 /- 2 52 /* 3 57 // 4 136 /^ 5 50 /( 6 133 /[ 7 51 /) 10 135 /] 11 74 /< 12 76 /> 13 75 /= 14 /*LET* AND *FOR* COMMANDS FOR, L7777 LET, DCA FOR1 /SAVE DETERMINATOR PUSHJ /GET VARIABLE GETVAR SNA CLA /WAS FUNCTION!?! TAD CHAR TAD MEQL SZA CLA ERR410, ERROR /NO "=" LET2, PUSHF /SAVE ADD,XCTIN,PT1 ADD PUSHJ /GET VALUE EVAL-1 POPF ADD FLPUT /SET VARIABLE FLARG L7777 /COUNT BACK FOR SAFETY TAD AXOUT DCA FOR5 ISZ FOR1 /WHICH COMMAND? JMP LET1 /LET COMMAND TAD ADD SPA CLA ERR420, ERROR /SUBSCRIPTED COMMAN /GET WORD TAD M4 SZA CLA JMP FOR2+3 /NOT *TO* TAD PT1 CIA DCA FOR1 /SAVE POINTER PUSHJ /GET LIMIT EVAL PUSHF /SAVE LIMIT FLARG TSTEND JMP FOR2 /GET INCREMENT PUSHF /INCREMENT IS ONE FLTONE FOR3, TAD LINENO PUSHA TAD LINENO SKP FOR4, POPA FIND /FIND A *NEXT* STATEMENT 1 /-NEXT CODE ERR440, ERROR /OUT OF TEXT PUSHA /SAVE FOR RESTART TSTALP JMP FOR4 PUSHJ /GET VARIABLE GETVAR SZA CLA DCA PT1 /NO SECOND CHANCE ON FUNCTION TSTCCR JMP I NEXERR /WE GOTTA CHECK THAT *NEXT* IS LAST ON LINE NOW, OR WE MIGHT /WIPE OUT HIS PROGRAM [AND THE SYSTEM?] TAD PT1 TAD FOR1 SZA CLA JMP FOR4 /LOOP ISZ PDLXR /DUMP RESTART POPA DCA LINENO TAD LINENO UDF DCA I AXOUT /SET TEXT AND LINE POINTERS TAD FOR5 DCA I AXOUT /SET POINTER CDF POPF /GET INCREMENT FLARG TAD AXOUT FLPUT /PUT INCREMENT FLARG POPF /GET LIMIT FLARG TAD C3 TAD AXOUT FLPUT /SET LIMIT FLARG FINDLN MEQL, -"=+200 LET1, TSTEND ERR450, ERROR /JUNK TAD FOR5 JMP I .+1 FOREXT FOR2, L7776 COMMAN /IS IT STEP? SNA CLA ERR430, ERROR /NOT STEP PUSHJ /GET INCREMENT EVAL PUSHF /SAVE INCREMENT FLARG TSTEND JMP FOR2+3 /JUNK JMP FOR3 FOR1, 0 FOR5, 0 /AXOUT SAVE REG NEXERR, ERR460 UNKWN, TSTALP JMP I PERRR PUSHJ GETVAR SNA CLA /NO WAY TAD CHAR TAD MEQL SZA CLA JMP UNKWN+1 /NO "=" DCA FOR1 /MAKE IT A LET COMMAND JMP LET2 PERRR, ERRCHK /*NEW* AND *BYE* AND *SCRATCH* AND *END* COMMANDS BYE, TSTCCR ERR002, ERROR UDF DCA I ALINE0 L0002 TAD ALINE0 DCA BUFR END, TAD STARTV DCA LASTV JMP I AREADY FATNC, 0 0 /LAST WORD IS SUBR START /*DELETE* ROUTINE XDELET, 0 FINDLN /FIND THE LINE JMP I XDELET /NOT THERE - EXIT ISZ SPACSW GETC TSTCCR /GO TO END OF LINE JMP .-2 TAD AXOUT CMA TAD LINEPC PUSHA /SAVE COUNT TAD LINEPC IAC DCA AXOUT /TO UNPACK DCA XCT PUSHJ ENDFND /GET LAST COMMAND HERE SNA CLA TAD M10 POPA DCA T3 /CORRECTED COUNT TAD LINEPC CIA TAD ALINE0 SNA CLA JMP I XDELET /NOT LINE0 UDF TAD I LINEPC /GET POINTER DCA I LASTLN /REMOVE LINE TAD ALINE0 XDEL3, DCA T2 /CURRENT LINE TAD I T2 SNA JMP XDEL2 /OUT OF TEXT DCA T1 TAD LINEPC CLL CIA TAD T1 SZL CLA TAD T3 /CORRECT LINE TAD T1 DCA I T2 TAD T1 JMP XDEL3 PERR, ERR100-2 XDEL2, L7777 TAD LINEPC DCA XREG3 TAD T3 CMA TAD LINEPC DCA AXOUT TAD T3 TAD BUFR DCA BUFR TAD AXIN CMA TAD AXOUT DCA T1 TAD T3 TAD AXIN DCA AXIN TAD I AXOUT DCA I XREG3 /MOVE TEXT ISZ T1 JMP .-3 JMP XDELET+1 /PUSH ROUTINES XPUSHA, 0 DCA XPUSHJ L7777 /BACK 1 JMS PCHK TAD XPUSHJ UDF DCA I PDLXR /PUSH IT CDF L7777 JMS PCHK /BACK AGAIN JMP I XPUSHA XPUSHJ, 0 TAD I XPUSHJ /GET SEND ADDRESS DCA XPUSHA ISZ XPUSHJ /GET RETURN ADDRESS JMP XPUSHA+2 PCHK, 0 TAD PDLXR DCA PDLXR L0002 TAD LASTV CLL CIA TAD PDLXR SNL CLA JMP I PERR JMP I PCHK /*PUSHF* ROUTINE XPUSHF, 0 L7777 TAD I XPUSHF DCA XREG3 /POINT TO DATA L7775 JMS PCHK /BACK 3 L7775 DCA T3 TAD I XREG3 UDF DCA I PDLXR /PUSH DATA CDF ISZ T3 JMP .-5 L7775 JMS PCHK /BACK 3 AGAIN ISZ XPUSHF JMP I XPUSHF *1777 RND, FINT FGET FRNDX FEXT CIF SWAP JMP I .+1 RND1 MANCOM, 0 DCA FLTXR2 /SAVE AC TAD (LIST7 /START AT BEGINNING OF LIST CDF SWAP /IN FIELD 1 COMLP1, DCA T2 /LIST POINTER L0002 DCA T1 /LETTER POINTER TAD I T2 /GET -UNIQUE COUNT-1 RTR / AND C7 / CLL RAR / CMA / DCA CNTR / JMS COM11 /UNIQUE? JMP COM3 /YES - TRY REST ISZ T2 /GET NEXT COMMAND IN LIST TAD I T2 / SZA /END OF LIST? JMP COMLP1 /NO - GO ON COM5, CDF /YES - RETURN FAILURE JMP I MANCOM /AC=0 COM3, TAD I T2 /GET -FULL LENGTH-3 AND C7 / TAD (2 / CMA / TAD T1 /T1=UNIQUE POINTER+1 DCA CNTR /-NO. OF CHARS TO GO-1 JMS COM11 /LONG FORM OF COMMAND? JMP COM4 /YES - THROW OUT SHORT POINTERS JMP COM8 COM4, TAD C4 /DELETE LAST 4 ENTRIES FROM PDL TAD PDLXR / DCA PDLXR / COM8, TAD I T2 RTL6 RAL AND C77 /GET CODE TAD M40 /CORRECT IT DCA FLTXR /AND SAVE IT TAD FLTXR2 SNA JMP .+4 /NO DOUBLE CHECK TAD FLTXR SZA CLA JMP COM7 /DOUBLE CHECK FAILS CDF TAD C4 TAD PDLXR /DUMPPDLJUNK DCA PDLXR TAD FLTXR JMP I MANCOM COM7, JMS COMPOP /RESET POINTERS TO ENTRY VALUES JMP COM5 /TAKE FAILURE RETURN COM11, 0 /COMMAND COMPARISON CDF PUSHF TEXTP /SAVE TEXT POINTERS TAD CHAR / PUSHA / COMLP2, CDF SWAP ISZ CNTR /-NO. OF CHARS TO GO-1 SKP JMP I COM11 /SUCCESS RETURN FROM COM11 TAD T1 CLL RAR TAD T2 DCA XREG3 TAD I XREG3 SZL JMP .+3 RTL6 RAL AND C77 SNA TAD (-215+337 TAD M137 TAD CHAR SZA CLA /SAME SO FAR? JMP COM13 /NO GO CDF GETC /NEXT CHAR ISZ T1 /LETTER POINTER JMP COMLP2 /LOOP COM13, ISZ COM11 /FAILURE RETURN FROM COM11 JMS COMPOP /RESTORE TEXT POINTERS TO ENTRY VALUES JMP I COM11 COMPOP, 0 /RESTORE TEXT POINTERS FROM PDL POPA DCA CHAR POPF TEXTP CDF SWAP JMP I COMPOP XGETL1, 137 /CR 100 /BELL 40 /SPACE AXUDF, XUDF+1 /NEGATIVE ENDS LIST ALT, 175 176 33 /ALL THOSE ALTMODES M137, -137 /NEGATIVE ENDS LIST /SUBROUTINE TO WRITE OUT MESSAGES READY1, 0 DCA AXOUT /POINT TO MESSAGE DCA XCT TAD M6 DCA T2 TAD I AXUDF /FIELD 1? TAD (-6211 SNA CLA TAD (STMV /YES - DISPLACE ADDRESS TAD AXOUT DCA AXOUT RDY1, GETC PRINTC /PRINT MESSAGE ISZ T2 JMP RDY1 JMP I READY1 PAGE /*EDIT* COMMAND EDIT, GETLN /GET LINE NUMBER TSTCCR SKP /JUNK FINDLN /FIND THE LINE ERR001, ERROR /NOT THERE ISZ SPACSW JMS I CINPACK /SET TO PACK IT MODF2, DCA LSTMOD /READ SILENTLY READC MODF3, TAD CHAR DCA LSTMOD /SET SEARCH CHARACTER MODF1, GETC FREE2 PRINTC /PRINT LINE UNTIL... SORTJ CCR-1 MODL1-CCR PACKC /KEEP PACKING JMP MODF1 MODF4, PACKC /PACK IT READC /GET CHARS SORTJ /CHECK THEM CCR-1 MODL2-CCR JMP MODF4 MODF5, PACKC /PACK THE CR PACKC JMS I COTPACK /SET TO UNPACK IT JMP I CSRETN /*DELETE* COMMAND DELET, JMS GETLIM /GET LIMITS TAD BUFR DCA AXIN /PROTECT TEXT JMS GETLIN /GET A LINE JMP I AREADY /WE ARE DONE JMS I CXDELET /DELETE IT TAD LASTLN DCA LINEPC /RESTORE POINTERS JMP .-5 /LOOP /*LIST* COMMAND LIST, JMS GETLIM /GET LIMITS ISZ SPACSW /KEEP SPACES TAD M100 DCA PT1 TAD OUTPUT SNA CLA JMP LLIST3-3 /NORMAL MODE DCA OUTPUT /WE WILL OUTPUT FOR A WHILE LLIST5, FREE2 L4000 PRINTC /DO L/T ISZ PT1 JMP LLIST5 FREE2 TAD CCR PRINTC LLIST3, JMS GETLIN /GET A LINE JMP LLIST4 /WE ARE DONE FREE13 TAD LINENO JMS I CITPRNT /PRINT THE NUMBER GETC FREE2 PRINTC /PRINT THE LINE TSTCCR JMP .-4 /UNTIL A CR JMP LLIST3 /LOOP LLIST4, TAD PT1 /DID WE PUNCH TRAILER?? SZA CLA JMP I AREADY /NORMAL SO EXIT TAD M100 DCA PT1 /DO IT AGAIN, TURN ECHO OFF LLIST6, FREE2 L4000 PRINTC ISZ PT1 JMP LLIST6 JMP I CTAPE GETLIN, 0 TAD CCR DCA CHAR /FOOL NXTGET GETNXT /GET NEXT LINE JMP I GETLIN /OUT OF TEXT POPA DCA T3 /GET LIMIT TAD T3 PUSHA /SAVE LIMIT TAD LINENO CIA TAD T3 SMA CLA ISZ GETLIN /OK JMP I GETLIN GETLIM, 0 TSTCCR JMP LIMGT1 /NOT ALL DCA LASTLN /START AT 0 L3777 JMP LIMGT3 LIMGT1, GETLN /GET A LINE NUMBER TAD LINENO DCA LASTLN /AND SAVE IT TSTCOM JMP LIMGT2 /ONLY ONE LINE GETC GETLN /GET LINE NUMBER TAD LINENO LIMGT3, PUSHA /UPPER LIMIT TAD LASTLN DCA LINENO /LOWER LIMIT TSTCCR JMP ERR001 /JUNK LIMGT4, FINDLN /FIND THE LINE CSRETN, SRETN TAD LASTLN DCA LINEPC /AND GO BACK ONE JMP I GETLIM LIMGT2, TAD LASTLN /1ST = 2ND JMP LIMGT3 CXDELET, XDELET CTAPE, TAPE CITPRNT, ITPRNT CINPACK, INPACK COTPACK, OTPACK /ABSOLUTE VALUE FUNCTION ABS, DCA ACSIGN POPJ /ONE OF THE LONGER FUNCTIONS /*NEXT* COMMAND NEXT, PUSHJ /GET VARIABLE GETVAR SNA CLA /WAS FUNCTION? TSTCCR /*NEXT* !MUST! BE LAST ON LINE ERR460, ERROR FINT FGET I FLARGP /PUT VARIABLE INTO FLAC FEXT UDF TAD I AXOUT SNA ERR470, ERROR /NEXT NOT INITIALIZED DCA T2 TAD I AXOUT PUSHA TAD AXOUT FLGET /GET INCREMENT FLARG GETSGN NEXT3, SMA CLA TAD C50 /POSITIVE INCREMENT TAD NEXT3 /NEGATIVE INCREMENT DCA NEXT1 /SET LIMIT TEST INSTRUCTION FINT FADD I FLARGP /BUMP VARIABLE FPUT I FLARGP /SAVE VALUE FEXT FLPUT /SET VARIABLE FLARG TAD C3 TAD AXOUT FLGET /GET LIMIT FLARG FINT FSUB I FLARGP FPUT I FLARGP FEXT GETSGN /SIGN OF DIFFERENCE NEXT1, HLT /SKIP IF DONE JMP NEXT2 /NOT DONE L7777 TAD AXOUT DCA T1 UDF DCA I T1 /NOT INITIALIZED NOW RETURN, ISZ PDLXR /*RETURN* AND *POPJ* TSTEND ERR320, ERROR XPOPJ, DCA XREG3 POPA DCA T3 TAD XREG3 JMP I T3 GOSUB1, POPA SKP NEXT2, TAD T2 DCA LINENO FINDLN C50, 50 POPA FOREXT, DCA AXOUT DCA CHAR POPJ /*RUN* COMMAND RUN, TAD STARTV /NO VARIABLES DCA LASTV PUSHF /SET RANDOM NUMBER FRNDX1 POPF FRNDX JMS RUN4 /ZAP THE *NEXT* STATEMENTS IDNE, TAD ALINE0 DCA LINEPC RUN7, GETNXT /NEXT COMMAND FOR EXECUTION JMP I AREADY RUN6, DCA SPACSW /NEED TO IGNORE SPACES GETC ISZ PC JMP RUN8+1 JMS RUN9 /WE'VE HAD OUR TIME SLICE NOW SKP RUN8, ISZ PDLXR /POISON--WATCH IT! DCA MODE TAD LINENO DCA ERLINE COMMAN SMA SZA /LEGAL COMMAND? JMP I (ERRCHK TAD (COMGOL+16 DCA T1 CDF SWAP TAD I T1 CDF DCA .+2 PUSHJ 0 /AND GO TO IT SNA /NORMAL RETURN:AC=0, TRANSFER RETURN:AC=LINENO JMP RUN7 DCA LINENO GOSUB2, FINDLN /LOOK FOR REQUESTED LINE ERR380, ERROR /IT'S NOT THERE JMP RUN6 RUN9, 0 /DISMISSAL ROUTINE:SET PC FOR RETURN TAD RUN9 DCA PC JMP NULL FLOTRX, JMS RUN4 /ZAP THE *NEXT* STATEMENTS L7777 TAD COMBUF DCA LINEPC JMS I (OTPACK L7777 DCA LINENO JMP RUN8+1 RUN4, 0 /UNINITIALIZE ALL THE *NEXT* STATEMENTS CLA TAD ERLINE /START AT LINE 0 FIND /FIND THE *NEXT* STATEMENTS FRNDX1, 1 JMP I RUN4 DCA ERLINE PUSHJ GETVAR SNA CLA /MUST NOT BE FUNCTION, TSTCCR /MUST BE END OF LINE JMP ERR460 UDF DCA I AXOUT /NOT INITIALIZED NOW JMP RUN4+1 PAGE /EXPRESSION EVALUATOR ECALL, 0 TAD SORTCN PUSHA TAD LASTOP PUSHA TAD EFOP PUSHA TAD ECALL PUSHA /RETURN ADDRESS GETC EVAL, DCA LASTOP /0 IS END TAD EVAL1 PUSHA /SAVE EVAL1 DCA EVAL1 /0 EVAL1 TESTC JMP ETERM1 /INITIAL TERMINATOR JMP ENUM /NUMBER JMP EVAR /VARIABLE JMP I (QUOTES /OTHER ETERM1, TAD (FLZERO DCA PT1 /0 DATA L7776 TAD SORTCN SNA JMP ETERM /MINUS IAC SNA CLA JMP ARGNXT /PLUS ELPAR, TSTLPR JMP EVAL2 /CHECK UNARY EPAR2, JMS ECALL /RECURSIVE CALL ISZ PDLXR JMP I (ENDFUN /END AS FUNCTION ENUM, TAD FLARGP DCA PT1 /DATA TO FLARG JMS I FLINTP /GET VALUE OPNEXT, ISZ EVAL1 JMP .+4 /NO UNARY L4000 TAD I PT1 DCA I PT1 /FLIP SIGN DCA EVAL1 SORTC TERMS-1 JMP ETERMN DCA SORTCN /ALL ELSE IS END ETERMN, TSTLPR SKP ERR120, ERROR /EXCESS L-PARENS ETERM, TAD SORTCN DCA THISOP /SET OP TAD THISOP TAD M10 SMA CLA DCA THISOP /END ETERM2, TAD THISOP CIA TAD LASTOP /PRIORITIES SPA CLA JMP EPAR /NO GO YET TAD LASTOP TAD (OPTABL DCA CNTR TAD I CNTR DCA FLOP /SET OP TAD LASTOP SZA CLA POPF /GET DATA AC3 FINT FGET AC3 FLOP, FJMP I (FUPARR /FLOATING OP FPUT I FLARGP /SAVE DATA FEXT TAD FLARGP DCA PT1 /POINT TO DATA TAD THISOP TAD LASTOP SNA CLA JMP EVAL3 /DONE POPA DCA LASTOP /NEW OP JMP ETERM2 EPAR, TSTLPR SKP JMP EPAR2 /DO RECURSIVE TAD LASTOP PUSHA TAD PT1 DCA .+2 PUSHF /SAVE DATA 0 TAD THISOP DCA LASTOP ARGNXT, GETC TESTC JMP ELPAR /T JMP ENUM /N JMP EVAR /V JMP ERR110 /OTHER EVAR, PUSHJ /GET VARIABLE GETVAR SZA JMP I (FUNCT3 /FUNCTION TAD FLARGP DCA PT1 /POINT TO DATA JMP OPNEXT EVAL1, 0 EVAL2, L7776 TAD SORTCN /IS IT + OR -? SMA SZA ERR110, ERROR /NO - DOUBLE OPS OR EX L-PARENS SZA CLA JMP ARGNXT /WAS + TAD EVAL1 CMA DCA EVAL1 /FLIP EVAL1 JMP ARGNXT EVAL3, POPA DCA EVAL1 /RESTORE EVAL1 POPJ /EXIT PAGE /USER FUNCTION PROCESSING FUNCT6, PUSHA /SAVE CHARACTER DCA EFOP ISZ EFOP PUSHF /SAVE ARGS FLARG TSTCOM JMP .+6 /NO MORE ARGS JMS I AECALL /GET NEXT POPA ISZ PDLXR ISZ PDLXR JMP .-12 TAD LASTV DCA SUBS /SAVE END OF VARIABLES TAD EFOP FUNC10, TAD K2000 DCA ADD /CREATE ILLEGAL NAME PUSHJ /LOOK IT UP - WILL DEFINE LOOKUP POPF FLARG FLPUT /SET ARGUMENT FLARG L5777 TAD ADD SZA JMP FUNC10 /MORE ARGUMENTS L4000 POPA CIA DCA FUNC17 /-CHAR OF FUNCTION PUSHF TEXTP TAD SORTCN PUSHA TAD SUBS PUSHA SKP FUNC11, POPA FIND /FIND A *DEF* 11 /-DEF CODE ERR170, ERROR /OUT OF TEXT PUSHA /FOR RESTART COMMAN /GET WORD TAD KM5 SZA CLA JMP FUNC11 TAD CHAR TAD FUNC17 SZA CLA JMP FUNC11 /NOT PROPER FUNCTION ISZ PDLXR TAD ERLINE PUSHA /SAVE CALLING LINE TAD LINENO DCA ERLINE /CALL THIS OUR LINE GETC SORTC TERMS-1 TSTLPR ERR180, ERROR /NO L-PAREN TAD SORTCN PUSHA GETC L2000 DCA T1 TAD LASTV DCA PT1 /POINT TO ARGUMENTS FUNC14, TSTALP JMP ERR180 /ILLEGAL VARIABLE TAD CHAR AND C37 RTL6 RAR DCA T2 /SAVE NAME GETC TESTN C37, 37 JMP FUNC13 /NOT NUMBER TAD CHAR AND C37 TAD T2 DCA T2 GETC FUNC13, ISZ T1 /SET ILLEGAL NAME UDF TAD I PT1 CIA TAD T1 SZA CLA ERR200, ERROR /WRONG NUMBER OF ARGUMENTS TAD T2 DCA I PT1 /SET TEMPORARY NAME CDF TAD M4 TAD PT1 DCA PT1 /POINT TO NEXT TSTCOM JMP FUNC12 /NO MORE GETC JMP FUNC14 FUNC12, ISZ T1 UDF TAD I PT1 CDF CIA TAD T1 SNA CLA JMP ERR200 /SHOULD NOT AGREE SORTC TERMS-1 SKP JMP ERR180 /NO PAREN L7776 TAD SORTCN CIA POPA SZA CLA JMP ERR180 /NO MATCH JMP I AFUN16 FUNC17, 0 /MOVE THIS IF YOU CAN FIND A SAFE TEMP ON PAGE 0 AECALL, ECALL KM5, -5 AFUN16, FUNC16 K2000, 2000 /*PRINT* COMMAND FREE2 TAD CCR PRINTC /PRINT THE CR PRINT6, IAC /DENOTE END POPJ /EXIT PRINT8, GETC /GO BY THE ";" ISZ PT1 /SHOULD WE SPACE? JMP PRINT1 /NO FREE2 TAD C40 PRINTC /PRINT A SPACE PRINT1, SORTJ /CHECK , " ' CR PRNTL1-1 PRNTL2-PRNTL1 PRINT4, L7777 COMMAN SNA CLA POPJ /MUST BE VALUE TAD T2 TAD (-LIST14 PUSHA /PUSH A ZERO ON STACK IF CHR$,NONZER IF TAB SORTC TERMS-1 TSTLPR ERR340, ERROR /NO "(" JMS I (ECALL /GET RECURSIVE ISZ PDLXR /DUMP EFOP JMS I .+2 /CALL PARTST POPA /TAB OR CHR$? PARTS=SZA CLA PARTS JMP I (PRIN12 /GO GET ARG MOD 72 JMS I INTEGE TAD (-15 /WAS IT CHR$(13)? SNA /NO- PRINT IT JMP PRIN11 /YES- TAB(0) TO AVOID THE LINE FEED TAD CCR /RESET CHARACTER PUSHA FREE2 POPA SNA /AC=0 WILL PRINT CHAR L4000 PRINTC JMP PRIN10 PRIN11, CMA DCA PT1 /SET -COUNT -1 TAD PRNTC1 TAD (110 TAD PT1 SPA JMP PRINT9 CLA IOF TAD CCR JMS I (XOUTL2 TAD CCR JMS I (XOUTL2 TAD (-110 DCA PRNTC1 ION SKP PRINT9, DCA PT1 ISZ PT1 SKP JMP PRIN10+1 FREE2 TAD C40 PRINTC JMP PRINT9+1 L7777 PRIN10, DCA PT1 /SET SPACE INDICATOR SORTJ /CHECK ; , ' " OR \ PRNTL4-1 PRNTL6-PRNTL4 ISZ PT1 /NO FIND O.K.? JMP PRINT4 /YES - ASSUME TAB OR EXPRESSION ERR350, ERROR /NO - SYNTAX ERROR PRINT2, ISZ SPACSW /KEEP SPACES GETC SORTJ /CHECK - CR PRNTL7-1 PRNTL8-PRNTL7 FREE2 PRINTC /PRINT THE LITERAL JMP PRINT2+1 PRINT3, DCA SPACSW GETC /GO BY THE " JMP PRIN10 /GO CHECK CHARACTER FREE2 TAD C40 PRINTC /SPACES TO FINISH ZONE PRINT5, TAD C7 TAD PRNTC1 TAD CCR SPA JMP .-2 SZA CLA JMP PRINT5-3 /KEEP GOING GETC /GO BY THE "," JMP PRINT1 /*PRINTX* ROUTINE XOUTL, 0 SNA TAD CHAR /USE CHAR IF AC=0 JMS I (XOUTL2 /DO OUTPUT TAD XREG3 TAD (-15 /WAS IT A CR SNA JMP XOUTL1 /YES! TAD (215-240 SPA JMP XOUTL3 /IT IS A NON-PRINTING CHARACTER TAD M100 SPA CLA ISZ PRNTC1 /IT IS A PRINTING CHAR SO COUNT IT JMP I XOUTL TAD CCR /END OF LINE SO DO CR-LF JMP XOUTL+3 XOUTL1, TAD CLF JMS I (XOUTL2 /OUTPUT A LINE FEED TAD (-110 DCA PRNTC1 /RESET COUNT XOUTL3, CLA JMP I XOUTL PAGE XOUTL2, 0 CDF DCA XREG3 /SAVE CHAR TAD OUTPUT SZA CLA JMP XOUTL4 /NO ECHO TAD TELSW /BUSY SZA CLA JMP XOUTL5 /YES TAD C10 AND I TEMP2 SNA CLA JMP .+3 TAD CPLS /HE HAS PUNCH JMP .+3 TAD C10 TAD XIOT DCA XOUTL6 /SET OUTPUT IOT TAD DECK CLL CML CMA DCA T3 SKP RAR ISZ T3 JMP .-2 TAD C10 /TURN ON GROUP 1 MTON /TURN ON PROPER USER - 0 IF NOT DCO2(SEE BEG760) CLA TAD XREG3 XOUTL6, HLT DCA TELSW /SET BUSY TAD I XAUSER /0 IF NOT DC02 MTON /ALL ON AGAIN - 0 IF NOT DC02 CLA JMP XOUTL4 XAUSER, AUSER XOUTL5, UDF TAD I OPTRI /ROOM SZA CLA ERR080, JMS IERROR /NO ROOM UDF TAD XREG3 DCA I OPTRI /FILL BUFFER ISZ OPTRI /BUMP BUFFER TAD OPTRI CIA TAD IPTR0 SZA CLA JMP XOUTL4 /OK TAD IPTR0 TAD M40 DCA OPTRI /RESET BUFFER XOUTL4, CDF JMP I XOUTL2 CPLS, PLS /*FINDLN* ROUTINE XFINDL, 0 TAD LINENO SPA CLA JMP XFNDL3 UDF TAD ALINE0 DCA LASTLN TAD ALINE0 XFNDL1, DCA LINEPC /CURRENT LINE TAD LINEPC DCA XREG3 TAD LINENO CIA TAD I XREG3 SNA JMP XFNDL2-1 /FOUND LINE SMA CLA JMP XFNDL2 /WENT BEYOND TAD LINEPC DCA LASTLN TAD I LINEPC SZA JMP XFNDL1 /LOOP SKP /OUT OF TEXT ISZ XFINDL /FOUND LINE XFNDL2, TAD LINEPC IAC DCA AXOUT /SET TO UNPACK DCA XCT CDF JMP I XFINDL XFNDL3, L7777 TAD COMBUF DCA LINEPC JMP XFNDL2-1 /ERROR ENTERING ROUTINES XERROR, 0 IOF CLA IERRO1, CDF TAD C177 DCA IERROR IERRO2, TAD XERROR CLL RAR /FORM ERROR CODE DCA LSTMOD L3777 AND I TEMP2 /CLEAR I WAIT DCA I TEMP2 TAD PERRORX DCA PC /SET FOR RESTART JMP I IERROR PERRORX, ERRORX IERROR, 0 L7777 TAD M40 TAD IPTR0 DCA XREG3 TAD M40 DCA T3 /BUFFER COUNT UDF DCA I XREG3 /CLEAR BUFFER ISZ T3 JMP .-2 CDF TAD OPTRI DCA OPTRO TAD IERROR DCA XERROR TAD LOOK CIA TAD TEMP2 SNA CLA JMP IERRO1 JMP IERRO2 /NOT RUNNING PAGE /*PACKC* ROUTINE XPACKC, 0 SORTJ XPAKL1-1 XPAKL2-XPAKL1 SORTC /CHECK FOR ALTMODE ALT-1 JMP XPPCK1 /IT IS ALTMODE TAD CHAR TAD M40 XPACK4, ISZ XCTIN JMP XPACK1 /NO PARTIAL TAD ADD /FORM WORD UDF DCA I AXIN /PACK IT CDF DCA ADD TAD I PACKND TAD M12 CLL CIA TAD AXIN SZL CLA ERR060, ERROR /TOO FAR XPACK5, JMP I XPACKC XPACK2, TAD XP37 XPACK3, TAD C40 JMP XPACK4 XPACK1, RTL6 DCA ADD /SAVE PARTIAL L7777 DCA XCTIN /INDICATE PARTIAL JMP I XPACKC XPACK7, ISZ XCTIN /PARTIAL HERE JMP XPACK8 /NO XPACK9, DCA ADD TAD C137 PRINTC /PRINT BACK ARROW JMP I XPACKC XPACK8, TAD PACKST CIA TAD AXIN SNA CLA JMP I XPACKC /ALL GONE ANY HOW TAD AXIN DCA T3 L7777 DCA XCTIN /INDICATE PARTIAL L7777 TAD AXIN DCA AXIN /PUT IT BACK ONE UDF TAD I T3 /GET OLD AND C7700 JMP XPACK9 XPRDY1, READY1 XP37, 37 C44, 44 XPPCK1, PUSHF /SAVE TEXT POINTERS TEXTP TAD XPACKC PUSHA /SAVE ADDRESS IF DISMISSED FREE13 TAD C44 PRINTC /PRINT "$" TAD C40 PRINTC TAD C7 JMS I XPRDY1 GETC /FINISH MESSAGE PRINTC GETC PRINTC POPA DCA XPACKC /RESTORE ADDRESS TAD PACKST DCA AXIN POPF TEXTP DCA CHAR JMP XPACK1+3 /*READC* ROUTINE XREADC, 0 UDF CIF /NO INTERRUPTS WHILE MESSING WITH IPTR0 /AND HIS BUFFER - ELSE THE READER DIES TAD I IPTRO /GET CHAR DCA CHAR /SET CHARACTER DCA I IPTRO /CLEAR BUFFER CDF TAD CHAR SNA CLA /WAS THERE A CHARACTER JMP XREAD1 /NO - WAIT ISZ IPTRO /BUMP BUFFER TAD IPTRO CIA TAD C40 TAD IPTR0 SZA CLA JMP .+3 /OK TAD IPTR0 DCA IPTRO /RESET BUFFER JMP I XREADC IF5, SMA SZA CLA SPA CLA SNA CLA SMA CLA SPA SNA CLA SZA CLA /POP THE AC ROUTINE XPOPA, 0 UDF TAD I PDLXR CDF JMP I XPOPA /*TSTLPR* ROUTINE LPRTST, 0 TAD SORTCN TAD M6 SPA CLA JMP I LPRTST /NOT L-PAREN TAD SORTCN TAD M10 SPA CLA ISZ LPRTST /L-PAREN JMP I LPRTST XR20, 20 XREAD1, L7777 TAD XREADC DCA PC /SET TO REDO ROUTINE TAD I LOOK AND XR20 SZA CLA RFC /HE'S GOT THE READER WITH AN EMPTY BUFFER! TAD I LOOK JMS I (XOR 4000 /I WAIT AND DISMISS /*POPF* ROUTINE XPOPF, 0 L7777 TAD I XPOPF DCA XREG3 /POINT TO DATA AREA L7775 DCA T3 POPA DCA I XREG3 /MOVE DATA ISZ T3 JMP .-3 ISZ XPOPF JMP I XPOPF /*TESTN* ROUTINE XTESTN, 0 TAD CHAR TAD TH60 DCA SORTCN /SAVE BINARY DIGIT L0002 TAD SORTCN SNA JMP I XTESTN /PERIOD ISZ XTESTN TAD TH13 SMA SZA CLA JMP I XTESTN /GREATER THAN 271 TAD SORTCN SMA CLA ISZ XTESTN /DIGIT JMP I XTESTN TH60, -60 TH13, -13 /*GETC* ROUTINE XGETC, 0 ISZ XCT JMP XGET1 /NO PARTIAL TAD GTEM /GET PARTIAL XGET2, AND C77 /AND OFF JUNK TAD C40 /CORRECT TO ASCII DCA CHAR SORTJ /CHECK SPECIALS XGETL1-1 XGETL2-XGETL1 JMP I XGETC XGET1, UDF TAD I AXOUT /GET NEXT CDF DCA GTEM /SAVE PARTIAL L7777 DCA XCT /INDICATE PARTIAL TAD GTEM RTL6 RAL JMP XGET2 XGET3, TAD SPACSW /SPACE TEST SZA CLA JMP I XGETC /KEEP SPACES JMP XGETC+1 /IGNORE SPACES XGET4, TAD C7 /BELL XGET6, DCA CHAR JMP I XGETC XGET5, TAD CCR /CR JMP XGET6 /*GETNXT* ROUTINE NXTGET, 0 SKP CLA GETC TAD CHAR TAD MSPLAT SNA CLA JMP NXEX TSTCCR JMP NXTGET+2 UDF TAD I LINEPC SNA JMP NXEX+1 /OUT OF TEXT DCA LINEPC TAD LINEPC DCA AXOUT DCA XCT TAD I AXOUT DCA LINENO NXEX, ISZ NXTGET CDF JMP I NXTGET /*FIND* ROUTINE XFIND, 0 DCA LINENO FINDLN MSPLAT, 200-"\ XFIND1, GETNXT /GET THE NEXT STATEMENT JMP XFIND2 /OUT OF TEXT GETC COMMAN TAD I XFIND /CORRECT COMMAND SZA CLA JMP XFIND1 /NO - LOOP ISZ XFIND TAD LINENO /FOR RESTART XFIND2, ISZ XFIND JMP I XFIND XPRNTC, 0 IOF PRINTX ION JMP I XPRNTC POPF FLARG /DUMP IT WHERE IT WONT HURT ENDFND, DCA SPACSW PUSHF TEXTP GETC TSTEND JMP .-2 TSTCCR JMP ENDFND-2 POPF TEXTP GETC COMMAN IAC POPJ OPTABL, FGET I PT1 FADD I PT1 FSUB I PT1 FMUL I PT1 FDIV I PT1 FJMP 0 /5775 = FJMP I (FUPARR, ON PG 2600 (SEE BEGMV4) PAGE /CHARACTER TEST ROUTINES COMTST, 0 TAD (200-", TAD CHAR SNA CLA ISZ COMTST /FOUND IT JMP I COMTST CCRTST, 0 TAD CCRTST DCA COMTST TAD (200-215 JMP COMTST+2 ENDTST, 0 TAD (200-"\ TAD CHAR SNA ISZ ENDTST TAD (-"'+"\ SNA CLA IAC TAD ENDTST JMP CCRTST+2 ALPTST, 0 TAD CHAR TAD (200-"A SPA CLA JMP I ALPTST /LESS THAN *A* TAD CHAR TAD (200-"Z SPA SNA CLA ISZ ALPTST /LETTER JMP I ALPTST /*TESTC* ROUTINE XTESTC, 0 SORTC TERMS-1 JMP I XTESTC /TERMINATOR ISZ XTESTC TESTN JMP I XTESTC SKP JMP I XTESTC ISZ XTESTC TSTALP ISZ XTESTC /OTHER JMP I XTESTC /LETTER /*GOSUB* COMMAND, WORKS FROM MIDDLE OF LINES AND FROM /IMMEDIATE MODE GOSUB, GETLN TSTEND ERR290, ERROR GOSUB3, L7777 TAD AXOUT /COUNT BACK PUSHA TAD ERLINE PUSHA /TO RETURN TO TAD (GOSUB1 PUSHA JMP I (GOSUB2 /*ON* COMMAND ON, PUSHJ EVAL /GET VALUE COMMAN TAD C7 /IS IT GOTO SNA JMP .+5 /YES TAD (4 /HOW ABOUT GOSUB SZA CLA ERR300, ERROR /JUNK L7777 /SIGNIFY GOSUB DCA T2 JMS I INTEGE SNA SPA SZL JMP ON2 /BAD INDEX CIA DCA T1 /MAKE COUNT ON1, GETLN /GET A LINE ISZ T1 JMP .+3 /NOT THIS ONE TAD LINENO PUSHA /SAVE FOR LATER TSTCOM JMP .+3 /NOT COMMA--TRY FOR END GETC JMP ON1 /LOOK AT NEXT TSTEND JMP ERR300 /JUNK TAD T1 SPA CLA JMP ON2 /IT AINT THERE POPA DCA LINENO TAD LINENO ISZ T2 /WHICH COMMAND? POPJ /JUST GOTO--TRANSFER TO IT JMP GOSUB3 ON2, TAD ERLINE DCA LINENO POPJ INT, FINT FSLT FJMP FFIX+1 /POSITIVE--GREATEST INT(X)=FIX(X) FPUT I (TEMP FADD FCN /INTEGERIZE IT ALREADY FCMP I (TEMP FSEQ FSUB FLTONE /NOT AN INT, AND NEG--GOTTA SUBTRACT 1 FADD I (TEMP FSKP FFIX, FINT FADD FCN /DOUBLE CHECK ON INT FUNCTION ALSO FEXT POPJ FLTONE, 2014 0 0 FCN, 2330 0 0 /CHECK FOR IMMEDIATE MODE ON UNRECOGNIZED COMMAND--"WHAT?" /OR "ERROR 47" /NOTE THAT THIS MUST BE AN EVEN ADDRESS OR WE DON'T HAVE /UNIQUENESS ON ERRORS!!!!!!! (SEE INIT CODE AS TO WHY) IFNZRO .&1 <:"#%&'IDIOT!> ERRCHK, TAD ERLINE SMA SZA CLA ERR520, ERROR ERR000, ERROR PAGE /GET A VARIABLE OR FUNCTION ROUTINE /EXIT WITH AC NON-ZERO IF FUNCTION /AC IS LIST POINTER UNLESS /AC IS NEGATIVE, THEN AC IS CHAR FOR USER FUNCTION GETVAR, TSTALP ERR220, ERROR /MUST BE LETTER TAD CHAR AND P37 RTL6 RAR DCA ADD /SAVE FOR NAME GETC TESTC JMP SUBT /T - TEST FOR SUBSCRIPT JMP P37-1 /N - ADD TO NAME JMP I FUNCTI /TRY FOR FUNCTION TAD CHAR TAD MDOLR SZA CLA JMP LOOKUP /0 - VARIABLE LOOKUP ISZ MODE JMP P37+2 TESTN P37, 37 JMP LOOKUP /WAS A . TAD CHAR AND P37 TAD ADD DCA ADD /NEW NAME GETC SORTC TERMS-1 JMP SUBT LOOKUP, UDF TAD LASTV GS1, DCA PT1 /POINT TO VARIABLES TAD STARTV CIA TAD PT1 SNA CLA JMP GS2 /NOT FOUND AT ALL TAD I PT1 /GET NAME CLL CIA TAD ADD SNA JMP GFND1 /FOUND NAME SNL CIA /POSITIVE DIFFERENCE CLL RTL /AC WILL BE 0 IF DIFFERENCE WAS 2000 SNA CLA ERR130, ERROR /ERROR - A(I) AND A(I,I) CANNOT EXIST TOGETHER TAD I PT1 SPA CLA L7777 /BACK 1 FOR SUBSCRIPT GS4, TAD M4 TAD PT1 JMP GS1 /LOOP GS2, TAD C7 TAD LASTV /ROOM LEFT CLL CIA TAD PDLXR SZL CLA JMP .+4 TAD STARTV DCA LASTV /KILL EM-OVFLOW ERR100, ERROR /NO ROOM TAD C4 TAD LASTV DCA PT1 /POINT TO NEW SPACE TAD ADD SMA CLA JMP GPUT1 TAD SUBS DCA I PT1 /SET SUBSCRIPT ISZ PT1 GPUT1, TAD ADD DCA I PT1 /SET NAME CDF TAD PT1 PUSHA L0001 TAD LASTV DCA PT1 /POINT TO NEW DATA SPACE POPA DCA LASTV /NEW LIMIT FLPUT /SET TO 0 FLZERO JMP I GS5I GS5I, GS5 MDOLR, -44 FUNCTI, FUNCT ECALLI, ECALL SUBT, TSTLPR JMP LOOKUP /NOT SUBSCRIPTED TAD ADD DCA EFOP JMS I ECALLI /GET SUBSCRIPT L4000 POPA DCA ADD /SAVE NAME JMS I INTEGE SPA SZL SUB1, ERROR /TOO BIG OR NEGATIVE ERR230=SUB1 DCA SUBS /SET SUBSCRIPT TSTCOM JMP SUB2 /ONLY ONE SUBSCRIPT PUSHF /SAVE ADD,SUBS ADD PUSHJ /GET SECOND SUBSCRIPT EVAL-1 POPF ADD JMS I INTEGE AND C7700 RAR PARTS1, SZA CLA JMP SUB1 /TOO BIG TAD SUBS AND C7700 SZA CLA JMP SUB1 /TOO BIG TAD SUBS RTL6 TAD AC3 /FORM DOUBLE SUBSCRIPT DCA SUBS L2000 TAD ADD DCA ADD /INDICATE 2 SUBSCRIPTS SUB2, JMS I PARTS1 /CHECK PAREN MATCH JMP LOOKUP GFND1, TAD ADD SMA CLA JMP GFND2 /NO SUBSCRIPT L7777 TAD PT1 DCA PT1 TAD I PT1 /GET SUBSCRIPT CIA TAD SUBS SZA CLA JMP I PGS4 /WRONG SUBSCRIPT GFND2, CDF L7775 TAD PT1 DCA PT1 /POINT TO DATA GS5, FLGET /GET VARIABLE FLARG POPJ FUNCT, TAD CHAR AND F37 TAD ADD SORTC FUNL1-1 SKP JMP I LLOOKUP /NOT A FUNCTION TAD SORTCN SNA CLA JMP FUNCT4 /USER FUNCTION PUSHF TEXTP TAD CHAR PUSHA GETC TAD CHAR DCA PT1 POPA DCA CHAR POPF TEXTP TAD SORTCN TAD LFUNL2 DCA T3 CDF SWAP TAD I T3 /GET CORRECT CODE CDF TAD PT1 SZA CLA JMP I LLOOKUP /WAS NOT A FUNCTION TAD SORTCN PUSHA /SAVE CONSTANT GETC FUNCT5, GETC SORTC TERMS-1 F37, 37 TSTLPR ERR240, ERROR /NO L-PAREN POPA IAC /FUNCTION CODE POPJ PGS4, GS4 LLOOKUP, LOOKUP LFUNL2, FUNL2-1 FUNCT4, GETC TSTALP ERR250, ERROR /NOT LETTER L3777 TAD CHAR PUSHA /SAVE CHAR OF USER FUNCTION JMP FUNCT5 /*SORTC* ROUTINE XSORTC, 0 SNA TAD CHAR /USE CHAR IF AC IS 0 CIA DCA T3 TAD I XSORTC DCA XREG3 /SET TO LIST CSORTC, 0 TAD I XREG3 CDF SPA JMP XSORT3 /END OF LIST TAD T3 SZA CLA JMP CSORTC /NO GO - LOOP TAD I XSORTC CMA TAD XREG3 DCA SORTCN /SET CONSTANT SKP XSORT3, ISZ XSORTC ISZ XSORTC CLL CLA DCA CSORTC JMP I XSORTC /*SORTJ* ROUTINE XSORTJ, 0 SNA TAD CHAR /USE CHAR IF AC IS 0 CIA DCA T3 TAD I XSORTJ DCA XREG3 /SET TO LIST ISZ XSORTJ TAD I XREG3 SPA JMP XSORT1 /END OF LIST TAD T3 SZA CLA JMP .-5 /NO GO - LOOP TAD XREG3 TAD I XSORTJ DCA XSORTJ CDF SWAP TAD I XSORTJ /GET ADDRESS CDF DCA XSORTJ XSORT1, CLL CLA ISZ XSORTJ JMP I XSORTJ VMEQL, 200-"= FUNC16, GETC TAD CHAR TAD VMEQL SZA CLA ERR210, ERROR PUSHJ EVAL-1 TSTEND JMP .-4 POPA DCA ERLINE TAD ERLINE DCA LINENO FINDLN IECALL, ECALL POPA DCA LASTV POPA DCA SORTCN POPF TEXTP DCA MODE JMP ENDFUN FUNC6I, FUNCT6 FUNL3I, FUNL3-2 FUNCT3, DCA EFOP JMS I IECALL POPA SPA JMP I FUNC6I TAD FUNL3I DCA EFOP CDF SWAP TAD I EFOP CDF DCA .+2 PUSHJ 0 /END OF A FUNCTION ENDFUN, FINT FNOR /NORMALIZE IT FPUT I FLARGP /SAVE DATA FEXT ENDF1, TAD FLARGP DCA PT1 /POINT TO DATA DCA SPACSW JMS I .+2 JMP I .+2 PARTST OPNEXT SGN, FINT FSGE FGET MNSONE FSLE FGET I VFLTONE FEXT POPJ VFCN, FCN VTEMP, TEMP VFLTONE, FLTONE VFUPAR1, FUPAR1 MNSONE, 6014 0 0 FUPARR, FPUT I VTEMP FGET I PT1 FADD I VFCN FCMP I PT1 FSEQ FJMP EXPLNG FGET I PT1 FSGE FMUL MNSONE FSUB I VFUPAR1 FSLE FJMP EXPLNG FGET I PT1 FSLT FJMP .+5 FGET I VFLTONE FDIV I VTEMP FPUT I VTEMP FGET I PT1 FEXT JMS I INTEGE SPA CIA CMA DCA FUPAR2 FINT FGET I VFLTONE FEXT JMP .+4 FINT FMUL I VTEMP FEXT ISZ FUPAR2 JMP .-4 JMP FUPAR3 EXPLNG, FGET I VTEMP FEXT PUSHJ LOG FINT FMUL I PT1 FEXT PUSHJ FEXP FUPAR3, FINT FJMP I VFLOP VFLOP, FLOP+1 FUPAR2, 0 /JUST A TEMP XFLGET, 0 SZA JMP XFLGT2 L7777 TAD PT1 XFLGT2, DCA FLTXR L7777 TAD I XFLGET DCA FLTXR2 L7775 DCA T3 UDF TAD I FLTXR /MOVE FLOATING DATUM DOWN CDF DCA I FLTXR2 ISZ T3 JMP .-5 ISZ XFLGET JMP I XFLGET INTRPL, TLS /USER 0 TLS IOT = INIT BEG750 MTLS /USER 1 TLS IOT MTLS /USER 2 MTLS /USER 3 MTLS /USER 4 MTLS /USER 5 MTLS /USER 6 MTLS /USER 7 INTR8E, CIF SWAP /FOR POWER FAIL RECOVERY JMP I .+1 INTR81 INTRPT, DCA SAVAC /SAVE THE AC RAR DCA SAVLK /AND THE LINK TAD T3 DCA T3SV /SAVE T3 TAD XREG3 DCA XREG3S /SAVE XREG3 TAD SORTCN DCA SRTCNS /SAVE SORTCN TAD I AUDF DCA UDFSV /SAVE UDF ADDRESS TAD I ASORTC DCA SORTCS /SAVE SORTC ADDRESS TAD I (CSORTC /SAVE SORTC FIELD OP DCA SC2SV DCA I (CSORTC /NOW FIELD 0 TAD I (XFREE DCA FREESV /SAVE XFREE ADDRESS DCA USER /START AT USER 0 RSF JMP PUNCHK RRB /MAKE SURE TO CLEAR IT DCA TEMP1 JMS I (RCHK JMP PUNCHK JMS I (DECKON /PUT HIM ONDECK TAD (EXIT /DON'T GO THROUGH THE REST OF THIS GARBAGE 300 TIMES/SEC! DCA I (KEY TAD TEMP1 /GET THAT CHAR JMP I PKEYMK /GO DO IT PUNCHK, PSF /IS IT THE PUNCH? JMP NONP /NOPE, PCF JMS I (PUNCH /ANYONE GOT IT? JMP EXIT /NOPE JMS I (TTY /FOOL THE TTY ROUTINE NONP, DCA TEMP1 /NO TTY'S TO TURN ON AT FIRST TAD ( INTRPL DCA INTRPP /SET LIST POINTER INTRP1,TAD I INTRPP /GET TLS IOT TAD M4 DCA INTRP4 /TCF L7777 TAD INTRP4 DCA INTRP3 /TSF TAD M10 TAD INTRP3 DCA INTRP2 /KSF TAD TEMP1 MTON /TURN ON PROPER USER - 0 IF NOT DC02(SEE BEG760) CLA INTRP2, HLT /KEY? SKP CLA /NO JMS I (KEY /READ TTY TAD TEMP1 MTON /USER ON AGAIN - 0 IF NOT DC02 CLL RAR /SHIFT FOR NEXT USER SNA /FIRST TIME? TAD (4004 /YES = GET TTY #1 BIT TAD C4 DCA TEMP1 INTRP3, HLT /TTY? JMP .+3 /NO INTRP4, HLT /CLEAR ITS FLAG JMS I (TTY /DO TTY OUTPUT ISZ USER /NEXT USER PLEASE ISZ INTRPP /BUMP LIST POINTER TAD USER TAD MUSER /ARE WE DONE? SZA CLA JMP INTRP1 /NO INTRP5, TAD AUSER /0 IF NOT DC02 MTON /TURN ALL USERS ON AGAIN - 0 IF NOT DC02 EXIT, CLA TAD I LOOK /GET RUNNING USER RAL SPA SZL CLA JMP .+3 TAD I LOOK JMS I (DECKON /AND PUT HIM ONDECK TAD T3SV DCA T3 /RESTORE ALL THOS STORED THINGS TAD XREG3S DCA XREG3 TAD SRTCNS DCA SORTCN TAD SC2SV DCA I (CSORTC /MAKE SURE TO RESTORE SORTC FIELD OP TAD UDFSV DCA I AUDF TAD SORTCS DCA I ASORTC TAD FREESV DCA I (XFREE ISZ I (INTCNT /COUNT INTERRUPTS PKEYMK, KEYMSK /IF PDP 8E, AND NOT DC02 - ASSUME KL8E, NEXT THREE WORDS ARE: / CIF SWAP / JMP I .+1 / KL8FIX1 /SEE BEG002 AND BEG540 FOR DETAILS. KL8JMP, TAD SAVLK /GET THE LINK BACK CLL RAL TAD SAVAC /AND THE AC ALSO KL8LFL, RMF ION JMP I 0 /EXIT FROM INTERRUPT SC2SV, 0 INTRPP, INTRPL SAVAC, 0 SAVLK, 0 T3SV, 0 XREG3S, 0 SRTCNS, 0 UDFSV, 0 FREESV, 0 MUSER, -1 /-1 FOR 1 USER, -2 FOR 2, ETC. AUSER, 0 /SET TO 0 IN BEG750 SORTCS, 0 PAGE /CALL TO FP INTERPRETER IN FIELD 1 ZFPNT, 0 CLA /MAY NOT BE NEEDED, BUT JUST TO BE SAFE CIF CDF SWAP TAD ZFPNT /GET RETURN ADDRESS DCA I .+3 /PASS IT ALONG CDF /INTERPRETER EXECUTES IN DATA FIELD 0 JMP I FPENT /ENTER FPNT /ENTRY TO FIELD 1 SUBROUTINE CALLER F1CALL, 0 CIF CDF SWAP JMP I .+1 F1CAL1 /*MOD* FUNCTION MOD, PUSHF FLARG TSTCOM JMP I (ERR560 PUSHJ EVAL-1 POPF PIF1, IF1 MOD1, FINT FGET I PIF1 FDIV I FLARGP FADD I (FCN FMUL I FLARGP FPUT I (TEMP FGET I PIF1 FSUB I (TEMP FEXT POPJ PRNTEX, TAD CHAR PUSHA PUSHF TEXTP PUSHF FLARG TAD PDLXR DCA AXOUT /SET UP UNPACKING FROM STACK DCA XCT TAD M6 DCA MODE ISZ SPACSW PRNTX1, GETC TSTCCR SKP JMP .+4 PRINTC ISZ MODE JMP PRNTX1 POPF FLARG POPF TEXTP POPA DCA CHAR DCA MODE /IN CASE OF A STRING LESS THAN 6 DCA SPACSW /IGNORE SPACES AGAIN PRINT, PUSHJ PRIN10 SZA CLA POPJ /ALL DONE FREE13 PUSHJ EVAL /GET EXPR. TAD MODE SZA CLA JMP PRNTEX TAD PRNTC1 TAD (16 SPA CLA JMP .+3 /IT WILL FIT TAD CCR /MAKE IT FIT PRINTC JMS I FLOUTP PRNTX2, L7777 JMP PRINT /*FREE* ROUTINE XFREE, 0 UDF TAD I OPTRI /ANY ROOM CDF SZA CLA JMP I XFREE /NO TAD OPTRI CIA TAD OPTRO SPA SNA TAD C40 CIA /-COUNT IAC SNA JMP I XFREE /ONLY 1 FREE IAC SNA JMP I XFREE /ONLY 2 FREE ISZ XFREE TAD FREEC SPA SNA CLA ISZ XFREE /14 OR MORE FREE JMP I XFREE /*FREE2* AND *FREE13* ROUTINES XFREE2, 0 JMS XFREE /ROOM JMP .+3 /WE MUST WAIT FPENT, FPNT+1 JMP I XFREE2 TAD XFREE2 JMP FREEWT /GET ROOM XFREE3, 0 JMS XFREE FREEC, 14 SKP /MUST WAIT JMP I XFREE3 TAD XFREE3 FREEWT, DCA PC /SET RESTART TAD I LOOK JMS I .+2 /SET O WAIT AND DISMISS 2000 XOR RESTOR, TSTEND ERR280, ERROR DCA DATAPC TAD CCR DCA DATAPC+4 POPJ PAGE QMDOT, -42 OPT1, .+1 11 QCT1, 0 QERR, ERR110 QINPACK,INPACK QUOCNT, 0 QCOUNT, 0 QUOTES, TAD CHAR /LITERAL STRING TAD QMDOT SZA CLA JMP I QERR /ERROR, NOT STRING TAD QOPNEXT /SET UP POPJ RETURN PUSHA QINP, TAD QCON1 /ENTRY POINT FOR INPUT COMMAND QLINP, TAD QCON2 /ENTRY POINT FOR LINPUT COMMAND DCA QSLIS /WHICH LIST TO SORT THROUGH TAD M6 DCA QCOUNT /COUNT FOR 6 CHARS DCA QUOCNT /QUOTE COUNTER ISZ SPACSW /KEEP SPACES ISZ MODE /SET STRING MODE INDICATOR PUSHF /PUSH 3 WORDS ONTO STACK CCR TAD PDLXR DCA AXIN DCA XCTIN TAD AXIN DCA PACKST TAD OPT1 DCA PACKND SKP /WE ALREAD HAVE FIRST CHAR QUOTE1, GETC SORTJ PRNTL1-1 QSLIS, 0 QNEXTC, TAD QCOUNT /HAVE WE GOT 6 CHARS YET SPA CLA /YES, DON'T BOTHER PACKING PACKC ISZ QCOUNT /BUMP CHAR COUNTER JMP QUOTE1 TAD QSLIS /GOT 6 CHARS: CHECK IF LINPUT COMMMAND CIA TAD QCON2 SZA CLA JMP QUOTE1 /NO, IGNORE REST OF STRING TAD QCOM /YES, FAKE A COMMA DCA QUOCNT /SO WE CAN GET REST OF STRING JMP QDONE2 QUOCHK, TAD QUOCNT /CHECK WHICH QUOTE THIS IS SNA CLA /SECOND QUOTE, ALL DONE JMP .+4 DCA SPACSW /IGNORE SPACES GETC /SKIP OVER QUOTE JMP QDONE /END OF STRING ISZ QUOCNT JMP QUOTE1 /SET FLAG AND CONTINUE QCOMCK, TAD QUOCNT /CHECK IF COMMA INSIDE QUOTES SNA CLA JMP QDONE /NO QUOTES, ENDS STRING JMP QNEXTC /INSIDE QUOTES, KEEP IT QDONE, TAD CHAR /DONE, SAVE TERMINATOR DCA QUOCNT TAD QCOUNT /SAVE CHAR COUNT, FILL WORD WITH CR'S CIA QDONE2, TAD M6 CIA DCA QCT1 TAD QCOUNT SMA CLA JMP QDONE1 /YES TAD CCR /CCR ENDS STRING DCA CHAR PACKC ISZ QCOUNT JMP .-2 QDONE1, POPF /GET THE STRING FLARG TAD FLARGP /POINT TO STRING DCA PT1 TAD QUOCNT DCA CHAR /RESTORE CHARACTER DCA SPACSW /SET TO IGNORE SPACES POPJ /RETURN QCON1, QLIS2-QLIS1 QCON2, QLIS1-PRNTL1 QCOM, ",-200 QOPNEXT,OPNEXT /CHECK IF STRING RETURNED, SET UP TO GET SECOND ARG /FOR MID AND CAT FUNCTIONS GETSTR, 0 TAD MODE /MAKE SURE FIRST ARG IS A STRING SZA CLA TSTCOM /CHECK FOR COMMA ERR560, ERROR /FIRST ARG NOT STRING, MISSING ARG PUSHF /SAVE THE STRING FLARG DCA MODE /CLEAR MODE TO CHECK NEXT ARG TYPE JMP I GETSTR /RETURN /FLOATS NUMBER IN AC INTO FLARG FLOAT, 0 DCA T1 /SAVE NUMBER DCA AC1 /ZERO AC1 SO NFIX WILL CLEAR FP AC LNFIX /CALL NFIX CALLF1 /IN FIELD 1 TAD C217 /SET EXPONENT DCA ACEXP TAD T1 /SET NUMBER DCA AC2 FINT FNOR /FLOAT NUMBER FPUT I FLARGP /PUT INTO FLARG FEXT JMP I FLOAT /DONE C217, 217 MGET, 0 /FAKE OUT GETC ISZ T2 /CHECK FLAG JMP MGET1 TAD CNTR JMP MGET2 MGET1, L7777 /SET FLAG DCA T2 TAD I FLTXR /GET NEW PAIR DCA CNTR TAD CNTR RTR RTR RTR MGET2, AND C77 /KILL GARGAGE JMP I MGET /RETURN PAGE /*MID* FUNCTION FORMAT: MID(A$,X,Y) /RETURNS Y CHARACTERS STARTING WITH THE XTH CHAR IN A$ MID, JMS I (GETSTR /GET THE FIRST TWO ARGS PUSHJ EVAL-1 JMS MIDCHK /CHECK IF ARG IN BOUNDS PUSHA /SAVE FOR LATER TSTCOM /ANOTHER COMMA? ERR550, ERROR /MISSING OR BAD ARG PUSHJ /GET THIRD ARG EVAL-1 JMS MIDCHK /CHECK ARG DCA MIDC2 POPA /GET SECOND ARG DCA MIDC1 /SAVE POPF /GET STRING FLARG TAD (FLARG-1 DCA FLTXR2 /PACK POINTER DCA T1 /PACK SWITCH TAD MIDC1 /# OF CHARS TO IGNORE CIA CLL RAR TAD FLTXR2 /CALCULATE FIRST CHAR DCA FLTXR SZL /CHECK IF PARTIAL CLA CMA DCA T2 /UNPACK SWITCH SZL TAD I FLTXR /GET CHAR IF PARTIAL DCA CNTR MID1, L7777 /CALCULATE NUMBER OF CHARS TO TRANSFER TAD MIDC2 DCA MIDC2 TAD MIDC2 TAD MIDC1 CIA TAD M6 SMA SZA CLA JMP ERR550 /SECOND ARG LESS THAN FIRST TAD M6 /CHARACTER COUNTER DCA MODE MID2, JMS I (MGET /GET CHAR JMS MPUT /PUT CHAR ISZ MODE SKP JMP MID3 /DONE WITH ALL 6 CHARS ISZ MIDC2 JMP MID2 /GET ANOTHER CHARACTER TAD C77 JMS MPUT /FILL STRING WITH CR'S ISZ MODE JMP .-3 MID3, ISZ MODE /SET STRING MODE FOR STRING *IF*'S ISZ PDLXR /KILL POPJ RETURN JMP I .+1 /SPECIAL RETURN FOR STRING FUNCTIONS ENDF1 MIDCHK, 0 /CHECK ARGUMENT LIMITS JMS I INTEGE /MAKE AN INTEGER SPA SNA SZL /CHECK IF ZERO, NEGATIVE OR TOO BIG JMP ERR550 CIA TAD C7 /CHECK IF TOO BIG SPA SNA JMP ERR550 /TOO BIG TAD M6 /FIX IT UP JMP I MIDCHK MIDC1, 0 /FIRST CHAR TO COPY MIDC2, 0 /LAST CHAR TO COPY /*CAT* FUNCTION FORMAT: CAT(A$,B$) /RETURNS A STRING OF A$ CONCATENATED WITH B$ CAT, JMS I (GETSTR /GET TWO ARGUMENTS PUSHJ EVAL-1 TAD MODE /CHECK IF SECOND ARG IS A STRING SNA JMP ERR550 DCA SPACSW /KEEP SPACES TAD M6 /COUNT FOR 6 CHARS DCA MIDC2 DCA MIDCHK /CLEAR FLAG POPF /FIRST STRING INTO FLARG FLARG FINT /PUT STRING INTO IF1 FPUT I (IF1 FEXT TAD (FLARG-1 /POINT TO STRING DCA FLTXR DCA T2 /CLEAR UPACK SWITCH TAD (FLARG-1 /POINT TO PACKING TEMP DCA FLTXR2 DCA T1 /CLEAR PACK SWITCH CCAT1, JMS I (MGET /GET A CHAR DCA MIDC1 /SAVE TAD MIDC1 IAC AND C7700 /CHECK FOR CR SZA CLA JMP CCAT2 /CR FOUND TAD MIDC1 CCAT3, JMS MPUT /REPACK CHAR ISZ MIDC2 /CHECK IF 6 YET JMP CCAT1 JMP MID3 /RETURN CCAT2, TAD MIDCHK /CHECK IF ALREADY HERE SNA CLA JMP .+3 TAD MIDC1 /FLAG SET, RESTORE CHAR JMP CCAT3 TAD (IF1-1 /SET POINTERS TO SECOND STRING DCA FLTXR DCA T2 /CLEAR FLAG ISZ MIDCHK /SET FLAG JMP CCAT1 MPUT, 0 /FAKE OUT PACKC ISZ T1 /CHECK FLAG JMP MPUT1 TAD T3 DCA I FLTXR2 /STASH CHAR JMP I MPUT MPUT1, RTL6 AND C7700 DCA T3 /SAVE PARTIAL L7777 /SET FLAG DCA T1 JMP I MPUT PAGE FLIN, 0 TAD (-11 DCA DNUMBR JMS DECONV TESTN JMP .+3 FP11, 11 JMP FIGO1 GETC TAD DNUMBR DCA FLTXR JMS DECON TAD DNUMBR CIA TAD FLTXR FIGO1, DCA FLTXR TAD C233 DCA ACEXP FINT FNOR FPUT I PT1 FEXT TAD DNUMBR TAD FP11 SNA CLA ERR150, ERROR TAD CHAR TAD (200-"E SZA CLA JMP FIGO2 GETC L7775 DCA DNUMBR JMS DECONV L0002 TAD DNUMBR SPA CLA JMP .-14 TAD ACSIGN CLL RAL TAD AC3 SZL CIA TAD FLTXR DCA FLTXR FIGO2, TAD FLTXR SNA JMP I FLIN SPA CLA JMP FIGO4 TAD FLTXR CIA DCA FLTXR TAD M1000 FIGO4, TAD (FDIV I (TEN DCA FIGO3+2 FIGO3, FINT FGET I PT1 HLT FPUT I PT1 FEXT ISZ FLTXR JMP FIGO3 JMP I FLIN DNUMBR, 0 DECONV, 0 DCA AC3 DCA AC2 DCA AC1 DCA ACSIGN TAD CHAR TAD (200-"+ SNA JMP .+6 CLL RTR SZA CLA JMP .+4 L4000 DCA ACSIGN GETC JMS DECON JMP I DECONV DECON, 0 TESTN M1000, NOP JMP I DECON CIF SWAP /GO DO FIELD 1 STUFF JMP I .+1 DECON1 DECON2, GETC ISZ DNUMBR JMP DECON+1 ERR160, ERROR XGETLN, 0 TESTN C233, 233 ERR370, ERROR TAD M6 DCA DNUMBR JMS DECONV TAD AC2 SNA CLA TAD AC3 SPA SNA JMP ERR370 DCA LINENO TAD LINENO IAC SPA CLA JMP ERR370 JMP I XGETLN /*RANDOMIZE* RANDOM, TAD I INTCNT /USE INTERRUPT COUNTER AS ADDRESS TAD FRNDX+1 DCA FRNDX TAD INTCNT DCA FRNDX+1 POPJ INTCNT,0 PAGE FLOUT, 0 TAD ACSIGN SPA CLA TAD CCR TAD C40 PRINTC TAD AC1 SZA CLA JMP FOGO1 TAD (60 PRINTC JMP I FLOUT FOGO1, LFXUP /CALL FIXUP CALLF1 TAD (-7 DCA CNTR TAD (NUMBUF-1 DCA FLTXR JMP .+6 FOGO2, TAD AC1 AND C177 DCA AC1 LMULT /CALL MULT10 CALLF1 TAD AC1 RTL6 AND (17 TAD (60 DCA I FLTXR ISZ CNTR JMP FOGO2 TAD (NUMBUF-1 DCA FLTXR L0002 TAD I (DECEXP SNA JMP FOGO4 SPA JMP FOGO3 TAD M10 SPA CLA JMP FOGO5 FOGO3, CLA TAD I FLTXR PRINTC TAD (".-200 PRINTC TAD M6 DCA CNTR TAD I FLTXR PRINTC ISZ CNTR JMP .-3 TAD ("E-200 PRINTC TAD I (DECEXP SPA CLA L0002 TAD ("+-200 PRINTC TAD I (DECEXP SPA CIA ISZ I (PRNT5 JMS I (ITPRNT JMP I FLOUT FOGO4, TAD (".-200 PRINTC TAD (60 PRINTC FOGO5, TAD (-7 DCA CNTR TAD (NUMBUF+6 FOGO6, DCA T2 TAD I T2 TAD (-60 SZA CLA JMP FOGO7 ISZ CNTR L7777 TAD T2 JMP FOGO6 FOGO7, TAD I (DECEXP TAD CNTR SPA CLA JMP .+4 TAD I (DECEXP CMA DCA CNTR L7776 FOGO8, CMA TAD I (DECEXP SZA JMP .+3 TAD (".-200 PRINTC DCA I (DECEXP TAD I FLTXR PRINTC ISZ CNTR JMP FOGO8 JMP I FLOUT ERR330, ERROR DECIMAL PRNTLL, -1000 -100 -10 OCTAL /THANKS TO TS8-V228 FOR THIS ONE /*OR* ROUTINE XOR, 0 DCA T3 /SAVE A TAD I XOR CMA /GET A AND NOT B AND T3 TAD I XOR /NOW GET BITS IN B, B AND NOT B IS ALWAYS /0, SO WE NOW HAVE B OR A (NO CHANCE OF OVFLOW) DCA I LOOK JMP NULL FUPAR1, 2055 0 0 PAGE /*LEN* FUNCTION, RETURNS NUMBER OF CHARACTERS /(UP TO 6) IN A STRING LEN, DCA CNTR /CHAR COUNTER L7775 /COUNT FOR 3 WORDS DCA T1 CLA STL CMA TAD FLARGP DCA FLTXR LENXT, TAD I FLTXR /GET NEXT TWO CHARACTERS TAD C100 SZL /LINK SET ONLY IF TOP HALF IS CR JMP LENDON ISZ CNTR /COUNT CHAR AND C77 /KILL TOP HALF IAC AND C7700 /KILL BOTTOM HALF SZA CLA /AC=100 IF BOTTOM HALF IS CR JMP LENDON ISZ CNTR /COUNT CHAR ISZ T1 /DONE? JMP LENXT LENDON, CLA /CLEAR GARBAGE IN AC DCA MODE /NO LONGER IN STRING MODE TAD CNTR JMS I (FLOAT /FLOAT NUMBER INTO FLARG POPJ /*LINPUT* COMMAND, INPUT AN ENTIRE LINE OF TEXT /INTO A STRING ARRAY LINPUT, DCA SUBS /CLEAR SUBSCRIPT PUSHJ /GET VARIABLE GETVAR SNA CLA /FUNCTION? TSTEND ERR540, ERROR /ILLEGAL OR MORE THAN ONE VARIABLE TAD MODE SNA CLA JMP .-3 /NOT STRING VARIABLE PUSHF /SAVE PT1;CHAR;LINEPC PT1 PUSHF /SAVE TEXT POINTERS TEXTP TAD ADD /CHECK IF SUBSCRIPTED CLL RAL STL RAR DCA ADD TAD SUBS AND C7700 /ZERO LAST DIMENSION DCA SUBS PUSHF /SAVE NAME AND SUBSCRIPT ADD ISZ SPACSW /KEEP LEADING SPACES PUSHJ /GET LINE OF INPUT PAKLIN DCA LINCT /ZERO CHARACTER COUNTER POPF /RESTORE NAME AND SUBSCRIPT ADD JMP .+3 LINXT, ISZ SPACSW /KEEP SPACES GETC /SKIP OVER COMMA ISZ SUBS /INCREMENT SUBSCRIPT PUSHJ /GET VARIABLE LOOKUP PUSHF /SAVE NAME AND SUBSCRIPT ADD PUSHJ /GET NEXT 6 CHARS OF STRING QLINP LINXT2, TAD I AQCT1 /GET CHARACTER COUNT TAD LINCT /BUMP CHARACTER COUNT DCA LINCT POPF /RESTORE NAME AND SUBSCRIPT ADD FLPUT /SET VARIABLE FLARG TSTEND /END OF STRING? JMP LINXT /NO, GET NEXT 6 CHARS TAD SUBS /ZERO LAST DIMENSION AND C7700 DCA SUBS PUSHJ LOOKUP /GET VARIABLE TAD LINCT JMS I (FLOAT /FLOAT AC INTO FLARG FLPUT /PUT IT AWAY FLARG POPF /RESTORE TEXT TEXTP POPF /RESTORE OTHER GARBAGE PT1 POPJ /RETURN DECEXP, 0 NUMBUF, ZBLOCK 7 FLARG=NUMBUF TEMP=NUMBUF+3 LINCT=NUMBUF+6 FIX, 0 FINT FSLE FADD FIXCON FSGE FSUB FIXCON FEXT LNFIX /CALL NFIX CALLF1 CLL RAR TAD ACSIGN RAL SZL CIA DCA FIXTMP CLL TAD AC1 SNA TAD AC2 SZA CLA CLL CML TAD FIXTMP JMP I FIX FIXTMP, 0 FIXCON, 1544 1433 6750 XPAKL1, 15 /CR 7 /BELL 177 /RUBOUT 137 /* 100 /@ IFZERO QCT1&4000 AQCT1, QCT1 PAGE SQR, FINT FPUT FSINZ FSNE FJMP SQEXIT FEXT TAD ACSIGN SPA CLA ERR020, ERROR TAD ACEXP TAD (7600 CLL SPA CML RAR TAD PL200 DCA ACEXP TAD M10 DCA SQCNT SQLOOP, FINT FPUT I FLARGP FGET FSINZ FDIV I FLARGP FADD I FLARGP FEXT L7777 TAD ACEXP DCA ACEXP ISZ SQCNT JMP SQLOOP SQEXIT, FEXT POPJ SQCNT, 0 TAN, FINT FPUT I (TEMP FEXT PUSHJ COS FINT FPUT I FLARGP FGET I (TEMP FEXT PUSHJ FSIN FINT FDIV I FLARGP FEXT POPJ COS, FINT FADD FSINC7 FSKP FSIN, FINT FDIV FSINC1 FPUT FSINZ FEXT PUSHJ FFIX L4000 TAD ACSIGN DCA ACSIGN FINT FADD FSINZ FEXT ISZ ACEXP ISZ ACEXP FINT FSINXX, FPUT FSINZ FEXT DCA ACSIGN FINT FSUB I (FLTONE FSGT FJMP FSINOK FGET FSINZ FEXT PUSHJ SGN ISZ ACEXP FINT FSUB FSINZ FJMP FSINXX FSINOK, FGET FSINZ FMUL FSINZ FPUT FSINZZ FMUL FSINC3 FADD FSINC4 FMUL FSINZZ FADD FSINC5 FMUL FSINZZ FADD FSINC6 FMUL FSINZZ FADD FSINC7 FMUL FSINZ FEXT POPJ FSINZ, 0;0;0 FSINZZ, 0;0;0 FSINC1, 2036;2207;7325 FSINC3, 1644;7553;6722 FSINC4, 5714;6223;1423 FSINC5, 1755;632;1276 FSINC6, 6005;1256;7406 FSINC7, 2016;2207;7325 /*UDF* ROUTINE XUDF, 0 IFZERO .&4000 CDF 10 JMP I XUDF PL200, 200 PAGE FEXP, FINT FDIV FEXPC1 FPUT I (FEXPU FEXT PUSHJ INT L4000 TAD ACSIGN DCA ACSIGN FINT FPUT FEXP1 FADD I (FEXPU FPUT I (FEXPF FMUL I (FEXPF FADD FEXPC2 FPUT I (FEXPU FGET FEXP1 FEXT JMS I INTEGE CIA IAC DCA FEXP1 FINT FGET FEXPC3 FDIV I (FEXPU FADD FEXPC4 FSUB I (FEXPF FPUT I (FEXPU FGET I (FEXPF FMUL I (FEXPF FMUL FEXPC5 FADD I (FEXPU FPUT I (FEXPU FGET I (FEXPF FDIV I (FEXPU FADD FEXPC6 FEXT TAD ACEXP TAD FEXP1 DCA ACEXP FINT FNOR FADD I (FLZERO FEXT POPJ FEXP1, 0;0;0 FEXPU=FSINZ FEXPF=FSINZZ FEXPC1, 2005;4271;300 FEXPC2, 2075;3552;7022 FEXPC3, 6124;6477;715 FEXPC4, 2044;7643;62 FEXPC5, 1744;3372;3400 FEXPC6, 2004 FLZERO, 0 0 0 F72, 2074;4000;0 PRNTL4, 73 /; PRNTL1, 54 /, 47 /' PRNTL7, 42 /" 15 /CR "\-200 LOG, LHIGH /CALL HIGHWD CALLF1 SPA SNA CLA ERR010, ERROR TAD ACEXP DCA LOGEXP TAD L200 DCA ACEXP FINT FPUT I (FEXPU FADD FLOGC1 FPUT I (FEXPF FGET I (FEXPU FSUB FLOGC1 FDIV I (FEXPF FPUT I (FEXPF FMUL I (FEXPF FMUL FLOGC2 FADD FLOGC3 FMUL I (FEXPF FMUL I (FEXPF FADD FLOGC4 FMUL I (FEXPF FSUB FEXPC6 FPUT I (FEXPF FGET LOGFWD FSUB LOGOKW FADD I (FEXPF FMUL FEXPC1 FEXT POPJ FLOGC1, 2005;5202;3632 FLOGC2, 2004;6253;2521 FLOGC3, 2007;5421;3604 FLOGC4, 2025;6125;1007 LOGFWD, 2174 LOGEXP, 0 0 LOGOKW, 2174 L200, 200 0 PAGE ATNSGN, 0 ATN, TAD ACSIGN DCA ATNSGN DCA ACSIGN FINT FPUT I (FATNT FPUT I (FATNAX FSUB FATNC1 FSGT FJMP ATNBIG FSUB FATNC2 FSGT FJMP ATNLOW FGET I (FLTONE FDIV I (FATNT FPUT I (FATNT ATNLOW, FGET I (FLZERO FPUT I (FATNC FGET I (FATNT FSUB FATNC3 FSGE FJMP ATNNOT FGET I (FATNT FADD FATNC4 FPUT I (FATNT FGET FATNCJ FDIV I (FATNT FADD FATNC4 FPUT I (FATNT FGET FATNC5 FPUT I (FATNC ATNNOT, FGET I (FATNT FMUL I (FATNT FPUT I (FATNTT FGET FATNC6 FMUL I (FATNTT FADD FATNC7 FMUL I (FATNTT FADD FATNC8 FMUL I (FATNTT FADD FATNC9 FMUL I (FATNTT FADD I (FLTONE FMUL I (FATNT FADD I (FATNC FPUT I (FATNT FGET I (FATNAX FSUB I (FLTONE FSGT FJMP ATNBIG FGET I (FSINC7 FSUB I (FATNT FPUT I (FATNT ATNBIG, FGET I (FATNT FEXT TAD ATNSGN DCA ACSIGN POPJ FATNAX=FSINZ FATNT=FSINZZ FATNTT=FEXP1 FATNCJ, 6034;0;0 FATNC1, 1634;0;0 FATNC2, 2007;7776;0 FATNC3, 1774;2230;2427 FATNC4, 2016;7331;7272 FATNC5, 2004;1405;2216 FATNC6, 1756;462;4562 FATNC7, 5764;4221;3403 FATNC8, 1766;3141;6672 FATNC9, 5775;2525;2377 FUNL1, 316 /FN 1151 /SI 157 /CO 64 /AT 270 /EX 617 /LO 42 /AB 1161 /SQ 1147 /SG 456 /IN 1116 /RN 311 /FI 1201 /TA 651 /MI 141 /CA 605 /LE 657 /MO PRIN12, FINT FPUT I (IF1 /SETUP TO CALL 'MOD' FEXT PUSHF F72 POPF FLARG PUSHJ MOD1 DCA ACSIGN /MAKE IT POSITIVE JMS I INTEGE JMP I (PRIN11 IFNZRO CONFIG < PAGE XLIST ENPUNCH > FIELD 1 *6600 P7600, NOPUNCH FIELD 0 *7600 /THIS WILL BE MOVED LATER ENPUNCH JMP 7756 /FOR A MONITOR SYSTEM /FIND OUT IF ANYONE HAS THE READER OR THE PUNCH RCHK, 0 TAD RCHK DCA PUNCH TAD C10 SKP PUNCH, 0 TAD C10 DCA RCHK /GET PROPER MASK TAD LOOKST DCA SORTCN SKP LKLOOP, ISZ SORTCN TAD SORTCN TAD I MMLOOKE SMA SZA CLA JMP I PUNCH /AIN'T NOBODY GOT IT TAD RCHK AND I SORTCN SNA CLA JMP LKLOOP TAD LOOKST CIA TAD SORTCN ISZ PUNCH JMP I PUNCH /GET HIS NUMBER INTO THE AC AND EXIT. MMLOOKE, MLOOKE /*RTL6* ROUTINE XRTL6, 0 CLL RTL RTL RTL JMP I XRTL6 /PAREN TEST ROUTINE PARTST, 0 IFNZRO PARTS-PARTST / PARTST MUST BE AT LOC 7640 / (SEE PARTS1 AND JMS NEAR PRINT4 AS TO WHY) POPA DCA LASTOP /SAVED BY *ECALL* L7776 TAD SORTCN CIA POPA /CHECK MATCH SZA CLA ERR260, ERROR /NO MATCH GETC JMP I PARTST TAPE, L0001 KKEY, DCA PT1 TAD T2 PUSHA /SAVE IT JMS I TRUN9 /WAIT FOR TTY TO DIE DOWN TAD TELSW SZA CLA JMP .-3 TAD PT1 DCA OUTPUT TSTCCR ERR003, ERROR /JUNK OF SOME SORT POPA TAD TDIF1 SNA JMP LISTN TAD TDIF2 SZA CLA JMP I AREADY /TAPE OR KEY COMMAND, NOT PUNCH OR PTR IOF JMS RCHK SKP CLA /FREE /SKP CLA = FOR PTR: PRESENT = SEE BEG118 /0 FOR NO PTR: ERRNNN, ERROR /SOMEBODY ALREADY HAS READER OR PUNCH TAD RCHK /ASSIGN IT TO HIM TAD I LOOK DCA I LOOK RFC /AND START THE STUPID THING JMP I TSTART /IT WOULD BE USEFUL TO JUMP TO READY HERE LISTN, IOF JMS PUNCH SKP /SKP CLA = FOR PTP: PRESENT - SEE BEGO11 /0 FOR NO PTP: JMP ERRNNN /ALREADY ASSIGNED TAD RCHK TAD I LOOK DCA I LOOK /GIVE IT TO HIM FOR A WHILE ION JMP I TLIST INPUTX, DCA DATAPC TAD CCR /AUTO-RESTORE DCA DATAPC+4 COMMAN TAD M6 SPA JMP I TFLOTRX /NOT IN STRAIGHT COMMANDS- TRY /FOR RUN-TIME COMMAND TAD TCOMGO1 DCA T1 CDF SWAP TAD I T1 /GET ADDRESS OF COMMAND CDF DCA T1 JMP I T1 /AND GO TO IT... IF4, 2 /< 6 /> 12 /= 5 /<= 11 />= 4 /<> TRUN9, RUN9 TDIF1, -LIST16 TDIF2, -LIST15+LIST16 TSTART, START TLIST, LIST TFLOTRX,FLOTRX TCOMGO1,COMGO1 TEN, 2045 0 0 FIELD 1 /PRECEDING THIS CODE IN FIELD 1 IS THE FOLLOWING: / CLA /ENTRY FROM INTERRUPT ROUTINE / 6XX5 /UNUSED CODES / . / . / . / JMP KL8INT / L0001 /ENTRY FROM SCHEDULER / 6XX6 /USED CODES / . / . / . *7356 KL8LOD, /LOADED HERE INITIALLY NOPUNCH *7756 ENPUNCH KL8FIX, CLA MQA IAC MQL CIF CDF /DISABLE INTRPT TEMPORARILY TAD I PLOOKS DCA I PLOOK JMP I .+1 /INTERRUPT ON AGAIN AFTER THIS JUMP KL8LF0 /BACK TO SCHEDULER KL8INT, TAD I PSAVLK /RESTORE LINK CLL RAL TAD I PSAVAC /RESTORE AC CIF CDF JMP I .+1 KL8LFL /BACK TO INTERRUPT ROUTINE PSAVLK, SAVLK PSAVAC, SAVAC PLOOKS, LOOKST PLOOK, LOOK PAGE IFNZRO CONFIG < NOPUNCH XLIST > FIELD 1 *17 FXR2, 0000 OPSIGN, 0 /OPERAND SIGN OPEXP, 0 /OPERAND EXPONENT OP3, 0 /OPERAND OP2, 0 OP1, 0 OVER, 0 /OVERFLOW INTO HERE FFLAG, 0 /=-1 IF OP NOT 0 OERROR=JMS . XERR, 0000 CLA TAD XERR CDI0, CIF CDF DCA I .+2 JMP I .+2 XERROR XERROR+1 OFNORM, FNORM O7, 7 O200, 200 O177, 177 O377, 377 O1600, 1600 OM4, -4 OM10, -10 OCNTR, 0000 OOCTAD, OCTADD MULTMP, 0000 OFLOOP, FLOOP OACSGN, ACSIGN OACEXP, ACEXP OAC3, AC3 OAC2, AC2 OAC1, AC1 ODECXP, DECEXP *120 F1CAL1, TAD AADR DCA XERR TAD I XERR DCA FXR2 TAD ARET DCA I FXR2 CDF JMP I FXR2 F1RET, CIF CDF DCA OCNTR TAD I F0RET DCA XERR TAD OCNTR JMP I XERR AADR, ADRLST+3 ARET, F1RET F0RET, F1CALL ADRLST, MULT10-1 AL1-1 FIXUP-1 NFIX-1 HIGHWD-1 DECON1, JMS I AMULT DCA OP1 DCA OP2 TAD I ASORT DCA OP3 JMS I AOADD CIF JMP I .+1 DECON2 AMULT, MULT10 ASORT, SORTCN AOADD, OADD FPSUB, L4000 TAD OPSIGN DCA OPSIGN FPADD, JMS I OOCTAD JMP I OFLOOP QLIS2, QCOMCK-1 /, QNEXTC-1 /' QUOCHK-1 /" QDONE-1 /CR QLIS1, QNEXTC-1 /\ , QNEXTC-1 /' QNEXTC-1 /" QDONE-1 /CR QNEXTC-1 /\ /RUNS IN DATA FIELD 0!! ALWAYS!!! *200 FPNT, 0 /ENTRY POINT C7600, 7600 JMP .+3 FLOOP, JMS I OFNORM /NORMALIZE RESULT ISZ FPNT /GET NEXT CIF /CHANGE TO CALLER'S FIELD TAD I FPNT /GET OPERATION SNA JMP I FPNT /0000 -> EXIT CIF SWAP RTL RTL AND O7 DCA FGOTO /SAVE OP TAD I FPNT AND O200 SNA CLA JMP FPNT1 /PAGE ZERO MODE TAD FPNT AND C7600 /GET PAGE FPNT1, DCA FADDR TAD I FPNT AND O177 TAD FADDR DCA FADDR /GET ADDRESS SNL JMP FPNT2 TAD I FADDR /DO INDIRECT DCA FADDR FPNT2, L4000 AND I FADDR DCA OPSIGN /SET SIGN TAD I FADDR SZA CLA L7777 DCA FFLAG /-1 IF NOT 0 TAD I FADDR RTR RAR AND O377 DCA OPEXP /SET EXP TAD I FADDR AND O7 DCA OP1 /SET WORDS ISZ FADDR TAD I FADDR DCA OP2 ISZ FADDR TAD I FADDR DCA OP3 L7775 TAD FADDR DCA FXR2 FPNT3, TAD FGOTO TAD (JMP I FJUMP DCA .+1 /FIND OP ADDRESS FGOTO, HLT FJUMP, FPGET FPADD FPSUB FPMUL FPDIV FPJMP FPCMP FPPUT FADDR, 0 FPJMP, L7776 /FLOATING JUMP TAD FADDR DCA FPNT JMP FLOOP+2 FPCMP, TAD I FPNT RTL RTL SZL SPA CLA JMP FPNT4 /FLOATING COMPARE TAD I FPNT TAD O1600 DCA .+2 /SET SKIP WORD JMS HIGHWD /GET WORD HLT /SKIP IF FALSE ISZ FPNT /TRUE => SKIP JMP FLOOP FPPUT, JMS HIGHWD DCA I FXR2 /SET WORD 1 TAD I OAC2 DCA I FXR2 /SET WORD 2 TAD I OAC3 DCA I FXR2 /SET WORD 3 JMP FLOOP+1 FPGET, TAD OPSIGN DCA I OACSGN /TRANSFER INTO FLAC TAD OPEXP DCA I OACEXP TAD OP1 DCA I OAC1 TAD OP2 DCA I OAC2 TAD OP3 DCA I OAC3 JMP FLOOP+1 HIGHWD, 0 TAD I OACEXP CLL RAL SMA CLL RTL SPA SZL ERR040, OERROR /OVERFLOW TAD I OACSGN TAD I OAC1 /FORM WORD JMP I HIGHWD FPNT4, L4000 TAD OPSIGN DCA OPSIGN JMS I OOCTAD TAD I OAC1 SNA TAD I OAC2 SZA CLA JMP FLOOP TAD I OAC3 AND OM4 SZA CLA JMP FLOOP JMP I (MULCLR PAGE AR1, 0 TAD I OAC1 CLL RAR DCA I OAC1 TAD I OAC2 RAR DCA I OAC2 TAD I OAC3 RAR DCA I OAC3 RAR DCA OVER JMP I AR1 OACN, 0 TAD OACN DCA ACN TAD OAC3 JMP ACN+3 ACN, 0 CDF SWAP TAD (OP3 DCA OADD L7775 DCA AR1 TAD I OADD CMA SZL CLL IAC DCA I OADD ISZ OADD ISZ AR1 JMP .-7 CDF JMP I ACN OADD, 0 CLL TAD I OAC3 TAD OP3 DCA I OAC3 RAL TAD I OAC2 TAD OP2 DCA I OAC2 RAL TAD I OAC1 TAD OP1 DCA I OAC1 JMP I OADD OCTADD, 0 ISZ FFLAG JMP I OCTADD TAD I OACEXP CLL CIA TAD OPEXP SZL JMP BCKWDS DCA OADD ALGNLP, TAD OP1 CLL RAR DCA OP1 TAD OP2 RAR DCA OP2 TAD OP3 RAR DCA OP3 ISZ OADD JMP ALGNLP JMP SETSGN BCKWDS, CMA DCA OADD TAD OPEXP DCA I OACEXP SKP JMS AR1 ISZ OADD JMP .-2 SETSGN, TAD I OACSGN TAD OPSIGN SPA CLA JMS ACN JMS OADD TAD I OAC1 SMA CLA JMP I OCTADD JMS OACN TAD OPSIGN DCA I OACSGN JMP I OCTADD FPMUL, ISZ FFLAG JMP MULCLR TAD I OACSGN TAD OPSIGN DCA I OACSGN TAD I OACEXP TAD OPEXP TAD (-201 DCA I OACEXP TAD I OAC1 DCA OPSIGN TAD I OAC2 DCA OPEXP TAD I OAC3 DCA MULTMP TAD (-33 DCA OCNTR MPYLUP, JMS AR1 TAD OPSIGN RAR DCA OPSIGN TAD OPEXP RAR DCA OPEXP TAD MULTMP RAR DCA MULTMP SZL JMS OADD ISZ OCNTR JMP MPYLUP JMP I OFLOOP MULCLR, DCA I OAC1 JMS I (NFIX JMP I OFLOOP PAGE FNORM, 0 DCA OVER TAD I OAC1 TAD OM10 SPA CLA JMP NOTBIG JMS I (AR1 ISZ I OACEXP JMP FNORM+2 NOTBIG, TAD OVER SMA CLA JMP NOBUMP ISZ I OAC3 JMP NOBUMP ISZ I OAC2 JMP NOBUMP ISZ I OAC1 JMP FNORM+1 L7777 NOBUMP, TAD I OACEXP SPA JMP UNDERF /UNDERFLOW OR ZERO DCA I OACEXP L7775 TAD I OAC1 SMA SZA CLA JMP I FNORM JMS AL1 JMP NOBUMP-1 UNDERF, SPA SNA SZL CLA TAD I OAC1 SNA TAD I OAC2 SNA TAD I OAC3 SZA CLA ERR050, OERROR /UNDERFLOW JMS NFIX JMP I FNORM AL1, 0 TAD I OAC3 CLL RAL DCA I OAC3 TAD I OAC2 RAL DCA I OAC2 TAD I OAC1 RAL DCA I OAC1 JMP I AL1 FPDIV, ISZ FFLAG ERR030, OERROR TAD I OACSGN TAD OPSIGN DCA I OACSGN TAD OPEXP CIA TAD I OACEXP TAD (177 DCA I OACEXP DCA OCNTR TAD (-35 DCA FNORM DIVLP, L4000 AND OP1 TAD I OAC1 SMA CLA JMS I (ACN JMS I (OADD TAD OCNTR RAL DCA OCNTR TAD OPEXP RAL DCA OPEXP TAD OPSIGN RAL DCA OPSIGN JMS AL1 ISZ FNORM JMP DIVLP TAD OPSIGN DCA I OAC1 TAD OPEXP DCA I OAC2 TAD OCNTR DCA I OAC3 JMP I (FLOOP NFIX, 0 TAD I OAC1 SNA CLA JMP ZFIXEX FIXLUP, TAD I OACEXP TAD (-233 SMA CLA JMP FIXEXT JMS I (AR1 ISZ I OACEXP JMP FIXLUP ZFIXEX, DCA I OACEXP DCA I OACSGN DCA I OAC1 DCA I OAC2 DCA I OAC3 FIXEXT, TAD I OAC3 JMP I NFIX MULT10, 0 JMS AL1 TAD I OAC3 DCA OP3 TAD I OAC2 DCA OP2 TAD I OAC1 DCA OP1 JMS AL1 JMS AL1 JMS I (OADD JMP I MULT10 PAGE STMV, /USER FIELD DEFINITIONS 7745 /CR,E 6262 /RR 5762 /OR 5156 /IN 7762 /CR,R 4541 /EA 4471 /DY 7777 /CR,CR 4445 /DE 5445 /LE 6445 /TE 4477 /D,CR 6750 /WH 4164 /AT 3777 /?,CR 7763 /CR,S 6457 /TO 6077 /P,CR CONLEN=.-STMV LINPUT RANDOM END ON READY /STOP COMGOL, RESTOR READ RETURN GOSUB FOR XPOPJ /DEF XPOPJ /DIM AND REM GOTO IF INPUT PRINT XPOPJ /DATA LET NEXT UNKWN LIST7, 2022 LIST70 -"O+337^100-"N+337 LIST70, 2134 LIST71 -"S+337^100-"T+337 -"O+337^100-"P+337 LIST71, 1733 LIST72 -"E+337^100-"N+337 -"D+337^100 LIST72, 2237 LIST73 -"R+337^100-"E+337 -"S+337^100-"T+337 -"O+337^100-"R+337 -"E+337^100 LIST73, 2334 LIST74 -"R+337^100-"E+337 -"A+337^100-"D+337 LIST74, 2436 LIST75 -"R+337^100-"E+337 -"T+337^100-"U+337 -"R+337^100-"N+337 LIST75, 2535 LIST76 -"G+337^100-"O+337 -"S+337^100-"U+337 -"B+337^100 LIST76, 2633 LIST77 -"F+337^100-"O+337 -"R+337^100 LIST77, 2733 LIST78 -"D+337^100-"E+337 -"F+337^100 LIST78, 3033 LIST79 -"D+337^100-"I+337 -"M+337^100 LIST79, 3033 LIST80 -"R+337^100-"E+337 -"M+337^100 LIST80, 1636 LIST81 -"R+337^100-"A+337 -"N+337^100-"D+337 -"O+337^100-"M+337 LIST81, 3134 LIST82 -"G+337^100-"O+337 -"T+337^100-"O+337 LIST82, 3222 LIST83 -"I+337^100-"F+337 LIST83, 3335 LIST84 -"I+337^100-"N+337 -"P+337^100-"U+337 -"T+337^100 LIST84, 3435 LIST85 -"P+337^100-"R+337 -"I+337^100-"N+337 -"T+337^100 LIST85, 3534 LIST86 -"D+337^100-"A+337 -"T+337^100-"A+337 LIST86, 3633 LIST87 -"L+337^100-"E+337 -"T+337^100 LIST87, 3734 LIST88 -"N+337^100-"E+337 -"X+337^100-"T+337 LIST88, 4133 LIST89 -"T+337^100-"A+337 -"B+337^100 LIST89, 4234 LIST90 -"S+337^100-"T+337 -"E+337^100-"P+337 LIST90, 4334 LIST91 -"T+337^100-"H+337 -"E+337^100-"N+337 LIST91, 4422 LIST92 -"T+337^100-"O+337 LIST92, 4522 LIST93 -"F+337^100-"N+337 LIST93, 4634 LIST94 -"L+337^100-"I+337 -"S+337^100-"T+337 LIST94, 5033 LIST95 -"B+337^100-"Y+337 -"E+337^100 LIST95, 5033 LIST96 -"N+337^100-"E+337 -"W+337^100 LIST96, 5037 LIST97 -"S+337^100-"C+337 -"R+337^100-"A+337 -"T+337^100-"C+337 -"H+337^100 LIST97, 5136 LIST98 -"D+337^100-"E+337 -"L+337^100-"E+337 -"T+337^100-"E+337 LIST98, 5234 LIST99 -"E+337^100-"D+337 -"I+337^100-"T+337 LIST99, 5333 LIST10 -"K+337^100-"E+337 -"Y+337^100 LIST10, 5434 LIST11 -"T+337^100-"A+337 -"P+337^100-"E+337 LIST11, 5533 LIST12 -"R+337^100-"U+337 -"N+337^100 LIST12, 3011 LIST13 -"'+337^100 LIST13, 4711 LIST14 -"_+337^100 LIST14, 4134 LIST15 -"C+337^100-"H+337 -"R+337^100-"$+337 LIST15, 5433 LIST16 -"P+337^100-"T+337 -"R+337^100 LIST16, 5433 LIST17 -"P+337^100-"T+337 -"P+337^100 LIST17, 1536 A0000, 0000 -"L+337^100-"I+337 -"N+337^100-"P+337 -"U+337^100-"T+337 INTR8A, 0 /AC SAVE INTR8F, 0 /FLAGS SAVE INTRRV, CAF /CLEAR ALL ON RECOVERY AAACDF, CIF CDF TAD PST2 DCA INTR81 /SECOND SETUP TAD I PAUSER MTON JMP I INTR8T INTRV2, CLA TAD RESTR DCA INTR81 /NORMAL INTERUPT SEQUENCE TAD INTR8F RTL RAL AND P70 TAD AAACDF DCA INTR88 TAD INTR8F AND P70 TAD CCIF DCA INTR89 TAD INTR8F RAL CLA INTR88, CDF INTR89, CIF TAD INTR8A /AND AC ION JMP I INTR80 /AND EXIT PST2, JMP INTRV2 PAUSER, AUSER INTR8T, INTRPL RESTR, DCA INTR8A SET, JMP INTRRV P70, 70 INTR80, 0 /INTERRUPT LOCATION INTR81, DCA INTR8A /SAVE AC 6634 /READ CARD READER TO CLEAR FLAG 6674 /AND CARD DONE FLAG CLA /AND CLEAR THE AC SPL /POWER FAIL INTERRUPT? JMP INTR82 /NO RAR RIB DCA INTR8F /AND FLAGS TAD I A0000 DCA INTR80 /AND LOCATION DCA I A0000 TAD SET DCA INTR81 /SET UP FOR RECOVERY HLT /THEN HALT INTR82, TAD INTR8A /GET THE AC AGAIN CCIF, CIF JMP I .+1 /GO TO REAL INTERRUPT ROUTINE INTRPT MODL2, MODF5-1 /CR MODF2-1 /BELL MODF4-1 /RUBOUT MODF4-1 /_ MODF1 /CHAR MODF1-1 /FORM MODF3-1 /LINE FEED XGETL2, XGET5-1 /CR XGET4-1 /BELL XGET3-1 /SPACE PRNTL6, PRINT8-1 /; PRINT5-4 /, PRINT6-4 /' PRINT8 /" PRINT6-4 /CR PRINT6-4 /\ PRNTL2, PRINT5-4 /, PRINT6-1 /' PRINT2-1 /" PRINT6-1 /CR PRINT6-1 /\ PRNTL8, PRINT3-1 /" PRINT6-4 /CR PRINT3-3 / \ MUST BE PRINTABLE MODL1, MODF5-1 /CR MODF1+5 /BELL AL1PNT, AL1 /SPACE OUT MODL1 LIST OADDP, OADD / MODF4-1 /CHAR XPAKL2, XPACK2-1 /CR XPACK3-1 /BELL XPACK7-1 /RUBOUT XPACK7-1 /* XPACK5-1 /@ FUNL2, -"N+200 /SIN -"S+200 /COS -"N+200 /ATN -"P+200 /EXP -"G+200 /LOG -"S+200 /ABS -"R+200 /SQR -"N+200 /SGN -"T+200 /INT -"D+200 /RND -"X+200 /FIX -"N+200 /TAN -"D+200 /MID -"T+200 /CAT -"N+200 /LEN -"D+200 /MOD RND1, JMS I AL1PNT JMS I OADDP TAD I PFRND RTL RTL RTL DCA I PFRNX TAD I PFRNX RAR TAD I OAC2 AND RNDM40 DCA I PFRND1 RAL TAD I OAC1 TAD I PFRNX DCA I PFRNX TAD I OAC3 DCA I PFRND TAD O200 DCA I OACEXP DCA I OACSGN TAD I PFRNX AND O7 DCA I OAC1 TAD I PFRND1 DCA I OAC2 CIF JMP I .+1 XPOPJ PFRND, FRNDX+2 PFRNX, FRNDX RNDM40, -40 PFRND1, FRNDX+1 FUNL3, FSIN COS ATN FEXP LOG ABS SQR SGN INT RND FFIX TAN MID CAT LEN MOD COMGO1, LIST START /CR BYE DELET EDIT KKEY TAPE RUN ERRLST, ERR000 ERR001 ERR002 ERR003 ERR004 ERR010 ERR020 ERR030 ERR040 ERR050 ERR060 ERR070 ERR080 ERR100 ERR110 ERR120 ERR150 ERR160 ERR170 ERR180 ERR200 ERR210 ERR220 ERR130 ERR230 ERR240 ERR250 ERR260 ERR270 ERR280 ERR290 ERR300 0 /ERROR 28 RESERVED FOR FUTURE USE ERR320 ERR330 ERR340 ERR350 ERRNNN ERR370 ERR380 ERR390 ERR400 ERR410 ERR420 ERR430 ERR440 ERR450 ERR460 ERR470 ERR490 ERR500 ERR510 ERR520 0 /ERROR 49 RESERVED FOR FUTURE USE ERR540 ERR550 ERR560 ERREND=. FIXUP, 0 TAD I OACEXP TAD .+2 DCA I OACEXP CLA SKP /THIS IS 7610 CR -170 FIXUP4, TAD I ODECXP DCA I ODECXP FIXUP1, TAD I OAC1 RTL SZL CLA JMP FIXUP2 JMS I (AL1 L7777 TAD I OACEXP DCA I OACEXP JMP FIXUP1 FIXUP2, TAD I OACEXP SMA SZA JMP FIXUP3 CLA JMS I (AR1 JMS I (AR1 JMS I (AR1 JMS I (AR1 JMS I (MULT10 TAD (4 TAD I OACEXP DCA I OACEXP L7777 JMP FIXUP4 FIXUP3, TAD (-5 SPA JMP FIXUP5 FIXUP7, CLL CLA TAD (-40 DCA OCNTR FIXUP8, TAD I OAC1 TAD (5400 SMA DCA I OAC1 CLA TAD I OAC3 RAL DCA I OAC3 TAD I OAC2 RAL DCA I OAC2 TAD I OAC1 RAL DCA I OAC1 ISZ OCNTR JMP FIXUP8 TAD I OAC1 AND (377 DCA I OAC1 L0001 JMP FIXUP4 FIXUP5, DCA OCNTR SKP JMS I (AR1 ISZ OCNTR JMP .-2 TAD I OAC1 TAD (5400 SMA CLA JMP FIXUP7 CLL TAD (2166 TAD I OAC3 DCA I OAC3 SZL ISZ I OAC2 SKP ISZ I OAC1 TAD I OAC1 TAD (5400 SZA CLA JMP I FIXUP TAD F200 DCA I OAC1 DCA I OAC3 ISZ I ODECXP F200, 0200 JMP I FIXUP PAGE ORG=. IFNZRO CONFIG /USER DEFINITIONS LIMIT=7776 /HIGHEST CORE POSITION SWAPR=ENSWAP-STSWAP+1 /SWAP LENGTH BUFFER=40 BUFCOM=100 LINE0=162 LINE1=164 TOP=LIMIT IFNZRO CONFIG < XLIST ENPUNCH> /PAGE ZERO FIELD 1 FOR INITIALIZATION--GETS WIPED OUT LATER PAGE 0 NOP /FOR CORE DETERMINING USRPTR, USRLST CORPTR, 0 USRPT2, 0 CORPT2, 0 BEGUSR, 0 CURFLD, 0 BEGDEV, 0 BEGXR1, 0 BEGXR2, 0 *20 USRCTR, 0 SS, 0 BEGCOR, 0 KLTOP, 0 KLSCH, 0 *2000 BEGIN, JMP .+3 /NORMAL ENTRY NOP /SO YOU CAN CHAIN TO US IFNZRO CONFIG < HLT /NO CONFIG FOR OS/8 > IFZERO CONFIG < JMP I (BEGOS8 /OS8 ENTRY POINT > IFNZRO FOURTY < CDF 10 DISKIN, JMP I (E40INT /WRITE IMAGE ON DISK FOR EDU40 SYSTEM > BEGMV4, CDF 10 TAD I BEGMV1 /MOVE PAGE 7600 FIELD 0 INTO ITS SPOT CDF DCA I BEGMV2 ISZ BEGMV1 ISZ BEGMV2 ISZ BEGMV3 JMP BEGMV4 CDF IFZERO CONFIG < TAD I (FLOP DCA I (OPTABL+5 CDF 10 TAD I BEGIN1 /MAKE SURE THAT NO ERRORS ARE NEG. SO THAT /THEY DON'T TERMINATE TABLE IAC CLL RAR DCA I BEGIN1 ISZ BEGIN1 ISZ BEGIN2 JMP .-6 > BEG002, TAD (BEG009-1 DCA BEGXR1 TAD (KL8JM0-1 DCA BEGXR2 JMS BEG008 TAD (KL8JMP-1 DCA BEGXR2 JMS BEG008 CDF 10 KCC TAD (BEGIOT DCA BEG012 TAD (-7 DCA BEG013 TAD (120 DCA I BEG012 ISZ BEG012 ISZ BEG013 JMP .-4 JMS I (BEG003 BEGM1 /INIT MESSAGE BEG006, JMS I (BEG003 BEGM2 /# USER MESSAGE JMS I (BEG001 TAD (-"8 SMA SZA JMP I (BEG005 TAD (10 SPA SNA JMP I (BEG005 CIA DCA BEGUSR JMP I (BEGX08 CORDON, CDF 10 TAD BEGUSR IAC SNA CLA JMP BEG010 JMS I (BEG01Q BEGM4 /DC02? BEG010, L7777 /NO - BEGDEV=-1 DCA BEGDEV TAD BEGDEV SNA CLA JMP I (BEG11A TAD (BEGIOT DCA BEG012 TAD BEGUSR DCA BEG013 TAD (410 DCA BEG12A BEG14B, ISZ BEG013 JMP BEG14A JMP I (BEG015 BEG14A, TAD BEG12A DCA I BEG012 ISZ BEG012 TAD BEG12A TAD (20 DCA BEG12A JMP BEG14B BEG008, 0 /UNPATCH SCHEDULER AND INTERRUPT ROUTINE L7775 / IN CASE WE COME HERE FORM A ^C DCA BEG013 CDF 10 TAD I BEGXR1 CDF DCA I BEGXR2 ISZ BEG013 JMP .-5 JMP I BEG008 BEG12A, 400 BEG012, 0 BEG013, 0 BEGIN1, ERRLST BEGIN2, ERRLST-ERREND BEGMV1, P7600 BEGMV2, 7600 BEGMV3, -156 PAGE BEG015, TAD BEGUSR IAC SNA CLA JMP I (BEG15I /ONE USER / TAD (BEGM78-1 /"REMOTE" / JMS I (BEGMFX /SEE BEG151 JMS BEG01Q BEGM7 /STANDARD? SKP JMP I (BEG15I /MULTIPLE USER = STANDARD BEG15A, TAD BEGUSR DCA BEG15B TAD (BEGIOT DCA BEG15C TAD (4361 /TEXT "#1" DCA I (BEGM5A BEG15D, ISZ BEG15B SKP JMP I (BEG15H JMS BEG014 BEGM5 TAD SS TAD (10 DCA I BEG15C ISZ BEG15C ISZ I (BEGM5A JMP BEG15D BEG15C, 0 BEG15B, 0 BEG014, 0 TAD I BEG014 ISZ BEG014 DCA .+2 JMS I (BEG003 0 JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RTL RTL DCA SS JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RAL TAD SS DCA SS JMP I BEG014 /FIGURE OUT HIGHEST CORE FIELD FOR HIM BEGX08, L0001 DCA BEGCOR /FIELD 1 TOP TO START WITH TAD (6221 DCA BEGCHK TAD CNOP CDF DCA I (0 CDF 10 TAD CNOP DCA I (0 BEGCHK, 0 TAD (1000 DCA I (0 CNOP, NOP TAD I (0 SKP /PDP-8 NXM BUG HLT /THIS SHOULD HAUL DOWN A PDP-8 CDF 10 /DOUBLE CHECK FOR PDP8/L TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE TAD (1000 CDF TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE-PROBABLY A PDP-8/L ISZ BEGCOR /THIS FIELD WAS SUCCESSFUL TAD BEGCHK TAD (10 DCA BEGCHK JMP BEGCHK /CALLING SEQUENCE / JMS I (BEG01Q / MSGADR /ADDRESS OF MESSAGE TO BE PRINTED / JMP NO /RETURNS HERE IF ANSWER IS "N" / JMP YES /RETURNS HERE IF ANSWER IS "Y" BEG01Q, 0 /ASK QUESTION - GET ANSWER TAD I BEG01Q /SKIP IF YES, NOT IF NO ISZ BEG01Q /OTHERWISE GIVE ERROR AND REPEAT QUESTION DCA .+2 JMS I (BEG003 0 JMS I (BEG001 TAD (-"Y SNA JMP BEG10R TAD ("Y-"N SNA CLA JMP BEG10R+1 JMS I (BEG003 BEGME JMP BEG01Q+4 BEG10R, ISZ BEG01Q JMP I BEG01Q PAGE BEG009, NOPUNCH *KL8JM0 ENPUNCH TAD LOOKST DCA LOOK SKP NOPUNCH *KL8JMP ENPUNCH TAD SAVLK CLL RAL TAD SAVAC NOPUNCH *BEG009+6 ENPUNCH BEG016, JMS BEG003 BEGME JMP I (BEG014+4 BEG005, JMS BEG003 BEGME JMP I (BEG006 BEG001, 0 KSF JMP .-1 KRB TAD (-203 SNA JMP I (BEG002 TAD (203 TLS TSF JMP .-1 AND (177 TAD (200 /FORCE THE PARITY BIT SO WE KNOW WHAT WAS TYPED. JMP I BEG001 BEG003, 0 CLA TAD I BEG003 DCA BEG004 ISZ BEG003 TAD I BEG004 CLL RTR RTR RTR JMS BEG03X TAD I BEG004 JMS BEG03X ISZ BEG004 JMP BEG003+5 BEG03X, 0 AND (77 SNA JMP I BEG003 TAD (-37 SNA JMP CRLF SPA TAD (100 TAD (237 JMS TTCHAR JMP I BEG03X TTCHAR, 0 TLS CLA TSF JMP .-1 KSF JMP I TTCHAR JMP I BEG003 /EXIT ON CHAR. CRLF, TAD (215 JMS TTCHAR TAD (212 JMP TTCHAR-2 BEG004, 0 BEGME, TEXT %_INVALID RESPONSE_% BEGM1, TEXT %__EDUSYSTEM 20 BASIC_% BEGM2, TEXT %_NUMBER OF USERS (1 TO 8)?% PAGE BEGHSS, TEXT %READER (Y OR N)?% BEGHSR, TEXT %_DO YOU HAVE A HIGH SPEED % BEGHSP, TEXT %PUNCH (Y OR N)?% BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% BEGM5, TEXT %_TELETYPE #1 DEVICE CODE?% BEGM5A=BEGM5+5 BEGM7, TEXT %_STANDARD REMOTE TELETYPE CODES (Y OR N)?% BEGM7A=BEGM7+4 /SEE BEG15I /BEGM7B, TEXT %D REMOTE% /*.-1 /BEGM7C, TEXT %D UNUSED% /*.-1 /BEGM7D, TEXT % _UNUSED% /*.-1 BEGMFL, TEXT %_FIELD % BEGMXX, TEXT %_THERE ARE % BEGMX1, TEXT % BLOCKS LEFT IN THIS FIELD._ YOUR ALLOCATION FOR USER #% BEGTTI, TEXT % WILL BE HOW MANY BLOCKS?% BEGM6, TEXT %__END OF DIALOGUE_% WNGDM, TEXT %_BLOCK SIZES DON'T WORK--HAVE TO START AGAIN__% BEGMQ, TEXT %_SAME AMOUNT OF STORAGE FOR ALL USERS?% BEGM6A, TEXT %_IS THE ABOVE CORRECT (Y OR N)?% BEGM8, TEXT % MORE?% BEGM9, TEXT %_ANY UNUSED TERMINALS (Y OR N)?% BEGM10, TEXT %_DEVICE CODE?% //MOVE IN MIDDLE OF BEGM7 /BEGMFX, 0 / DCA 17 / TAD (BEGH7A-1 / DCA 16 / TAD (-4 / DCA CORPTR / TAD I 17 / DCA I 16 / ISZ CORPTR / JMP .-3 / JMP I BEGMFX PAGE /COMMENTED MATERIAL WILL GENERATE UNUSED CODES /BUT GOOD LUCK TRYING TO EXPLAIN TO A USER /HOW IT WORKS. IT'S SIMPLER TO JUST ASK HIM. //STANDARD USED CODES BEG15I, /JMS BEG15C /MOVE IN USED IOT'S / TAD (BEGM7C-1 /"UNUSED" / JMS I (BEGMFX / JMS I (BEG01Q / BEGM7 /"STANDARD UNUSED TTY CODES?" / JMP BEG15K /NO = GET CODES FROM TTY / TAD (6305 /YES = GENERATE THEM FROM 30 THRU 56 / DCA SS / JMP BEG15L /INSERT IF CODE NOT USED /BEG15M, TAD SS / TAD (20 /INCREMENT / DCA SS / TAD SS / TAD (-6605 / SZA CLA /LAST? / JMP .-7 /NO = LOOP / JMP BEG011 /DONNE / / //INSERT IF IOT UNUSED /BEG15L, TAD SS / CIA / DCA BEG15G / TAD BEGUSR / DCA USRCTR / TAD CORPT2 / DCA CORPTR / TAD BEG15G / TAD I CORPTR / SNA CLA / JMP BEG15M / ISZ CORPTR / ISZ USRCTR / JMP .-6 / TAD SS / JMP BEG15F / JMP BEG15M /NON-STANDARD USED CODES BEG15H, JMS BEG15G /MOVE IN USED IOT'S JMS I (BEG01Q BEGM9 /"ANY UNUSED TERMINALS" JMP BEG011 /NO = DUN JMP .+4 BEG15K, JMS I (BEG01Q BEGM8 /"MORE?" JMP BEG011 /NO = KAPUT! JMS I (BEG014 BEGM10 /"DEVICE CODE?" TAD SS TAD (6005 JMS BEG15F /INSERT IN PATCH JMP BEG15K /INSERT WORD INTO PATCH BEG15F, 0 DCA I KLTOP L7777 TAD KLTOP DCA KLTOP JMP I BEG15F /MOVE IOT'S FROM BEG10T TO PATCH BEG15G, 0 CLA CLL IAC BSW /IS IT AN 8E? TAD (-100 SZA CLA JMP I (BEG011 TAD (KL8FIX-1 DCA KLTOP TAD BEGUSR DCA USRCTR TAD (BEGIOT-1 DCA CORPTR TAD I CORPTR TAD (6005-10 JMS BEG15F ISZ CORPTR ISZ USRCTR JMP .-5 TAD KLTOP DCA KLSCH /SAVE ENTRY ADDRESS FOR SCHEDULER L0001 TAD KLTOP DCA CORPT2 TAD .-3 /INSERT L0001 JMS BEG15F TAD (KL8INT&177+5200 /INSERT JMP KL8INT JMS BEG15F JMP I BEG15G BEG011, TAD (CLA DCA I KLTOP BEG11A, CDF TAD (SKP CLA DCA I (LISTN+2 TAD (SKP CLA DCA I (ERRNNN-1 CDF 10 JMS I (BEG003 BEGHSR JMS I (BEG01Q BEGHSP SKP /NO PUNCH = KILL INST JMP BEG11B CDF DCA I (LISTN+2 /NO PUNCH CDF 10 BEG11B, JMS I (BEG003 BEGHSR JMS I (BEG01Q BEGHSS SKP /NO READER = KILL INST JMP BEGCK0 /YES = GO ON CDF DCA I (ERRNNN-1 CDF 10 BEGCK0, TAD BEGUSR IAC SNA CLA JMP I (BEGOLD /ONLY 1 USER, ASSUME ANSWER! JMS I (BEG01Q BEGMQ /SAME AMT OF STG FOR ALL USRS? JMP I (BEG500 /NO = GO ASK HIM JMP I (BEGOLD /YES = ALLOCATE IT FOR HIM PAGE LBLK=SS OLNUM=USRPT2 NUNUM=CORPT2 BEGER0, CDF 10 JMS I (BEG003 WNGDM BEG500, CDF 10 TAD BEGUSR DCA USRCTR TAD (USRLST DCA USRPTR TAD BEGCOR IAC DCA CURFLD BEGFLD, L7777 TAD CURFLD SPA SNA JMP BEGER0 /EH? DCA CURFLD JMS I (BEG003 BEGMFL TAD (60 TAD CURFLD TLS TSF JMP .-1 L7777 TAD CURFLD SNA CLA TAD (-6 /6 'BLOCKS' LESS IN FLD1 TAD (20 /20 LOGICAL BLOCKS IN OTHERS DCA LBLK BEGXXX, JMS I (BEG003 BEGMXX TAD LBLK JMS I (BEGPRNT JMS I (BEG003 BEGMX1 JMS I (BEG001 TAD (-"8 SMA SZA JMP BEGER1 TAD (10 SPA SNA JMP BEGER1 /BAD USERNO DCA I USRPTR TAD BEGUSR TAD I USRPTR SMA SZA CLA JMP BEGER1 /NONEXISTENT USER DUMMY ISZ USRPTR TAD CURFLD DCA I USRPTR ISZ USRPTR /AND HIS NO. BEGRE, JMS I (BEG003 BEGTTI DCA OLNUM /DOUBLE CHECK! BEGINP, JMS I (BEG001 TAD (-215 SNA JMP DN TAD (215-"9 SMA SZA JMP BEGER2 /UNGOOD NO TAD (11 SPA JMP BEGER2 /LIKEWISE DCA NUNUM TAD OLNUM /MULT BY 10 DECIM CLL RAL RTL TAD OLNUM TAD OLNUM TAD NUNUM /PLUS NEW DIGIT DCA OLNUM /MAKES NEW NO JMP BEGINP DN, TAD OLNUM SNA SPA SZL JMP BEGER2 /JUNKY NO CIA TAD LBLK SPA JMP BEGER0 /TOO MUCH ASKED FOR DCA LBLK /NEW AMOUNT REMAINING TAD OLNUM ISZ USRCTR SKP JMP BEGR2 DCA I USRPTR ISZ USRPTR TAD LBLK SZA CLA /MORE TO COME IN THIS FIELD? JMP BEGXXX /SURE IS L7777 TAD CURFLD SPA CLA JMP BEGER0 JMP BEGFLD /MORE FIELDS TO COME BEGER2, JMS I (BEG003 BEGME JMP BEGRE BEGER1, JMS I (BEG003 BEGME JMP BEGXXX BEGR2, TAD LBLK /EXPAND HIM TO FINISH FIELD DCA I USRPTR /THERE'S NO REASON TO WASTE CORE ISZ USRPTR /JUST THINK OF ALL THE PEOPLE WHO GO TO BED HUNGRY FOR IT EVERY NIGHT! JMP I (BEG540 PAGE BEG540, CLA CLL IAC BSW TAD (-100 SZA CLA JMP BEG550-2 /NOT AN 8/E TAD BEGDEV SNA CLA JMP BEG550-1 /THE FOOL HAS AN 8/E WITH DC02 CDF TAD KLSCH DCA I BEGKL5 TAD KLTOP DCA I BEGKL6 CDF 10 TAD KL8FRST SZA CLA /FIRST TIME THROUGH JMP BEG550 /NO ISZ KL8FRST /SIGNIFY DONE TAD I BEGKL1 DCA I BEGKL2 ISZ BEGKL1 ISZ BEGKL2 /MOVE PATCH TO PROPER POSITION JMP .-4 CDF TAD (CIF SWAP DCA I BEGKL3 ISZ BEGKL3 TAD (KL8JMP+2&177+5600 DCA I BEGKL3 TAD (CIF SWAP DCA I BEGKL4 ISZ BEGKL4 TAD (KL8JM0+2&177+5600 DCA I BEGKL4 CDF 10 TAD KLTOP JMP BEG550-1 /SET TOP OF FIELD 1 BEGKL1, KL8LOD BEGKL2, KL8FIX KL8FRST, 0 BEGKL3, KL8JMP BEGKL4, KL8JM0 BEGKL5, KL8JM0+2 BEGKL6, KL8JMP+2 DCA I (INTRRV DCA KLTOP BEG550, TAD (USRLST /NOW WE SORT FOR FIELDS TO MAKE IT EASY DCA USRPTR TAD (3 TAD (USRLST DCA CORPTR TAD BEGUSR DCA USRCTR DCA SS /SORT SWITCH FOR MODIFIED BUBBLE SORT BEG551, TAD USRPTR IAC DCA USRPT2 TAD CORPTR IAC DCA CORPT2 ISZ USRCTR SKP JMP BEG553 TAD I USRPT2 CIA TAD I CORPT2 SNA SPA CLA JMP BEG552 L7775 DCA SS /3 SWAPS TAD I USRPTR DCA 0 TAD I CORPTR DCA I USRPTR TAD 0 DCA I CORPTR ISZ USRPTR ISZ CORPTR ISZ SS JMP .-11 ISZ SS /SET TO INDICATE BEG552, L0002 TAD USRPT2 DCA USRPTR L0002 TAD CORPT2 DCA CORPTR JMP BEG551 BEG553, TAD SS SZA CLA JMP BEG550 JMP I (BEG600 PAGE BEG600, TAD (BEGLST DCA USRPT2 TAD (USRLST DCA USRPTR TAD BEGUSR DCA USRCTR TAD BEGUSR DCA I (BEGUS1 TAD I (USRLST+1 BEG610, DCA CURFLD L7777 TAD CURFLD SZA CLA JMP .+12 TAD KLTOP DCA BEG602 TAD BEGUSR DCA SS TAD (ENSWAP-STSWAP+1 ISZ SS JMP .-2 TAD (ORG JMP .+3 DCA BEG602 TAD (CONLEN DCA BEG601 NXUSR, TAD I USRPTR ISZ USRPTR DCA I USRPT2 ISZ USRPT2 TAD I USRPTR CIA TAD CURFLD SZA CLA JMP BEG609 /HE WANTS A NEW FIELD ISZ USRPTR TAD CURFLD CLL RAL RTL TAD (6201 /MAKE UP XFIELD OP DCA I USRPT2 /INTO OUR QUICKIE LIST ISZ USRPT2 TAD I USRPTR ISZ USRPTR CIA DCA SS TAD (400 ISZ SS JMP .-2 /MULT. HIS BLOCKSIZE BY 400 OCTAL FOR CORE SIZE DCA SS L7776 TAD BEG602 DCA I USRPT2 ISZ USRPT2 TAD SS CIA TAD BEG602 DCA BEG602 TAD (4 TAD BEG602 SPA CLA JMP BEG608-1 TAD BEG602 SPA JMP BEG607 CIA TAD BEG601 SMA CLA JMP BEG607 TAD BEG602 BEG608, DCA I USRPT2 ISZ USRPT2 ISZ USRCTR JMP NXUSR JMP I (BEG700 /WHEW..THAT WENT QUICKLY ANYWAY BEG601, 0 /BOTTOM BEG602, 0 /TOP BEG609, TAD USRPTR DCA CURFLD /SAVE IT L7777 TAD USRPTR DCA USRPTR /TAKE OUT ENTRIES L7777 TAD USRPT2 DCA USRPT2 TAD I CURFLD /COUNT DOWN FIELD JMP BEG610 BEG607, CLA TAD BEG601 JMP BEG608 PAGE BEG700, TAD (BEGLST DCA USRPTR DCA SS TAD BEGUSR DCA USRCTR TAD (4 TAD (BEGLST DCA USRPT2 BEG7X1, ISZ USRCTR SKP JMP BEG703 TAD I USRPTR CIA TAD I USRPT2 SNA JMP I (BEGER0 /MULTIPLE ASSIGNMENTS FOR ONE USER SMA CLA JMP BEG702 TAD (-4 DCA SS BEG701, TAD I USRPTR DCA CORPTR TAD I USRPT2 DCA I USRPTR TAD CORPTR DCA I USRPT2 ISZ USRPTR ISZ USRPT2 ISZ SS JMP BEG701 ISZ SS TAD (-4 BEG702, TAD USRPT2 DCA USRPTR TAD (4 TAD USRPTR DCA USRPT2 JMP BEG7X1 BEG703, TAD SS SZA CLA JMP BEG700 /MORE TO COME TAD (BEGLST DCA USRPTR /NOW TAKE OUT USER NOS. TAD BEGUSR DCA USRCTR IAC TAD (BEGLST DCA USRPT2 BEG704, L7775 DCA SS TAD I USRPT2 DCA I USRPTR ISZ USRPTR ISZ USRPT2 ISZ SS JMP .-5 ISZ USRPT2 /SKIP OVER USER NO. ISZ USRCTR JMP BEG704 JMS I (BEG01Q BEGM6A JMP I (BEG002 /OH NO--ALL THIS JUNK FOR NOTHING! JMS I (BEG003 BEGM6 JMP I (BEG750 BEGPRNT,0 DCA BEG705 TAD (-12 DCA BEG706 DCA BEG707 JMP .+3 ISZ BEG707 DCA BEG705 BEGPR1, TAD BEG705 TAD BEG706 SMA JMP .-5 CLA TAD (60 TAD BEG707 TLS TSF JMP .-1 KCC ISZ BEG706 SKP JMP I BEGPRNT /WAS SECOND TIME THROUGH L7777 DCA BEG706 DCA BEG707 JMP BEGPR1 BEG706, 0 BEG707, 0 BEG705, 0 BEG604=SS BEG605=USRPTR PAGE BEG750, CDF TAD I (MLOOKE TAD BEGUSR DCA I (MLOOKE /CORRECT FOR NO. OF USERS TAD I (MLOOKE CIA DCA I (LOOK TAD BEGUSR DCA I (MUSER /SETUP FOR NO. OF USERS CDF 10 TAD (BEGIOT-1 DCA BEG604 TAD (INTRPL DCA BEG605 L7777 TAD BEGUSR DCA BEG60X TAD BEGUSR DCA USRCTR BEG75Q, CDF 10 TAD I BEG604 ISZ BEG604 CDF ISZ BEG60X JMP .+4 CLA CMA DCA BEG60X TAD (CLA-6006 TAD (6006 DCA I BEG605 ISZ BEG605 ISZ USRCTR JMP BEG75Q CDF TAD BEGUSR DCA SS ISZ SS SKP JMP .+3 CLL CML RAR JMP .-4 TAD (10 /GROUP 1 DCA I (AUSER CDF 10 BEG75X, TAD BEGCOR CLL RTL RAL TAD (CDF DCA BEG756 TAD BEG756 TAD (-6211 SNA CLA JMP BEG760 TAD (-CONLEN DCA BEG753 TAD (STMV DCA BEG751 DCA BEG752 BEG755, CDF 10 TAD I BEG751 ISZ BEG751 NOP BEG756, CDF 20 DCA I BEG752 ISZ BEG752 JMP BEG754 L7777 TAD BEGCOR DCA BEGCOR JMP BEG75X BEG60X, 0 BEG751, 0 BEG752, 0 BEG753, 0 BEG754, ISZ BEG753 JMP BEG755 L7777 DCA BEG753 JMP BEG756 BEG760, TAD BEGDEV SNA CLA JMP I (BEG76X CDF DCA I (XOUTL6+3 DCA I (XOUTL6-3 DCA I (INTRP2-2 DCA I (INTRP2+4 DCA I (INTRP5+1 CDF 10 DCA I (INTRV2-2 JMP I (BEG80X PAGE BEG76X, CDF 10 TAD (TLS DCA I (AAACDF+1 DCA I (AAACDF+2 TAD (MTLS DCA I (INTRV2-1 TAD (17 MTON /DESELECT ALL TTY'S L0001 MINT CLA CLL BEG80X, CDF 10 TAD KLTOP DCA I (KLTOP2 JMP I (BEG800 PAGE USRLST, 0 IFNZRO FOURTY < *5200 /DO NOT MOVE FROM 5200 WITHOUT /CHANGING CONSTANT FOR SWAP DCMA=6601 DMAW=6605 DEAL=6615 DCIM=6611 DIML=6615 DCXA=6641 DXAL=6643 DFSC=6622 /ROUTINE TO COPY EDU20 IMAGE ONTO DISK TO SET UP EDU40 SYSTEM E40INT, JMS I (BEG01Q E40M1 /IS SYSTEM DEVICE A DF32 DISK? SKP JMP EDF32 /YES-DISK IS DF32 JMS I (BEG01Q E40M2 /IS SYSTEM DEVICE AN RF08 DISK? JMP E40INT /NO-HE DOESN'T KNOW WHAT HE IS TALKING ABOUT /ROUTINE TO PUT EDU20 ON RF08 DISK CDF 10 DCIM /WRITE FROM FIELD 0 DCXA /WRITE TO TRACK 0 TAD (200 DCA I (7750 /WC TO 7600 TAD (177 DCA I (7751 /CA TO 200 TAD (200 DMAW /WRITE FIELD 0 IMAGE ONTO TRACK 0 DFSC JMP .-1 TAD (10 DIML /WRITE FROM FIELD 1 CLA CLL IAC DXAL /WRITE ONTO TRACK 1 CLA CMA DCA I (7751 /CA TO 0 DCA I (7750 /WC TO 10000 TAD (7000 CDF 10 DCA I (DISKIN /NOP CALL TO THIS CODE SO WHEN LOADED FROM DISK CDF 0 /THIS CODE WILL NOT BE RUN DMAW /WRITE FIELD 1 IMAGE ON DISK DFSC JMP .-1 DCIM /WRITE FROM FIELD 0 CLA CLL IAC DXAL /ONTO TRACK 1 LASTW, TAD (7600 DCA I (7750 /WC TO 200 CLA CMA DCA I (7751 /CA TO 0 TAD (5200 DMAW /WRITE FIELD 0,PAGE 0 IMAGE ONTO TRACK 1 AT 5200 DFSC JMP .-1 DCMA /CLEAR DISK FLAGS JMP I (DISKIN+1 /RETURN /ROUTINE TO PUT EDU20 IMAGE ON DF32 DISK EDF32, CDF 0 DEAL TAD (200 DCA I (7750 /WC TO 7600 TAD (177 DCA I (7751 /CA TO 200 TAD (200 DMAW DFSC JMP .-1 TAD (110 DEAL CLA CMA DCA I (7751 /CA TO 0 DCA I (7750 /WC TO 10000 TAD (7000 CDF 10 DCA I (DISKIN /NOP CALL TO THIS CODE CDF 0 DMAW /WRITE FIELD 1 ONTO TRACK 1 DFSC JMP .-1 TAD (100 DEAL /WRITE FROM FIELD 0 ONTO TRACK 1 CLA JMP LASTW E40M1, TEXT %_IS SYSTEM DEVICE A DF32 DISK?% E40M2, TEXT %_IS SYSTEM DEVICE AN RF08 DISK?% > PAGE /THIS ROUTINE DOES ALLOCATION THE OLD WAY IF YOU ASK FOR THE SAME AMOUNT /OF CORE FOR ALL USERS. IT DOES A TABLE LOOKUP ON BEGCOR&BEGUSR AND /ENTERS THINGS IN USRLST THE WAY YOU WOULD IF YOU ANSWERED QUESTIONS BEGOLD, TAD BEGCOR CLL RTL RAL TAD BEGUSR /GET ADDR. OF ADDR. OF LIST TAD (BGLD1 DCA SS TAD I SS DCA SS TAD (USRLST DCA USRPTR /SETUP TO SLIDE TAD BEGUSR DCA USRCTR /NO. OF SLIDES BEGOL1, TAD I SS CLL RTL RTL AND (7 IAC /CORRECT USERNO. DCA I USRPTR ISZ USRPTR TAD I SS CLL RTR RTR RTR AND (7 /SET FIELD DCA I USRPTR ISZ USRPTR TAD I SS AND (37 DCA I USRPTR ISZ SS ISZ USRPTR ISZ USRCTR JMP BEGOL1 JMP I (BEG540 /CONTINUE ON...WE'VE ANSWERED QUESTIONS FOR HIM NOW. PAGE /THE FORMAT OF THE FOLLOWING LIST OF ANSWERS IS THE FOLLOWING: /(USER NO. [0 TO 7] +FIELD)TIMES 100 PLUS BLOCKSIZE. /THIS GETS ALL THREE DATA ABOUT EACH USER INTO ONE WORD. /THE USER NO. IS INTERNAL USER NO. OR EXTERNAL USER NO.-1 X=100 BGL11, 01^X+12 BGL12, 01^X+5 11^X+5 BGL13, 01^X+4 11^X+3 21^X+3 BGL14, 01^X+3 11^X+3 21^X+2 31^X+2 BGL15, 01^X+2 11^X+2 21^X+2 31^X+2 41^X+2 BGL16, 01^X+2 11^X+2 21^X+2 31^X+2 41^X+1 51^X+1 BGL17, 01^X+2 11^X+2 21^X+2 31^X+1 41^X+1 51^X+1 61^X+1 BGL18, 01^X+2 11^X+2 21^X+1 31^X+1 41^X+1 51^X+1 61^X+1 71^X+1 BGL22, 11^X+12 BGL21, 02^X+20 BGL31=BGL21 BGL41=BGL21 BGL51=BGL21 BGL61=BGL21 BGL71=BGL21 BGL23, 01^X+12 12^X+10 22^X+10 BGL24, 02^X+10 12^X+10 21^X+5 31^X+5 BGL25, 02^X+6 11^X+5 21^X+5 32^X+5 42^X+5 BGL26, 01^X+5 11^X+5 22^X+4 32^X+4 42^X+4 52^X+4 BGL27, 01^X+4 12^X+4 22^X+4 32^X+4 42^X+4 51^X+3 61^X+3 BGL28, 01^X+4 12^X+4 21^X+3 31^X+3 42^X+3 52^X+3 62^X+3 72^X+3 BGL33, 21^X+12 BGL32, 02^X+20 13^X+20 BGL42=BGL32 BGL52=BGL32 BGL62=BGL32 BGL72=BGL32 BGL34, 02^X+20 11^X+12 23^X+10 33^X+10 BGL35, 01^X+12 12^X+10 22^X+10 33^X+10 43^X+10 BGL36, 02^X+10 12^X+10 23^X+10 33^X+10 41^X+5 51^X+5 BGL37, 02^X+10 12^X+10 23^X+6 31^X+5 41^X+5 53^X+5 63^X+5 BGL38, 02^X+6 13^X+6 21^X+5 31^X+5 42^X+5 52^X+5 63^X+5 73^X+5 BGL44, 31^X+12 BGL43, 02^X+20 13^X+20 24^X+20 BGL53=BGL43 BGL63=BGL43 BGL73=BGL43 BGL45, 02^X+20 13^X+20 21^X+12 34^X+10 44^X+10 BGL46, 02^X+20 11^X+12 23^X+10 33^X+10 44^X+10 54^X+10 BGL47, 01^X+12 12^X+10 22^X+10 33^X+10 43^X+10 54^X+10 64^X+10 BGL48, 61^X+5 71^X+5 02^X+10 12^X+10 23^X+10 33^X+10 44^X+10 54^X+10 BGL55, 41^X+12 BGL54, 02^X+20 13^X+20 24^X+20 35^X+20 BGL64=BGL54 BGL74=BGL54 BGL56, 02^X+20 13^X+20 24^X+20 31^X+12 45^X+10 55^X+10 BGL57, 02^X+20 13^X+20 21^X+12 34^X+10 44^X+10 55^X+10 65^X+10 BGL58, 02^X+20 11^X+12 23^X+10 33^X+10 44^X+10 54^X+10 65^X+10 75^X+10 BGL66, 51^X+12 BGL65, 02^X+20 13^X+20 24^X+20 35^X+20 46^X+20 BGL75=BGL65 BGL67, 41^X+12 02^X+20 13^X+20 24^X+20 35^X+20 56^X+10 66^X+10 BGL68, 02^X+20 13^X+20 24^X+20 31^X+12 45^X+10 55^X+10 66^X+10 76^X+10 BGL78, 71^X+12 BGL77, 67^X+20 BGL76, 02^X+20 13^X+20 24^X+20 46^X+20 35^X+20 BGLD1, BGL18 BGL17 BGL16 BGL15 BGL14 BGL13 BGL12 BGL11 BGL28 BGL27 BGL26 BGL25 BGL24 BGL23 BGL22 BGL21 BGL38 BGL37 BGL36 BGL35 BGL34 BGL33 BGL32 BGL31 BGL48 BGL47 BGL46 BGL45 BGL44 BGL43 BGL42 BGL41 BGL58 BGL57 BGL56 BGL55 BGL54 BGL53 BGL52 BGL51 BGL68 BGL67 BGL66 BGL65 BGL64 BGL63 BGL62 BGL61 BGL78 BGL77 BGL76 BGL75 BGL74 BGL73 BGL72 BGL71 IFNZRO CONFIG < XLIST NOPUNCH> *6200 MONDSK, 1773 3772 2372 2373 5356 1371 3350 1371 3351 5770 7573 7576 7573 7774 6603 6622 5374 7610 MONTAP, 1774 3773 2373 2374 5356 3354 1372 3355 1371 5770 7575 0220 7577 7575 7775 6766 6771 5376 OSDRK8, 1377 3030 1376 3031 5030 0 0 0 0 0 0 0 0 0 0 0 5031 6733 OSDDSK, 1772 3771 2371 2372 5356 5350 0 0 0 0 0 7750 7773 7600 6603 6622 5352 5752 OSDDTA, 6774 1377 3354 1376 3355 1375 6766 6771 5365 1374 6766 6771 5371 5200 220 600 7577 7700 OS8ERM, TEXT %ILLEGAL OS/8 DEVICE FOUND_CAN'T SAVE BOOTSTRAP__% OS8MSG, TEXT %__TO BOOTSTRAP BACK % OS8M1, TEXT %OS/8% OS8M2, TEXT % MONITOR:_ LOAD ADDRESS 07600_ AND START__% DISKMM, TEXT %DISK% TAPMM, TEXT %TAPE% BEGOS8, CDF 10 TAD I (7760 /GET DCB OF SYS: AND (770 TAD (-050 /5 IS RK8 SPA JMP OS8ERR /<5 IS ERROR SNA JMP OS8RK8 /5 = RK8 TAD (050-160 /16 IS DECTAPE SPA JMP OS8KSK /6 TO 15 = DSK SNA CLA JMP OS8DTA /16 = DTA: OS8ERR, CLA JMS I (BEG003 OS8ERM /BAD OS8 DEVICE JMP I (BEGMV4 /DO NOT SET UP ANYTHING OS8KSK, CLA JMP OS8DSK IAC IAC OS8DSK, IAC OS8DTA, IAC OS8RK8, IAC TAD (OS8LST-1 DCA OS8PTR TAD I OS8PTR DCA OS8PTR /POINT TO BOOTSTRAP OS8LP1, CDF 10 TAD I OS8PTR ISZ OS8PTR CDF DCA I OS8PT2 ISZ OS8PT2 JMP OS8LP1 CDF 10 JMS I (BEG003 OS8MSG /OS8 MESSAGE JMS I (BEG003 OS8AB, OS8M1 JMS I (BEG003 OS8M2 JMP I (BEGMV4 OS8PTR, 0 OS8PT2, 7756 /INTO RIM LOCATIONS OS8LST, OSDRK8 OSDDTA OSDDSK MONDSK MONTAP TAPEM, CDF 10 TAD (600 DTXA DTCA /REWIND TAPE DTSF JMP .-1 TAD (TAPMM DCA OS8AB JMP OS8DSK-2 DISKM, CDF 10 TAD (DISKMM DCA OS8AB JMP OS8DSK-1 IFNZRO CONFIG < PAGE XLIST ENPUNCH > *7000 40 BEGIOT, 120 120 120 120 120 120 120 BEG800, TAD (ORG DCA BEG801 TAD (BEGLST BEGZCT, DCA BEG802 TAD (BEGLST+1 DCA BEG804 TAD (BEGLST+2 DCA BEG803 TAD (BEGIOT-1 DCA BEG805 BEG810, TAD I BEG804 JMS BEG900 /SETUP PDLXR TAD (4 JMS BEGZER TAD (READY /PC GETS READY FOR STARTUP JMS BEG900 TAD (10 JMS BEGZER L7777 /DINPUT SET TO INPUT MODE JMS BEG900 JMS BEG900 /OUTPUT GETS ZEROED FOR ECHO TAD I BEG805 /MAKE UP XIOT TAD (6006-10 JMS BEG900 TAD I BEG802 /MAKE UP XFIELD JMS BEG900 TAD (5 JMS BEGZER TAD (BUFFER /NOW BUILD BUFFERS USING DEF. OF BUFFER+OFFSET TAD I BEG803 /THIS IS IPTRI JMS BEG900 TAD (BUFFER /AND IPTRO TAD I BEG803 JMS BEG900 TAD (BUFFER TAD I BEG803 JMS BEG900 TAD (BUFFER-40 TAD I BEG803 JMS BEG900 TAD (BUFFER-40 TAD I BEG803 JMS BEG900 TAD (3 JMS BEGZER TAD (LINE1 /BUFR TAD I BEG803 JMS BEG900 TAD (LINE1 /LASTV TAD I BEG803 JMS BEG900 TAD I BEG804 JMS BEG900 TAD (LINE0 TAD I BEG803 JMS BEG900 TAD (BUFCOM TAD I BEG803 JMS BEG900 JMS BEG900 JMS BEG900 L0001 JMS BEG900 /SEE FRNDX1 TAD (5321 JMS BEG900 TAD (3062 JMS BEG900 ISZ BEG802 ISZ BEG802 ISZ BEG802 ISZ BEG803 ISZ BEG803 ISZ BEG803 ISZ BEG804 ISZ BEG804 ISZ BEG804 ISZ BEG805 ISZ BEGUS1 JMP BEG810 JMP I (FINISH BEGUS1, 0 BEG801, 0 BEG802, 0 BEG803, 0 BEG804, 0 BEG805, 0 BEG900, 0 DCA I BEG801 ISZ BEG801 JMP I BEG900 BEGZER, 0 CIA DCA BEGZCT JMS BEG900 ISZ BEGZCT JMP .-2 JMP I BEGZER *7200 /STAY OUT OF HIS BUFFER AND TEXT AREA /AS WELL AS THE MONITOR (OR WE WONT GET LOADED) /ALSO ON THIS PAGE = KL8LOD FINCNT, 0 FIN001, FIN002+1 KLTOP2, 0 FINISH, TAD I FIN002 /FIND TOP OF USER SWAP AREAS DCA FIN002 /SAVE IT TAD KLTOP2 /EFFECTIVE TOP OF THIS FIELD CIA TAD FIN001 DCA FINCNT /HOW MANY WORDS TO CLEAR ABOVE US FINLP1, DCA I FIN001 ISZ FIN001 NOP ISZ FINCNT JMP FINLP1 FINLP2, DCA I FIN002 ISZ FIN002 /LOOP TO TOP OF CORE JMP FINLP2 /DCA WILL GET WIPED, AND KLFIX WILL BE SAFE CIF CDF JMP I .+1 ENTRY FIN002, BEG801 PAGE BEGLST=. $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$