V=6 /EDUSYSTEM 25 BASIC /16 NOVEMBER 1972 /EDUSYSTEM 25 BASIC /MARK BRAMHALL /DIGITAL EQUIPMENT CORP. /BARRY SMITH /STEVE POULSEN /OREGON MUSEUM OF SCIENCE & INDUSTRY /JOHN O'DONNELL /YALE UNIVERSITY /EDUSYSTEM 25 BASIC IS FOR THE PDP-8/E, -8/F, -8/M, -8/I, -8/L WITH /12K OR MORE MEMORY AND EITHER THE DC02 OR PT08(KL8E) OPTION /AND TC08 DECTAPE CONTROLLER WITH TU56 OR TWO TU55 TRANSPORT(S) /NOTE: START ADDRESS IS 15200. /DEFINITIONS FIXMRI FGET=0000 /FLOATING INSTRUCTIONS FIXMRI FADD=1000 FIXMRI FSUB=2000 FIXMRI FMUL=3000 FIXMRI FDIV=4000 FIXMRI FJMP=5000 FIXMRI FCMP=6000 FIXMRI FPUT=7000 FINT=JMS I 7 FEXT=0000 FXIT=0000 FNOR=6010 FSKP=6000 FSNE=6040 FSEQ=6050 FSGE=6100 FSLT=6110 FSGT=6140 FSLE=6150 DTLA=6766 CAF=6007 BSW=7002 MQL=7421 MQA=7501 SPL=6102 MTKF=6123 MTPF=6113 MTON=6117 MINT=6115 MINS=6125 MKSF=6111 MKRB=6116 MTSF=6121 MTCF=6122 MTLS=6126 L0001=CLL CLA IAC L0004=CLL CLA IAC RTL L0003=CLL CLA CML IAC RAL L7777=CLL CLA CMA L7776=CLL CLA CMA RAL L7775=CLL CLA CMA RTL L3777=CLL CLA CMA RAR L5777=CLL CLA CMA RTR L4000=CLL CLA CML RAR L2000=CLL CLA CML RTR L0002=CLL CLA CML RTL SWAP=10 /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 FPNT /FLOATING POINT XREG, 0 /INTERRUPT XREG XREG2, 0 /INTERRUPT XREG XREG3, 0 /GENERAL XREG FLTXR, 0 /FLOATING XREG FLTXR2, 0 /FLOATING XREG 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 /FOR MINI-STRINGS 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 NAME, 1617 /PROGRAM NAME 1605 0 READC=JMS I . PREADC, XREADC PRINTC=JMS I . PPRINT, XPRNTC FREE2=JMS I . PFREE2, XFREE2 FREE13=JMS I . PFREE3, XFREE3 BASE, 5400 IPNTR, 0 I3, 0 IBLK, 0 OPNTR, 0 O3, 0 OBLK, 0 OMAX, 0 CHAINP, READY /'CHAIN' POINTER FRNDX, 0001 0203 5555 ENSWAP=.-1 /END OF SWAP DECK=XFIELD /USER ON DECK SORTCN, 0 /SORT CONSTANT T1, 0 /THREE TEMPS T2, 0 CNTR, 0 /COUNTER T3, 0 THISOP, 0 /CURRENT OP LASTOP, 0 /LAST OP EFOP=CNTR /FUNCTION OP FLOUTP, FLOUT /FLOATING OUTPUT FLINTP, FLIN /FLOATING INPUT LOOK, USER0-1 /USER BEING RUN OR LOOKED AT LOOKST, USER0-1 /TO RESET LOOKING FLARGP, FLARG /POINTER TO TEMP FLAC INTEGE, FIX /FIX THE FLAC ROUTINE CCR, 15 /CR C7, 7 /BELL C177, 177 /RUBOUT C137, 137 /BACK ARROW LSTMOD, -1 /SET BY *INPUT* C14, 14 /FORM FEED CLF, 12 /LINE FEED M12, -12 /-10 DECIMAL C40, 40 /BUFFER SIZE C77, 77 /RIGHT MASK M40, -40 /-BUFFER SIZE M6, -6 /MESSAGE LENGTH C10, 10 M10, -10 M100, -100 /CHARACTER TEST C7700=M100 /LEFT MASK M4, -4 /CHARACTER COUNT /NEW INSTRUCTIONS GETC=JMS I . /UNPACK A CHAR 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 TSTEND=JMS I . /TEST FOR END OF LINE ENDTST TSTLPR=JMS I . /SKIP IF L-PAREN LPRTST 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 /RESPECTIVLY *177 NULL, ION CDF TAD LOOK TAD MLOOKE /CHECK POSITION OF POINTER SPA CLA JMP .+3 /O.K. TO LOOK AT NEXT KL8JMP, TAD LOOKST DCA LOOK /RESET POINTER ISZ LOOK /LOOK AT NEXT TAD I LOOK /GET STATUS AND C7700 SZA CLA JMP NULL /NO GO DCA PRNT5 /CLEAR FORMAT SWITCH TAD I LOOK /GET STATUS IOF /NO INTERRUPTS JMS DECKON /PUT HIM ONDECK TAD PC DCA 0 /RESTART LOCATION L7776 /NUMBER OF COMMANDS THEN LOOK DCA PC ION JMP I 0 /GO TO IT... C60, 60 MLOOKE, -USER4+5 /LAST STATUS WORD : SUBTRACT NUMBER OF USERS /*PRNTIT* ROUTINE /ENTER WITH THE AC CONTAINING THE VALUE TO BE PRINTED AS /A DECIMAL NUMBER BETWEEN 0 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 /FORMATING 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 AND C7 /USER NUMBER ONLY DCA SIN /SAVE NEW TAD DECK CIA TAD SIN SNA CLA JMP DTCHK /FAST EXIT (BUT CHECK TAPE FIRST) TAD DECK JMS DFIND /LOCATE OLD TAD LSTMOD DCA DINPUT TAD I (XUDF+1 DCA XFIELD /* THIS SWAP ROUTINE EXECUTES WITH INTERRUPT OFF /* AND TAKES APPROXIMATELY 600 MICROSECONDS TO /* EXECUTE, WHEREAS THE MAXIMUM TIME AVAILABLE /* TO ANSWER A DECTAPE INTERRUPT AFTER A SEARCH /* IS 400 MICROSECONDS. THEREFORE, WE MUST CHECK /* THE DECTAPE FLAG AS PART OF THE INNER LOOP. TAD I XREG2 CIF CDF SWAP DCA I XREG /SWAP OUT OLD JMS DTINTR /CHECK TAPE ISZ TEMP2 JMP .-5 TAD SIN JMS DFIND /LOCATE NEW ENTRY1, CIF CDF SWAP TAD I XREG JMS DTINTR /CHECK TAPE 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 IAC TAD DECK DCA TEMP2 /POINT TO STATUS DTCHK, CIF CDF SWAP JMS DTINTR JMP I DECKON DFIND, ENTRY1 ENTRY, CMA DCA TEMP2 TAD (ORG1-1-ENSWAP+STSWAP-1 /START AT THE BEGINNING TAD STARTP /SPACE BETWEEN ISZ TEMP2 JMP .-2 DCA XREG /POINT TO USER TAD (STSWAP-1 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, JMS I (IOFIX /CLEAN UP FILES TAD I (DTQ1 /CLEAR DECTAPE QUEUE DCA T3 /(IF NECESSARY) TAD DECK /ARE WE ON TOP? CMA TAD I T3 SNA CLA JMS I (DTFREE /REMOVE US FROM THE QUEUE FREE13 /GET ROOM TAD M40 DCA T3 /BUFFER IS 40 LONG 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 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 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, TAD CCR PRINTC ERROR3, CLA /*READY* ROUTINE /ROUTINE TO PRINT "READY" AND RESET POINTERS /ENTER THE ROUTINE AT START TO OMIT READY MESSAGE READY, JMS I (IOFIX /RESET FILES FREE13 L0003 JMS I (READY1 /PRINT "READY" GETC PRINTC START, DCA ERLINE /IMMEDIATE MODE L7777 DCA LSTMOD /SHORT LIST TAD PDLST DCA PDLXR /RESET PUSH-DOWN DCA SPACSW /IGNORE LEADING SPACES DCA MODE /CLEAR STRING MODE FLAG TAD (ERR330 PUSHA /TRAP THE *RETURN* SANS *GOSUB* PUSHJ /INPUT COMMAND LINE PAKLIN SZA CLA /END-OF-FILE? JMP I CHAINP /'OLD' OR 'CHAIN' FINISHED /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 JMP I (INPUTX /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 (XDELET /DELETE THIS LINE JMP START ISZ SPACSW /KEEP SPACES SKP GETC PACKC /REPACK LINE TSTCCR JMP .-3 JMS I (XDELET /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 FINDLN /FIND THE LINE C16, 16 PUSHJ ENDFND /SCAN FOR *NEXT* SNA CLA TAD C10 IAC TAD AXIN DCA BUFR /NEW FREE POSITION TAD STARTV DCA LASTV /RESET VARIABLES AFTER INPUTTING TEXT ION JMP START FUPAR1, 2055 0 0 PAGE KEY, 0 TAD USER JMS I (DECKON /PUT HIM ONDECK TAD XIOT DCA .+1 /SET READ IOT HLT AND C177 /IGNORE PARITY SNA JMP I KEY /IGNORE 0 NAD 200 DCA SIN /SAVE INPUT L7775 TAD SIN /CTRL/C? KM140, SZA CLA JMP KEY7 /NOT "^C" ERR004, JMS I (IERROR /RECOVER JMP I KEY KEY7, TAD LSTMOD SNA JMP KEY6 /NO ECHO - BREAK CDF SWAP DCA I (XCCR+4 CDF TAD SIN SORTC /CHECK BREAK XCCR-1 JMP KEY5 /BREAK TAD SIN SORTC ALT-1 JMP KEY6 /FOUND AN ALTMODE TAD SIN TAD M12 SNA CLA JMP I KEY /IGNORE LINE FEED IF NOT BREAK TAD SIN AND C140 SNA JMP KEY3 /ILLEGAL CHAR TAD KM140 SNA CLA JMP KEY3 /ILLEGAL CHAR TAD SIN PRINTX /ECHO THE CHAR JMS KEY4 /STORE THE CHAR TAD IPTRO CIA TAD IPTRI SPA SNA TAD C40 TAD M12 SPA CLA JMP I KEY /NO - EXIT ANYINP, L3777 AND I TEMP2 /CLEAR I WAIT DCA I TEMP2 JMP I KEY 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 /ROOM? SZA CLA ERR070, JMS I (IERROR /NO ROOM UDF TAD SIN DCA I IPTRI CDF ISZ IPTRI TAD IPTRI CIA TAD C40 TAD IPTR0 SZA CLA JMP I KEY4 /OK TAD IPTR0 DCA IPTRI /RESET POINTER JMP I KEY4 TTY, 0 TAD USER JMS I (DECKON /PUT HIM ONDECK DCA TELSW /CLEAR BUSY UDF TTY3, TAD I OPTRO /MORE SNA JMP TTY2 /NO JMS I (XOUTL2 /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 (XFREE /ROOM AVAILABLE C140, 140 JMP I TTY /NOT ENOUGH ROOM L5777 AND I TEMP2 /CLEAR O WAIT DCA I TEMP2 JMP I TTY /POP THE AC ROUTINE XPOPA, 0 UDF TAD I PDLXR CDF JMP I XPOPA DECIMAL PRNTLL, -1000 -100 -10 OCTAL PAGE /*READ* AND *INPUT* COMMANDS INREAD, 0 SZA CLA JMP INREA3 /RE-ENTRY PUSHJ /PRINT CRAP PRIN10 DCA MODE /NEW VARIABLE PUSHJ /GET A VARIABLE GETVAR SZA CLA JMP ERR500 /WAS FUNCTION TAD MODE /SET TO IGNORE LEADING SPACES IF NECESSARY 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 /MORE? JMP INREA1 /NO INREA4, ISZ INREAD /2ND EXIT 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 SPLCH1-2 /NUMERIC INPUT SPLCH, PUSHJ /GET THE STRING QINP JMP SPLCH1 PUSHJ EVAL SPLCH1, 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 /MUST SAVE MODE PUSHA /IT IS CHANGED BELOW TAD DATAPC FIND 3 ERR510, ERROR /OUT OF DATA DCA DATAPC POPA /RESTORE MODE DCA MODE JMP READ-1 INPUT, JMS CHKFIL /CHECK IF A FILE PUSHF DATAPC+1 TAD DATAPC+4 PUSHA TAD CCR DCA DATAPC+4 JMS INREAD /SET THOSE VARIABLES JMP INPUT1 /DONE INPUT2, PUSHJ /GET LINE OF INPUT GETINP L7777 JMP INPUT2-2 INPUT1, TSTEND JMP INREA1+1 POPA DCA DATAPC+4 POPF DATAPC+1 POPJ CHKFIL, 0 TAD CHAR /CHECK FOR FILE INPUT TAD MNMSGN SZA CLA JMP I CHKFIL /NOT FILE TAD IBLK /FILE OPEN? SZA CLA GETC /SHOULD BE COMMA TSTCOM ERR600, ERROR GETC /SKIP OVER COMMA TAD VXGET /SETUP FILE INPUT DCA PREADC JMP I CHKFIL /DONE GETINP, TAD PREADC /CHECK IF FILE, GET LINE OF INPUT TAD MXREADC SZA CLA JMP GETIN1 /IT WAS A FILE FREE13 TAD C77 PRINTC TAD C40 PRINTC GETIN1, PUSHJ PAKLIN SZA CLA /EOF? ERR610, ERROR POPJ MNMSGN, 200-"# VXGET, XGET MXREADC, -XREADC /INTERRUPTS HERE FIRST INTR8E, CIF SWAP JMP I .+1 INTR81 /*IF* COMMAND IF, PUSHJ /GET FIRST VALUE EVAL PUSHF /AND SAVE IT FLARG TAD MODE PUSHA /SAVE MODE 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 PIF5, SKP CLA /7610=IF5, AT LEAST, IT BETTER!!!!!! JMP ERR390 /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 NEXT COMMAND SNA CLA ERR400, ERROR /THEN NOT FOUND POPA /GET OLD MODE TAD MODE SZA CLA JMP IFSTR /WE WANT TO DO A STRING COMPARE POPF FLARG FINT FCMP I FLARGP /GET DIFFERENCT FPUT I FLARGP /AND SAVE IT FEXT IF7, GETSGN /GET SIGN OF DIFFERENCE IF6, HLT /SKIP IF FALSE TESTN IFDONE, POPJ /SO WHO CARES ABOUT A STRANGE NO-OP? JMP I VRUN8 /GO DO COMMAND GOTO, GETLN TSTEND ERR270, ERROR /JUNK TAD LINENO /SET UP TRANSFER TO LINE POPJ /RETURN IF2, TAD SORTCN TAD M12 SPA JMP IF3 /NO 2ND OP IAC TAD IF1 DCA IF1 GETC JMP IF3+1 VRUN8, RUN8 VIF1, IF1-1 V100, 100 VREADY, READY VRESETO,RESETO /*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 VXREADC,XREADC 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 V100 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 IOFIX, 0 TAD VXREADC DCA PREADC TAD VREADY /RESET CHAIN POINTER DCA CHAINP JMS I VRESETO JMP I IOFIX /RESET OUTPUT POINTERS AND EXIT. PAGE /*LET* AND *FOR* COMMANDS FOR, L7777 LET, DCA FOR1 /SAVE DETERMINATOR PUSHJ /GET VARIABLE GETVAR SNA CLA 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 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 SNA CLA TAD PT1 TAD FOR1 SZA CLA JMP FOR4 /LOOP TSTCCR JMP I NEXERR /MAKE SURE IT'S LAST ON LINE-SORRY NO COMMENTS ISZ PDLXR /DUMP RESTART ADDRESS POPA DCA LINENO TAD LINENO UDF DCA I AXOUT /SET LINE NUMBER TAD FOR5 DCA I AXOUT /AND MIDDLE OF LINE POINTER CDF POPF /GET INCREMENT FLARG TAD AXOUT FLPUT /PUT INCREMENT FLARG POPF /GET LIMIT FLARG L0002 IAC TAD AXOUT FLPUT /SET LIMIT FLARG FINDLN /FIND US AGAIN MEQL, -"=+200 /THIS NEVER GETS EXECUTED LET1, TSTEND ERR450, ERROR /JUNK TAD FOR5 JMP I (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 FOR5, 0 NEXERR, ERR460 UNKWN, TSTALP JMP ERRCHK PUSHJ GETVAR SNA CLA TAD CHAR TAD MEQL SZA CLA JMP UNKWN+1 /NO "=" DCA FOR1 /MAKE IT A LET COMMAND JMP LET2 IFZERO .&1 ERRCHK, CLA TAD ERLINE SMA SZA CLA ERR520, ERROR /RUNNING ERR000, ERROR /IMMEDIATE MODE--"WHAT?" OPUSJ1, PUSHA TAD (OPUS PUSHA JMP I T3 FOR1, 0 /*RTL6* ROUTINE XRTL6, 0 CLL RTL RTL RTL JMP I XRTL6 PAGE /*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 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 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 /CALCULATE RETURN ADDRESS JMP XPUSHA+2 PCHK, 0 TAD PDLXR DCA PDLXR L0002 TAD LASTV STL CIA TAD PDLXR SZL CLA JMP I (ERR100-2 /PUSHED TOO FAR JMP I PCHK /*PUSHF* ROUTINE XPUSHF, 0 L7777 TAD I XPUSHF DCA XREG3 /POINT TO DATA L7775 JMS PCHK L7775 DCA T3 TAD I XREG3 UDF DCA I PDLXR CDF ISZ T3 JMP .-5 L7775 JMS PCHK /BACK AGAIN ISZ XPUSHF JMP I XPUSHF /SUBROUTINE TO WRITE OUT MESSAGES READY1, 0 DCA AXOUT /POINT TO MESSAGE DCA XCT TAD M6 DCA T2 GETC PRINTC /PRINT MESSAGE ISZ T2 JMP .-3 JMP I READY1 XPAKL1, 15 /CR 7 /BELL 177 /RUBOUT XGETL1, 137 /_ 100 /@ 40 /SPACE PAGE /*COMMAN* ROUTINE MANCOM, 0 DCA FLTXR2 /SAVE AC IF ANY TAD CHAR PUSHA /SAVE TEXT PUSHF TEXTP TAD (LIST7 CDF SWAP COM1, DCA T2 /POINT TO LIST L3777 AND I T2 /MAKE IT ACTIVE (BIT 0) DCA I T2 ISZ T2 TAD I T2 /GET POINTER SZA JMP COM1 /LOOP DCA T1 /LETTER POINTER DCA CNTR /UNIQUENESS REGISTER JMP COM2 COM3, TAD I T2 CLL RAL CLL CML RAR /MAKE IT INACTIVE DCA I T2 COM4, ISZ T2 TAD I T2 /GET POINTER SZA JMP COM5 /LOOP TAD FLTXR /ANY HITS? SNA CLA JMP COM7 /NO - EXIT CDF GETC /GET NEXT CHAR CDF SWAP COM2, ISZ T1 /COUNT LETTERS DCA FLTXR /ZERO HIT COUNT TAD (LIST7 COM5, DCA T2 /POINT TO LIST TAD I T2 SPA CLA JMP COM4 /IGNORE INACTIVE ENTRIES JMS COM12 /TEST THAT CHARACTER SZA CLA JMP COM3 /NOGO - DEACTIVATE ISZ FLTXR /COUNT HIT TAD I T2 RTR AND C7 CLL RAR DCA FLTXR TAD FLTXR CIA TAD T1 /CHECK UNIQUE SZA CLA JMP COM4 /NO TAD I T2 AND C7 CMA TAD FLTXR DCA FLTXR /- NUMBER TO GO -1 COM11, CDF GETC CDF SWAP ISZ FLTXR /MORE? JMP COM9 /YES COM8, TAD I T2 RTL6 RTL AND C77 /GET CODE TAD (-32 /CORRECT IT COM10, DCA FLTXR /AND SAVE IT TAD FLTXR2 SNA JMP .+4 /NO DOUBLE CHECK TAD FLTXR SZA CLA JMP COM7 /DOUBLE CHECK FAILS CDF L0004 TAD PDLXR /DUMPPDLJUNK DCA PDLXR TAD FLTXR JMP I MANCOM COM9, ISZ CNTR ISZ T1 JMS COM12 SNA CLA JMP COM11 /KEEP GOING L7777 TAD CNTR SNA CLA JMP COM8 /OK COM7, CDF POPF TEXTP POPA DCA CHAR JMP I MANCOM COM12, 0 CLL CLA IAC TAD T1 RAR TAD T2 DCA XREG3 TAD I XREG3 SZL JMP .+4 RTR RTR RTR AND C77 SNA TAD TSTCON TAD (-137 TAD CHAR JMP I COM12 TSTCH1, 0 /TEST A-Z,0-9 FOR FIELD 1 TESTN TSTCON, -215+337 SKP ISZ TSTCH1 TSTALP SKP ISZ TSTCH1 CIF CDF 10 JMP I TSTCH1 PAGE /*EDIT* COMMAND EDIT, GETLN /GET LINE NUMBER TSTCCR ERR001, ERROR /JUNK FINDLN /FIND THE LINE JMP ERR001 /NOT THERE ISZ SPACSW JMS I EPINPACK /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 .+2 JMP I .+2 OTPACK SRETN EPINPACK,INPACK /*DELETE* COMMAND DELETE, JMS GETLIM /GET LIMITS TAD BUFR DCA AXIN /PROTECT TEXT JMS GETLIN /GET A LINE JMP I CREADY /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 SZA CLA JMP I CSAVDON /SEE IF THIS IS A 'SAVE' TAD M100 DCA PT1 LLIST6, FREE2 L4000 PRINTC /DO L/T ISZ PT1 JMP LLIST6 JMP I CTAPE GETLIN, 0 TAD CCR /FAKE OUT GETNXT! DCA CHAR 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 EDIT+2 /JUNK LIMGT4, FINDLN /FIND THE LINE CREADY, READY TAD LASTLN DCA LINEPC /AND GO BACK ONE JMP I GETLIM LIMGT2, TAD LASTLN /1ST = 2ND JMP LIMGT3 CXDELET,XDELET CITPRNT,ITPRNT CSAVDON,SAVDON CTAPE, TAPE /*NEXT* COMMAND NEXT, PUSHJ /GET VARIABLE GETVAR SNA CLA TSTCCR ERR460, ERROR /WAS FUNCTION FINT FGET I FLARGP /PUT VARIABLE INTO FLAC FEXT UDF TAD I AXOUT /GET *FOR* LINE NUMBER SNA ERR470, ERROR /*NEXT* NOT INITIALIZED DCA T1 /SAVE LINE TAD I AXOUT DCA RUNSCR CDF 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 L0003 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 POPJ NEXT2, TAD T1 /GET LINE NUMBER OF *FOR* DCA LINENO FINDLN C50, 50 /IF IT AIN'T THERE, WELL... TAD RUNSCR FOREXT, DCA AXOUT DCA CHAR POPJ CHAIN1, JMS I PIOFX JMS I (DTFREE /REALLY FREE IT THIS TIME /*RUN* COMMAND RUN, TAD STARTV DCA LASTV /NO VARIABLES PUSHF FRNDX1 POPF /SET RANDOM NUMBER FRNDX RUN4, TAD ERLINE FIND /FIND THE NEXT STATEMENTS 1 /- NEXT CODE JMP RUN3 /OUT OF TEXT DCA ERLINE /SAVE FOR RESTART JMS RUN9 /DISMISS US NOW PUSHJ GETVAR SNA CLA TSTCCR JMP ERR460 UDF DCA I AXOUT /NOT INITIALIZED NOW CDF JMP RUN4 RUN3, JMS RUN9 /DISMISS US AGAIN TAD ALINE0 DCA LINEPC /START AT LINE ZERO RUN7, GETNXT /GET NEXT LINE JMP I (READY /ALL DONE RUN6, DCA SPACSW GETC ISZ PC JMP RUN8+1 /STILL O.K. JMS RUN9 /DISMISS US NOW SKP RUN8, ISZ PDLXR JMS I PIOFX DCA MODE TAD LINENO DCA ERLINE /SET CURRENT LINE COMMAN /GET COMMAND SMA SZA JMP I (ERRCHK TAD (COMGOL DCA T1 CDF SWAP TAD I T1 /GET ADDRESS CDF DCA .+2 PUSHJ /GO TO IT RUNSCR, 0 SNA JMP RUN7 /NORMAL RETURN DCA LINENO /FOR TRANSFER GOSUB2, FINDLN /FIND THE LINE ERR380, ERROR /NOT FOUND JMP RUN6 RUN9, 0 /DISMISSAL ROUTINE TAD RUN9 DCA PC /SET RESTART ADDRESS JMP NULL /DISMISS ABS, CDF SWAP DCA I (ACSIGN POPJ GOSUB1, POPA DCA LINENO FINDLN PIOFX, IOFIX POPA JMP FOREXT FCN, 2330 /INTEGERIZING CONSTANT 0 0 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 /CHECK FOR LITERAL STRING 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 T1 /DUMB TEMP FINT FGET T1 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-PARNES SZA CLA JMP ARGNXT /WAS + TAD EVAL1 CMA DCA EVAL1 /FLIP EVAL1 JMP ARGNXT EVAL3, POPA DCA EVAL1 /RESTORE EVAL1 POPJ /EXIT PAGE FUNCT6, PUSHA /SAVE CHARACTER DCA EFOP ISZ EFOP PUSHF /SAVE ARGS FLARG TSTCOM JMP .+6 /NO MORE ARGS JMS I (ECALL /GET NEXT POPA ISZ PDLXR ISZ PDLXR JMP .-12 TAD LASTV DCA SUBS /SAVE END OF VARIABLES TAD EFOP FUNC10, TAD (2000 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 (-5 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 FUNC17, 0 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 (FUNC16 /*UDF* ROUTINE XUDF, 0 CDF 20 /TO USER'S FIELD JMP I XUDF PAGE /COMMON PART FOR *PRINT* AND *INPUT* COMMANDS 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 /TAB? SZA CLA JMP PRIN5+1 TAD (-26 COMMAN SNA CLA POPJ /MUST BE EXPRESSION PRIN5, L7777 PUSHA SORTC TERMS-1 TSTLPR ERR340, ERROR JMS I (ECALL /GET RECURSIVE ISZ PDLXR /DUMP EFOP JMS I (PARTST /CHECK MATCH UDF ISZ I PDLXR /AHA! JMP I (PRIN12 /WAS TAB FUNCTION JMS I INTEGE PUSHA FREE2 /MAKE SOME ROOM POPA SNA L4000 /MAKE "NULL" PRINTABLE (OTHERWISE WE PRINT CHAR...) PRINTC JMP PRIN10 PRIN11, JMS I INTEGE /MAKE INTEGER OF TAB ARG TAD (-110 SZA /SPECIAL CASE CHECK TAD (110 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 PRINT3+2 FREE2 TAD C40 PRINTC JMP PRINT9+1 PRINT3, DCA SPACSW GETC SKP L7777 PRIN10, DCA PT1 /SET SPACE INDICATOR SORTJ /CHECK ; , ' " CR PRNTL4-1 PRNTL6-PRNTL4 ISZ PT1 /NO FIND O.K.? JMP PRINT4 /YES - ASSUME TAB OR EXPRESSION ERR350, ERROR /NO - SYNTAX ERROR PRINT5, TAD PPRINT TAD (-XPRNTC SNA CLA JMP PRNT5A FREE2 PRINTC JMP PRNT5B FREE2 TAD C40 PRINTC /SPACES TO FINISH ZONE PRNT5A, L0002 TAD PRNTC1 TAD (16 SPA JMP .-2 SZA CLA JMP PRNT5A-3 /KEEP GOING PRNT5B, 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 (15-40 SPA SKP CLA /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 (-110 DCA PRNTC1 /RESET COUNT TAD CLF JMP XOUTL+3 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 TAD XIOT DCA XOUTL6 /SET OUTPUT IOT TAD DECK CLL CML CMA DCA T3 SKP RAR ISZ T3 JMP .-2 MTON /TURN ON PROPER USER CLA TAD XREG3 XOUTL6, HLT DCA TELSW /SET BUSY TAD I (AUSER MTON /ALL ON AGAIN MINT /WITH INTERRUPTS CLA JMP XOUTL4 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 /*FINDLN* ROUTINE XFINDL, 0 TAD LINENO SPA CLA /IS THIS IMMEDIATE MODE??????? JMP XFNDL3 /YEP. 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 /RESET TO DO COMMAND BUFFER NOW /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 JMS I (IOFIX /RESET FILES TAD (ERRORX DCA PC /SET FOR RESTART JMP I IERROR 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 /RUNNING JMP IERRO2 /NOT RUNNING FLTONE, 2014 FLZERO, 0 0 0 PAGE /*PACKC* ROUTINE XPACKC, 0 SORTJ XPAKL1-1 XPAKL2-XPAKL1 XXPAK, 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 (37 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 XPPCK1, PUSHF /SAVE TEXT POINTERS TEXTP TAD XPACKC PUSHA /SAVE ADDRESS IF DISMISSED FREE13 TAD (44 PRINTC /PRINT "$" TAD C40 PRINTC TAD C7 JMS I (READY1 /PRINT "DELETE" GETC /PRINT "D" PRINTC GETC /PRINT CR PRINTC POPA DCA XPACKC /RESTORE ADDRESS TAD PACKST DCA AXIN POPF TEXTP DCA CHAR JMP XPACK1+3 /*READC* ROUTINE XREADC, 0 UDF 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 XREAD1, L7777 TAD XREADC DCA PC /SET TO REDO ROUTINE TAD I LOOK JMS I (XOR 4000 /I WAIT AND DISMISS /*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 RESETO, 0 /RESET OUTPUT POINTERS TAD (XPRNTC DCA PPRINT TAD (XFREE2 DCA PFREE2 TAD (XFREE3 DCA PFREE3 JMP I RESETO PAGE /*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 /*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 /*TESTN* ROUTINE XTESTN, 0 TAD CHAR TAD (-60 DCA SORTCN /SAVE BINARY DIGIT L0002 TAD SORTCN SNA JMP I XTESTN /PERIOD ISZ XTESTN TAD (-13 SMA SZA CLA JMP I XTESTN /GREATER THAN 271 TAD SORTCN SMA CLA ISZ XTESTN /DIGIT JMP I XTESTN /*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 XGET7, TAD CHAR /COPY TO UPPER FIELD CDF SWAP DCA I (OCHAR CDF 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 XGET7 /KEEP SPACES JMP XGETC+1 /IGNORE SPACES XGET4, TAD C7 /BELL XGET6, DCA CHAR JMP XGET7 XGET5, TAD CCR /CR JMP XGET6 /*GETNXT* ROUTINE NXTGET, 0 TSTCCR /END OF LINE? SKP CLA JMP NXTGT1 /YES, GET NEXT LINE NUMBER TAD CHAR TAD MSPLAT SNA CLA JMP NXTG /YES, NEXT COMMAND FOUND GETC /NO, GET ANOTHER CHAR JMP NXTGET+1 /TRY AGAIN NXTGT1, UDF TAD I LINEPC /POINTER TO NEXT SNA JMP NXTG+1 /OUT OF TEXT DCA LINEPC /NEW POINTER TAD LINEPC DCA AXOUT DCA XCT /SET TO UNPACK TAD I AXOUT /GET LINE NUMBER DCA LINENO NXTG, ISZ NXTGET CDF JMP I NXTGET /*FIND* ROUTINE XFIND, 0 DCA LINENO /SET START LINE FINDLN MSPLAT, -"\+200 XFIND1, GETNXT /GET NEXT LINE 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 GETCX1, 0 /*GETC* FOR FIELD 1 GETC CIF CDF SWAP JMP I GETCX1 USER0, 0 USER1, 1 USER2, 2 USER3, 3 USER4, 4 PAGE /*GOSUB* COMMAND GOSUB, GETLN TSTEND ERR290, ERROR GOSUB3, L7777 TAD AXOUT PUSHA TAD ERLINE PUSHA TAD (GOSUB1 PUSHA JMP I (GOSUB2 /*NEW* AND *BYE* AND *SCRATCH* COMMANDS NEW, L7777 RENAME, DCA MODE /KLUDGE! PUSHJ GETNAM JMS I (DTGRAB /SO WE DON'T BLOW ANY OTHER NAMES CIF CDF SWAP /UNPACK THE NAME JMS I (XGETNAM JMS MOVNAM /GET THE NAME WHERE IT COUNTS JMS I (DTFREE /SEE, WE DIDN'T USE THE TAPE! ISZ MODE /NEW OR RENAME COMMAND? JMP I (READY BYE, TSTCCR ERR002, ERROR /JUNK UDF DCA I ALINE0 /NO TEXT L0002 TAD ALINE0 DCA BUFR /FREE UP TEXT SPACE END, TAD STARTV DCA LASTV JMP I (READY MOVNAM, 0 CDF SWAP /MOVE NAME DOWN TAD I CCR /TAD I [NAMEX DCA NAME TAD I (NAMEX+1 DCA NAME+1 TAD I (NAMEX+2 DCA NAME+2 CDF JMP I MOVNAM INPUTX, DCA DATAPC TAD CCR DCA DATAPC+4 /AUTO-RESTORE COMMAN TAD M6 SPA JMP IMMED /IMMEDIATE MODE TAD (COMGO1 DCA T1 CDF SWAP TAD I T1 CDF DCA T1 JMP I T1 IMMED, L7777 TAD COMBUF DCA LINEPC L7777 DCA LINENO /IMMEDIATE MODE JMS I (OTPACK JMP I (RUN8+1 /*ON* COMMAND--ON-GOTO AND ON-GOSUB ON, PUSHJ /GET VALUE EVAL COMMAN TAD C7 SNA JMP .+5 TAD (4 SZA CLA ERR300, ERROR L7777 DCA T2 JMS I INTEGE SNA SPA SZL JMP ON2 CIA DCA T1 ON1, GETLN ISZ T1 JMP .+3 TAD LINENO PUSHA TSTCOM JMP .+3 GETC JMP ON1 TSTEND JMP ERR300 TAD T1 SPA CLA JMP ON2 /IT WASN'T THERE POPA DCA LINENO TAD LINENO ISZ T2 POPJ /*GOTO* COMMAND--TRANSFER TO IT JMP GOSUB3 /*GOSUB* CMD--CALL GOSUB (NO NEED TO CLEAR AC) ON2, TAD ERLINE /INDEX WAS OUT OF RANGE DCA LINENO POPJ PRIN12, FINT FPUT I (IF1 /SETUP CALL TO 'MOD' FEXT PUSHF F72 POPF FLARG PUSHJ MOD1 PUSHJ ABS /MAKE IT POSITIVE JMP I (PRIN11 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 /CHECK FOR $ TAD MDOLR SZA CLA JMP LOOKUP ISZ MODE /IT'S A STRING! JMP .+4 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 I GFND1I /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 GS2, TAD C7 TAD LASTV /ROOM LEFT CLL CIA TAD PDLXR SZL CLA JMP .+4 TAD STARTV DCA LASTV /WIPE OUT VARIABLES--OVERFLOW ERR100, ERROR /NO ROOM L0001 RTL 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 SUB2I, SUB2 GS5I, GS5 FUNCTI, FUNCT ECALLI, ECALL AC3I, AC3 MDOLR, -44 GFND1I, GFND1 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 I SUB2I /ONLY ONE SUBSCRIPT PUSHF /SAVE ADD,SUBS ADD PUSHJ /GET SECOND SUBSCRIPT EVAL-1 POPF ADD JMS I INTEGE AND C7700 RAR SZA CLA JMP SUB1 /TOO BIG TAD SUBS AND C7700 SZA CLA JMP SUB1 /TOO BIG TAD SUBS RTL6 CDF SWAP TAD I AC3I /FORM DOUBLE SUBSCRIPT CDF DCA SUBS L2000 TAD ADD DCA ADD /INDICATE 2 SUBSCRIPTS SUB2, JMS I (PARTST /CHECK PAREN MATCH JMP I (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 (GS4 /WRONG SUBSCRIPT GFND2, CDF L7775 TAD PT1 DCA PT1 /POINT TO DATA GS5, FLGET /GET VARIABLE FLARG POPJ FUNCT, TAD CHAR AND (37 TAD ADD SORTC /CHECK 2 LETTERS FUNL1-1 SKP JMP I (LOOKUP /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 (FUNL2-1 DCA T3 CDF SWAP TAD I T3 /GET CORRECT CODE TAD PT1 SZA CLA JMP I (LOOKUP /WAS NOT A FUNCTION TAD SORTCN PUSHA /SAVE CONSTANT GETC FUNCT5, GETC SORTC TERMS-1 TSTLPR ERR240, ERROR /NO L-PAREN POPA IAC /FUNCTION CODE POPJ 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 CDF SWAP TAD I XREG3 CDF SPA JMP XSORT3 /END OF LIST TAD T3 SZA CLA JMP .-7 /NO GO - LOOP TAD I XSORTC CMA TAD XREG3 DCA SORTCN /SET CONSTANT SKP XSORT3, ISZ XSORTC ISZ XSORTC CLL CLA 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 XPRT1, 0 /PRINTC FOR FIELD 1 PRINTC CIF CDF SWAP JMP I XPRT1 PAGE FLOUT, 0 CIF CDF SWAP JMS I (OFLOUT JMP I FLOUT ISZ I (PRNT5 JMS I (ITPRNT JMP I FLOUT SGN, FINT FSGE FGET MNSONE FSLE FGET I (FLTONE FEXT POPJ MNSONE, 6014 0 0 FUPARR, FPUT I (TEMP FGET I PT1 FADD I (FCN FCMP I PT1 FSEQ FJMP EXPLNG FGET I PT1 FSGE FMUL MNSONE FSUB I (FUPAR1 FSLE FJMP EXPLNG FGET I PT1 FSLT FJMP .+5 FGET I (FLTONE FDIV I (TEMP FPUT I (TEMP FGET I PT1 FEXT JMS I INTEGE SPA CIA CMA DCA FUPAR2 FINT FGET I (FLTONE FEXT JMP .+4 FINT FMUL I (TEMP FEXT ISZ FUPAR2 JMP .-4 JMP FUPAR3 FUPAR2=FLOUT EXPLNG, FGET I (TEMP FEXT PUSHJ LOG FINT FMUL I PT1 FEXT PUSHJ FEXP FUPAR3, FINT FJMP I (FLOP+1 TAPE, L0001 KKEY, DCA PT1 /SAVE CONSTANT FOR OUTPUT TSTCCR ERR003, ERROR /JUNK JMS I (RUN9 /DISMISS US NOW TAD TELSW SZA CLA JMP .-3 /STILL BUSY - WAIT TAD PT1 DCA OUTPUT /SET OUTPUT JMP I (READY FUNC16, GETC TAD CHAR TAD FMEQL SZA CLA ERR210, ERROR PUSHJ EVAL-1 TSTEND JMP .-4 POPA DCA ERLINE TAD ERLINE DCA LINENO FINDLN FMEQL, -"=+200 POPA DCA LASTV POPA DCA SORTCN POPF TEXTP DCA MODE /!!! JMP I (ENDFUN XFLGET, 0 SZA JMP .+3 L7777 TAD PT1 XFLGT2, DCA FLTXR L7777 TAD I XFLGET DCA FLTXR2 L7775 DCA T3 UDF TAD I FLTXR CDF DCA I FLTXR2 ISZ T3 JMP .-5 ISZ XFLGET JMP I XFLGET PAGE 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 (XFREE DCA FREESV /SAVE XFREE ADDRESS DCA USER /START AT USER 0 DCA TEMP1 /NO TTY'S TO TURN ON AT FIRST TAD (TAD INTRPL DCA INTRP1 /SET LIST POINTER INTRP1, HLT /GET TLS IOT TAD M4 DCA INTRP4 /TCF L7777 TAD INTRP4 DCA INTRP3 /TSF TAD M10 TAD INTRP3 DCA INTRP2 /KSF CIF CDF SWAP /GO CHECK DECTAPE FLAG JMS DTINTR TAD TEMP1 MTON /TURN ON PROPER USER CLA INTRP2, HLT /KEY? SKP /NO JMS I (KEY /READ TTY TAD TEMP1 MTON /USER ON AGAIN CLL RAR /SHIFT FOR NEXT USER SNA /FIRST TIME? L4000 /YES - GET TTY #1 BIT 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 INTRP1 /BUMP LIST POINTER TAD USER TAD MUSER /ARE WE DONE? SZA CLA JMP INTRP1 /NO INTRP5, TAD AUSER MTON /TURN ALL USERS ON AGAIN MINT /WITH INTERRUPTS CLA TAD I LOOK /GET RUNNING USER JMS I DECKNI /AND PUT HIM ONDECK TAD T3SV DCA T3 /RESTORE ALL THOS STORED THINGS TAD XREG3S DCA XREG3 TAD SRTCNS DCA SORTCN TAD UDFSV DCA I AUDF TAD SORTCS DCA I ASORTC TAD FREESV DCA I (XFREE ISZ I (INTCNT /COUNT INTERRUPTS DECKNI, DECKON TAD SAVLK /GET LINK BACK CLL RAL TAD SAVAC /AND THE AC ALSO RMF ION JMP I 0 /EXIT FROM INTERRUPT 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 /4000 FOR 2 USERS; 6000 FOR 3 USERS; ETC. SORTCS, 0 INTRPL, TLS /USER 0 TLS IOT MTLS /USER 1 TLS IOT MTLS /USER 2 MTLS /USER 3 MTLS /USER 4 CIF SWAP JMP I INTRPL-1 /AND EXIT /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 /FIX FOR KL8/E HARDWARE BUG: /(BARRY OR STEVE--MOVE THIS TO FIELD 1 SOMETIME. THIS SPACE COULD /BE BETTER USED) KL8FIX, TAD (TAD INTRPL DCA KL8F1 TAD MUSER DCA T2 IAC TAD M12 KL8F1, HLT DCA .+2 IAC HLT ISZ KL8F1 ISZ T2 JMP KL8F1-1 CLA MQA IAC MQL TAD LOOKST DCA LOOK JMP NULL PAGE 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 JMP PRINT FIX, 0 CIF CDF SWAP /CALL THE FIX ROUTINE JMS I (FIX1 JMP I FIX OLD, TAD (SAVDN1 /SET UP FAKE RETURN FOR *OLD* COMMAND DCA CHAINP /TO LOCK THE TAPE ON AN OLD JMP I (OLD1 /GO TO REAL ROUTINE OPTABL, FGET I PT1 FADD I PT1 FSUB I PT1 FMUL I PT1 FDIV I PT1 FJMP 0 /FUNCTIONS IN FIELD 1 CALLED WITH *PUSHJ* RND, FINT FGET FRNDX FEXT TAD (ORND-OINT INT, TAD (OINT-OFFIX FFIX, TAD (OFFIX-OSQR SQR, TAD (OSQR-OTAN TAN, TAD (OTAN-OCOS COS, TAD (OCOS-OFSIN FSIN, TAD (OFSIN-OFEXP FEXP, TAD (OFEXP-OLOG LOG, TAD (OLOG-OATN ATN, TAD (OATN DCA T3 CIF CDF SWAP JMP I T3 PRNTL4, 73 /; PRNTL1, 54 /, 47 /' PRNTL7, 42 /" 15 /CR 134 /\ RUN9X, PUSHA /SAVE FIELD 1 RESTART ADDRESS JMS I (RUN9 /DISMISS US POPA /RESTORE ADDRESS DCA T1 CIF CDF 10 /GO TO IT JMP I T1 PRINT0, TAD CHAR TAD (200-"# SZA CLA JMP PRINT /OK AS IS TAD OBLK SZA CLA GETC TSTCOM JMP I (ERR600 GETC JMS I (SETUPO 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 FREE2 TAD CCR PRINTC PRINT6, IAC POPJ OPUS, POPA DCA T3 CIF CDF 10 JMP I T3 PAGE /*OR* ROUTINE XOR, 0 DCA T3 TAD I XOR CMA AND T3 TAD I XOR DCA I LOOK JMP NULL INPACK, 0 TAD COMBUF DCA AXIN DCA XCTIN TAD COMBUF DCA PACKST TAD (ALINE0 DCA PACKND JMP I INPACK OTPACK, 0 TAD COMBUF DCA AXOUT DCA XCT TAD CCR /DON'T MOVE PDLXR FROM 15 DCA PACKND GETC JMP I OTPACK PAKLIN, JMS INPACK READC JMP .+3 L0001 POPJ PACKC TSTCCR JMP .-6 PACKC JMS OTPACK POPJ FPNT, 0 /CALL THE REAL INTERPRETER CLA CLL TAD FPNT CIF CDF SWAP DCA I (OFPNT JMP I (OFPNT+3 /SET FIELD 0 OTEST2, 0 /FIELD 1 *TESTN* TESTN JMP .+4 /RETURN +1 SKP /+2 ISZ OTEST2 /+3 ISZ OTEST2 CIF CDF SWAP /RETURN TO FIELD 1 JMP I OTEST2 XGETLN, 0 /*GETLN* CIF CDF 10 /CALL THE REAL ROUTINE JMS I (OGETLN JMP I XGETLN /PAREN TEST ROUTINE PARTST, 0 POPA DCA LASTOP /SAVED BY *ECALL* L7776 TAD SORTCN CIA POPA /CHECK MATCH SZA CLA ERR260, ERROR /NO MATCH GETC JMP I PARTST /*RETURN* AND *POPJ* RETURN, ISZ PDLXR /DUMP ONE RETURN ADDRESS TSTEND ERR320, ERROR XPOPJ, DCA XREG3 /SAVE AC POPA DCA T3 /RETURN ADDRESS TAD XREG3 /GET AC JMP I T3 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 JMP I (ENDFUN IECALL, ECALL FUNC6I, FUNCT6 FUNL3I, FUNL3-2 FLIN, 0 CIF CDF SWAP JMS I (OFLIN FINT FPUT I PT1 FEXT JMP I FLIN GETNAM, TSTEND /DID THEY GIVE A NAME? POPJ /YES, GO UNPACK IT FREE13 /PRINT "NAME--" TAD (21 /POINT TO TEXT JMS I (READY1 PUSHJ /GO PACK THE REPLY PAKLIN POPJ ALPTST, 0 TAD CHAR TAD (-"A+200 SPA CLA JMP I ALPTST /LESS THAN *A* TAD CHAR TAD (-"Z+200 SPA SNA CLA ISZ ALPTST JMP I ALPTST F72, 2074;4000;0 PAGE /*FREE2* AND *FREE13* ROUTINES XFREE2, 0 JMS XFREE /ROOM JMP .+3 /WE MUST WAIT 0 JMP I XFREE2 TAD XFREE2 JMP FREEWT /GET ROOM XFREE3, 0 JMS XFREE /ROOM FREEC, 14 SKP /MUST WAIT JMP I XFREE3 TAD XFREE3 FREEWT, DCA PC /SET RESTART TAD I LOOK JMS I (XOR /SET O WAIT AND DISMISS 2000 /*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 /*LINPUT* COMMAND, INPUT AN ENTIRE LINE OF TEXT /INTO A STRING ARRAY LINPUT, JMS I (CHKFIL /CHECK IF FILE INPUT 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 GETINP 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 (QCT1 /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 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 LINCT, TEMP, 0 0 0 FLARG, 0 0 0 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 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 /*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 UNPACK 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 PAGE /*FLPUT* ROUTINE XFLPUT, 0 SZA JMP .+3 L7777 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 /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 (-15 JMP COMTST+2 ENDTST, 0 TAD (-"'+200 TAD CHAR SZA TAD ("'-"\ SNA CLA ISZ ENDTST TAD ENDTST JMP CCRTST+2 /*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 (100 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 STRING MODE TAD CNTR JMS FLOAT /FLOAT NUMBER INTO FLARG POPJ /FLOATS NUMBER IN AC INTO FLARG FLOAT, 0 DCA T1 /SAVE NUMBER TAD (ACSIGN-1 /SET TO FLOAT DCA FLTXR CDF SWAP DCA I FLTXR /ZERO ACSIGN DCA I FLTXR TAD (217 /EXPONENT FUDGE DCA I FLTXR /INTO ACEXP DCA I FLTXR /ZERO AC3 TAD T1 DCA I FLTXR /NUMBER IN AC2 DCA I FLTXR /ZERO AC1 FINT FNOR /FLOAT NUMBER FPUT I FLARGP /PUT INTO FLARG FEXT JMP I FLOAT /DONE POPF FLARG ENDFND, DCA SPACSW PUSHF TEXTP GETC TSTEND JMP .-2 TSTCCR JMP ENDFND-2 POPF TEXTP GETC COMMAN IAC POPJ XPUT, 0 /FILE OUTPUT ROUTINE SNA TAD CHAR DCA T3 TAD XPUT PUSHA XPUT3, TAD T3 PUSHA TAD T3 JMS I LENDON /XPUT0=7200 POPA TAD (-15 SZA CLA POPJ TAD CLF DCA T3 JMP XPUT3 CHAIN, JMS I (DTGRAB TAD (CHAIN1 DCA CHAINP JMP I (CHAIN2 PAGE DTQ1, DTQ DTQ2, DTQ DTGRAB, 0 /GET THE TAPE! CIF 10 /CALL CHECKING ROUTINE JMS I (DTCHKX DCA I DTQ2 TAD DTQ2 /BUMP QUEUE POINTER IAC /(MUST BE AT START OF PAGE) AND (7607 DCA DTQ2 TAD DTQ1 /WAS THE QUEUE EMPTY? CLL CMA TAD DTQ2 AND C7 SNA CLA JMP XDTG1 /YES, GIVE THIS JOB THE TAPE TAD DTGRAB /SET RESTART ADDRESS DCA PC TAD I LOOK /SET DECTAPE BUSY JMS I (XOR /AND DISMISS 1000 XDTG1, ION /RETURN TO THE JOB JMP I DTGRAB /(WITH THE DECTAPE) DTFREE, 0 /LET THE TAPE GO TAD CHAINP /CHECK IF WE SHOULD HOLD ONTO TAPE TAD (-READY /FOR AN OLD, SAVE, OR CHAIN SZA CLA JMP I DTFREE /RETURN, BUT STILL HOLD ONTO TAPE!! DCA I DTQ1 /CLEAR THE SLOT TAD DTQ1 /BUMP THE POINTER IAC AND (7607 DCA DTQ1 TAD I DTQ1 /IS THERE ANOTHER REQUEST? SNA JMP I DTFREE /NO, ALL DONE! TAD LOOKST /BUILD A POINTER TO STATUS DCA T3 IOF TAD I T3 /CLEAR DECTAPE BUSY AND (6777 DCA I T3 ION JMP I DTFREE /BACK TO CURRENT JOB XGET, 0 /FILE INPUT ROUTINE CLA CLL ISZ I3 /3RD CHAR OF 3? JMP GET1 /NO, NORMAL L7776 /BACK UP POINTER TAD IPNTR DCA IPNTR L7775 /RESET 3-WAY SWITCH DCA I3 CDF SWAP /GET THE FIRST HALF TAD I IPNTR ISZ IPNTR AND C7400 CLL RTL RTL DCA CHAR /HANDY TEMP TAD I IPNTR /GET THE SECOND HALF AND (7400 TAD CHAR /GET THE FIRST HALF (AGAIN?) RTL RTL RAL JMP GEXIT GET1, TAD IPNTR /IS THERE ANY BUFFER? AND C177 SZA CLA JMP GET2 /GUESS SO TAD BASE /BUILD POINTER TO BUFFER TAD (200 DCA IPNTR TAD XGET /SAVE THE RETURN PUSHA JMS DTGRAB /GET THE DECTAPE TAD IPNTR /MOVE THE ARGS DCA IBUFF TAD IBLK DCA INBLK ISZ IBLK /NEXT BLOCK, NEXT TIME CLA IAC /AC=1 FOR READ CIF SWAP JMS I (DTAPE /DO THE DECTAPE THING IBUFF, 0 7600 /READ 200 WORDS (ONE PAGE) INBLK, 0 JMS DTFREE /ALL THROUGH, GIVE IT BACK POPA /RESTORE THE RETURN DCA XGET L7776 /PRETEND WE SET THE PACK SWITCH DCA I3 GET2, CDF SWAP /NORMAL CHARACTER UNPACKING TAD I IPNTR /GET THE CHARACTER GEXIT, ISZ IPNTR C7400, NOP 400 /IN CASE IT SKIPS CDF AND C177 /MASK OFF PARITY SZA /IGNORE NULLS TAD M12 /AND LINE FEEDS SZA TAD (12-14 /AND FORM FEEDS SNA JMP XGET+1 TAD (14-32 /CHECK FOR ^Z SZA JMP .+5 ISZ XGET /SKIP RETURN FOR EOF DCA IBLK /CLEAR FILE OPEN TAD (XREADC /RESET 'READC' DCA PREADC TAD (32 /RESTORE CHAR DCA CHAR JMP I XGET /WHEW! PAGE DTQ, ZBLOCK 10 STRFIL, 0 /GET A STRING FILENAME JMS I (DOLCHK /SET EXTENSION PUSHJ /GET FILE NAME EVAL TAD CHAR /SAVE TEXT POINTERS PUSHA PUSHF TEXTP CLA CMA /PUSH A CR PUSHA PUSHF /FINALLY, PUSH THE STRING FLARG TAD PDLXR /SET UP UNPACKING (FROM THE STACK!) DCA AXOUT DCA XCT GETC /GET THE FIRST CHAR CIF CDF SWAP JMS I (XGETNAM /GET THE FILE NAME TAD PDLXR /UNSTACK GARBAGE TAD (4 DCA PDLXR POPF /RESTORE THE TEXT POINTERS TEXTP POPA DCA CHAR JMP I STRFIL /DONE WITH FILENAME OPEN, JMS I (DTGRAB /GET THE DECTAPE TAD M100 /SET '.DX' EXTENSION JMS STRFIL /GET THE FILENAME TAD CLF /DOUBLE CHECK FOR 'FOR' COMMAN SNA CLA ERR620, ERROR /WASN'T THERE COMMAN /MUST BE 'INPUT' OR 'OUTPUT' TAD (5 /CHECK FOR 'INPUT' SNA JMP OINPUT TAD (-5-4+32 SZA CLA JMP ERR620 FILOUT, TSTCOM /LENGTH GIVEN? JMP NOLEN /ASSUME 10 BLOCKS PUSHJ /EVALUATE THE LENGTH EVAL-1 JMS I INTEGER /FIX IT SPA SNA SZL ERR650, ERROR /TOO BIG OR TOO LITTLE LENIN, DCA OMAX /SAVE LENGTH TAD DECK /USER 0 CAN OPEN ANY LENGTH SZA CLA TAD OMAX /ANYBODY ELSE IS LIMITED TO 64 TAD C7700 SPA SNA CLA /TOO BIG, SCREW HIM! LENOK, TSTEND /SHOULD BE END JMP LENIN-1 TAD M100 /MAKE SURE EXTENSION IS CORRECT JMS I (DOLCHK /(HE COULD HAVE SAID 'OPEN $') TAD OMAX /PUT LENGTH FOR ENTER IN AC CIF CDF SWAP JMS I (XENTER /ENTER AND CLOSE ERR630, ERROR CDF SWAP TAD I (BLOCK CLL RAL DCA OBLK L7775 DCA O3 /INIT POINTERS TAD BASE DCA OPNTR TAD OMAX /FORM MAXIMUM LENGTH (IN PAGES) CLL RAL CMA DCA OMAX JMP OUTOUT /USE SOME COMMON CODE NOLEN, TAD CLF /ASSUME 10 BLOCKS JMP LENIN SAVDON, TAD PPRINT /WAS THIS A 'SAVE'? TAD (-XPRNTC SNA CLA JMP I (READY /NO, GOTO 'READY' PUSHJ /CLOSE THE FILE CLOSE0 SAVDN1, JMS I (IOFIX JMS I (DTFREE /RELEASE THE TAPE FOR REAL JMP I (READY /ALL DONE! OINPUT, TSTEND JMP ERR620 CIF CDF SWAP JMS I (FLOOK /LOOK UP THE FILE CDF SWAP TAD I (BLOCK /GET THE TAPE BLOCK CLL RAL /*2 FOR PAGES DCA IBLK DCA I3 /CLEAR THE SWITCH DCA IPNTR /AND THE POINTER OUTOUT, CDF JMS I (DTFREE /GIVE UP THE TAPE POPJ RESTOR, TSTEND ERR280, ERROR DCA DATAPC TAD CCR DCA DATAPC+4 POPJ ERR330, ERROR PAGE XPUT0, 0 CDF SWAP ISZ O3 JMP PUT1 DCA T3 L7776 TAD OPNTR DCA OPNTR JMS OPAK JMS OPAK CDF L7775 DCA O3 TAD OPNTR AND C177 SZA CLA JMP I XPUT0 ISZ OMAX /GONE TOO FAR? JMP .+3 DCA OBLK /CLEAR FILE ERR640, ERROR TAD BASE DCA OPNTR JMS I (DTGRAB TAD BASE DCA OBUFF TAD OBLK DCA OUTBLK ISZ OBLK CIF SWAP JMS I (DTAPE OBUFF, 0 7600 OUTBLK, 0 JMS I (DTFREE JMP I XPUT0 PUT1, AND C177 DCA I OPNTR ISZ OPNTR CDF JMP I XPUT0 IFNZRO XPUT0-7200 OPAK, 0 TAD T3 CLL RTL RTL DCA T3 TAD T3 AND (7400 TAD I OPNTR DCA I OPNTR ISZ OPNTR JMP I OPAK OFREE2, 0 TAD OFREE2 PUSHA TAD (-2+200 TAD BASE CLL CIA TAD OPNTR SNL CLA POPJ L4000 PRINTC TAD BASE CIA TAD OPNTR SZA CLA JMP .-6 POPJ OFREE3, 0 TAD OFREE3 PUSHA TAD M6 JMP OFREE2+3 OLD1, TAD CHAR /CHECK FOR LIBRARY CALL TAD (-"$+200 SZA CLA JMP .+4 GETC /SKIP OVER $ TAD C10 SKP TAD DECK /PUSH HIS NUMBER IF NOT LIBRARY PUSHA PUSHJ /GET THE PROGRAM NAME GETNAM JMS I (DTGRAB /GET THE TAPE POPA /SET THE EXTENSION TAD (560 CIF CDF SWAP /UNPACK THE NAME DCA I (EXTEN JMS I (XGETNAM SKP CHAIN2, JMS I (STRFIL JMS I (MOVNAM /MOVE THE NEW NAME DOWN PUSHJ /LOOKUP THE FILE OINPUT+2 /AND SWITCH TO FILE INPUT UDF /SCRATCH USER AREA DCA I ALINE0 L0002 TAD ALINE0 DCA BUFR TAD (XGET DCA PREADC JMP I (START /RETURN TO COMMAND INPUT! SETUPO, 0 TAD (XPUT DCA PPRINT TAD (OFREE2 DCA PFREE2 TAD (OFREE3 DCA PFREE3 JMP I SETUPO PAGE INTCNT, 0 RANDOM, TAD FRNDX+1 TAD INTCNT DCA FRNDX TAD INTCNT DCA FRNDX+1 POPJ XPRNTC, 0 IOF PRINTX ION JMP I XPRNTC CLOSE0, TAD OBLK /ANY FILE TO CLOSE? SNA CLA JMP I (ERR600 JMS I (SETUPO /OPEN OUTPUT TAD (232 /WRITE A ^Z PRINTC TAD BASE CIA TAD OPNTR SZA CLA JMP .-6 DCA OBLK /CLOSE THE FILE! POPJ SAVE, ISZ CHAINP /SET TAPE LOCKING FLAG JMS I (DTGRAB /GET THE DECTAPE CDF SWAP /MOVE THE NAME TO TAD NAME /WORKING SPACE DCA I (NAMEX TAD NAME+1 DCA I (NAMEX+1 TAD NAME+2 DCA I (NAMEX+2 TAD DECK TAD (560 /SET '.EX' EXTENSION DCA I (EXTEN CDF DCA OMAX /SETUP TO COMPUTE LENGTH TAD ALINE0 /(BUFR)-(ALINE0)=LENGTH IN WORDS CIA TAD BUFR CLL RAR /HALVE IT FOR THOSE USERS WITH OVER 2K ISZ OMAX /(# WORDS)*2/(CHAR'S/BLOCK)+1=BLOCKS TAD (-124 /(APPROX # CHAR'S/BLOCK)/2 (AND 2 AGAIN) SMA JMP .-3 /CONTINUE DIVISION CLA CLL /NOW DO ENTER PUSHJ /OPEN FILE LENOK+4 DCA OUTPUT /FOR 'LIST' JMS I (SETUPO /SETUP TO PRINT JMP I (LIST /CALL 'LIST' KILL, L4000 DCA ERLINE UNSAVE, PUSHJ /GET THE NAME GETNAM JMS I (DTGRAB /GET THE DECTAPE CIF CDF SWAP /BUILD THE NAME JMS I (XGETNAM TAD ERLINE /WHICH EXTENSION? SZA CLA TAD M100 /'.DX' EXTENSION JMS DOLCHK /JUST TO SET '.EX' EXTENSION CIF CDF SWAP /DO THE CLOSE JMS I (XENTER /WHAT? UNSAV1, JMS I (DTFREE /RELEASE THE TAPE JMP I (READY /ALL DONE DATLOG, L4000 DCA ERLINE CATLOG, TAD CLF PRINTC JMS I (DTGRAB /GET THE TAPE TAD ERLINE SZA CLA TAD M100 /LIST '.DX' EXTENSIONS JMS DOLCHK /SET CATALOG TO LIST CIF CDF SWAP /GET THE CATALOG JMS I (CAT0 CATLUP, FREE13 /MAKE SURE THERE'S ROOM CIF CDF SWAP /PRINT THE NEXT NAME JMS I (CAT1 JMP CATLUP /DO IT AGAIN! JMP UNSAV1 PRINT2, ISZ SPACSW /KEEP SPACES GETC SORTJ PRNTL7-1 /CHECK " CR PRNTL8-PRNTL7 FREE2 PRINTC JMP PRINT2+1 /KEEP PRINTING THE LITERAL DOLCHK, 0 /DECIDE WHICH CATALOG TO USE TAD (560 /SET EITHER '.E0' OR '.D0' DCA T1 TAD CHAR /CHECK FOR $ TAD (-"$+200 SNA CLA JMP .+7 TAD DECK /ADD CURRENT USER TO EXTENSION CDF SWAP TAD T1 DCA I (EXTEN CDF JMP I DOLCHK GETC /SKIP OVER $ TAD C10 JMP .-7 PAGE FIELD 1 *5000 MVPAG=. NOPUNCH *7600 /THIS WILL BE MOVED LATER ENPUNCH JMP 7756 /FOR A MONITOR SYSTEM QMQOT, -42 QPT1, .+1 11 QCT1, 0 QEVAL2, EVAL2+3 QINPACK,INPACK QUOCNT, 0 IFNZRO 7610-. IF5, SMA SZA CLA SPA CLA SNA CLA SMA CLA SPA SNA CLA SZA CLA QCOUNT, 0 QUOTES, TAD CHAR /LITERAL STRING TAD QMQOT SZA CLA JMP I QEVAL2 /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 QPT1 DCA PACKND SKP /WE ALREADY 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 COMMAND 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 FRNDX1, 0001 /INITIALIZE RANDOM NUMBER 0203 5555 ENDFUN, FINT FNOR /NORMALIZE IT FPUT I FLARGP /SAVE DATA FEXT ENDF1, TAD FLARGP DCA PT1 /POINT TO DATA DCA SPACSW JMS I QPARTST JMP I QOPNEXT QPARTST,PARTST QOPNEXT,OPNEXT PAGE 0 DTINTR, 0 DTSF /DECTAPE? JMP DIS+1 DCA INTAC1 /JUST FOR *DECKON* JMP I MCOM /YES, GO TO IT OCHAR, 0 /*CHAR* FROM FIELD 0 OCNTR, 0 /FLT PT COUNTER OFPNT /FLOATING INTERPRETER CALL FXR1, 0 /FLOATING POINT INDEX REG FXR2, 0 XR1, 0 XR2, 0 XR3, 0 *15 /NAMEX MUST BE AT LOCN. 15 FOR MOVNAM TO WORK NAMEX, ZBLOCK 3 DIS, TAD INTAC1 /RESTORE AC CIF CDF JMP I DTINTR /RESUME INTERRUPT PROCESSING OPRINTC=JMS I . /FIELD 1 PRINTC OPRINC OERROR= JMS I . /FIELD 1 ERROR CALL OERRX OGETC= JMS I . /FIELD 1 GETC (LEAVES CHAR IN 'OCHAR') OGETCX OTESTN= JMS I . /FIELD 1 TESTN OTESTX OPOPJ= JMP I . OPOPJX OPUSHJ= JMS I . OPUSHX DECTAP= JMS I . /DO READ OR WRITE DTAPE ENTER= JMS I . /OS/8 ENTER XENTER ERROX= JMP . ERR530, OERROR CLOSE= JMS I . /OS/8 CLOSE XCLOSE GETCAT= JMS I . /READ IN DIRECTORY XGETCAT BUMPXR= JMS I . /UTILITY XBUMPXR DIRSCH= JMS I . /FIND A FILE NAME XDIRSCH SETPT= JMS I . /SETUP DIRECTORY POINTERS XSETPT /FLOATING POINT STORAGE OPSIGN, 0 /OPERAND SIGN ACSIGN, 0 /FLAC SIGN OPEXP, 0 /OPERAND EXPONENT ACEXP, 0 /FLAC EXPONENT AC3, 0 /FLAC AC2, 0 AC1, 0 OP3, 0 /OPERAND OP2, 0 OP1, 0 OVER, 0 /OVERFLOW INTO HERE FFLAG, 0 /-1 IF OP NOT 0 INTAC1, 0 TEMPX, 0 TEMPX1, 0 FILEN, 0 BLOCK, 0 WASTE, 0 ENTRIES, 0 FOUND, 0 MCOM, 0 EXTEN, 0 XGETNAM, 0 /FUDGE TO GET FILE NAME CDF /IN SOME CASES TAD I [CHAR /CHAR IS DESTROYED!!! CDF SWAP DCA OCHAR JMP I [XGTNM1 /CALL THE REAL ROUTINE PAGE OFPNT, 0 /ENTRY POINT C7600, 7600 RDF TAD DIS+1 /OPERANDS IN CALLING FIELD DCA FLOOP+2 JMP .+3 FLOOP, JMS I [FNORM /NORMALIZE RESULT ISZ OFPNT /GET NEXT CIF CDF TAD I OFPNT /GET OPERATION SNA JMP I OFPNT /0000 => EXIT CIF SWAP RTL RTL AND [7 DCA FGOTO /SAVE OP TAD I OFPNT AND [200 SNA CLA JMP FPNT1 /PAGE ZERO MODE TAD OFPNT AND C7600 /GET PAGE FPNT1, DCA FADDR TAD I OFPNT AND [177 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 [377 DCA OPEXP /SET EXP TAD I FADDR AND [7 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 OFPNT JMP FLOOP+2 FPCMP, TAD I OFPNT RTL RTL SZL SPA CLA JMP FPNT4 /FLOATING COMPARE TAD I OFPNT TAD .-1 /TAD (1600 DCA .+2 /SET SKIP WORD JMS HIGHWD /GET WORD HLT /SKIP IF FALSE ISZ OFPNT /TRUE => SKIP JMP FLOOP FPPUT, JMS HIGHWD DCA I FXR2 /SET WORD 1 TAD AC2 DCA I FXR2 /SET WORD 2 TAD AC3 DCA I FXR2 /SET WORD 3 JMP FLOOP+1 FPGET, TAD OPSIGN DCA ACSIGN /TRANSFER INTO FLAC TAD OPEXP DCA ACEXP TAD OP1 DCA AC1 TAD OP2 DCA AC2 TAD OP3 DCA AC3 JMP FLOOP+1 HIGHWD, 0 TAD ACEXP CLL RAL SMA CLL RTL SPA SZL ERR040, OERROR /OVERFLOW TAD ACSIGN TAD AC1 /FORM WORD JMP I HIGHWD FPNT4, L4000 TAD OPSIGN DCA OPSIGN JMS I [OCTADD TAD AC1 SNA TAD AC2 SZA CLA JMP FLOOP /NOT ZERO TAD AC3 AND [7774 SZA CLA JMP FLOOP /NOT ZERO JMP I [MULCLR /CALL IT ZERO PAGE AR1, 0 TAD AC1 CLL RAR DCA AC1 TAD AC2 RAR DCA AC2 TAD AC3 RAR DCA AC3 RAR DCA OVER JMP I AR1 ACN, 0 TAD (OP3 DCA OADD L7775 DCA AR1 CDF SWAP /MAKE SURE TAD I OADD CMA SZL CLL IAC DCA I OADD ISZ OADD ISZ AR1 JMP .-7 JMP I ACN OADD, 0 CLL TAD AC3 TAD OP3 DCA AC3 RAL TAD AC2 TAD OP2 DCA AC2 RAL TAD AC1 TAD OP1 DCA AC1 JMP I OADD FPSUB, L4000 TAD OPSIGN DCA OPSIGN FPADD, JMS OCTADD JMP I [FLOOP OCTADD, 0 ISZ FFLAG JMP I OCTADD TAD ACEXP 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 ACEXP SKP JMS AR1 ISZ OADD JMP .-2 SETSGN, TAD ACSIGN TAD OPSIGN SPA CLA JMS ACN JMS OADD TAD AC1 SMA CLA JMP I OCTADD L7775 JMS ACN TAD OPSIGN DCA ACSIGN JMP I OCTADD FPMUL, ISZ FFLAG JMP MULCLR TAD ACSIGN TAD OPSIGN DCA ACSIGN TAD ACEXP TAD OPEXP TAD (-201 DCA ACEXP TAD AC1 DCA OPSIGN TAD AC2 DCA OPEXP TAD AC3 DCA TEMPX TAD (-33 DCA OCNTR MPYLUP, JMS AR1 TAD OPSIGN RAR DCA OPSIGN TAD OPEXP RAR DCA OPEXP TAD TEMPX RAR DCA TEMPX SZL JMS OADD ISZ OCNTR JMP MPYLUP JMP I [FLOOP MULCLR, DCA AC1 JMS I (NFIX JMP I [FLOOP PAGE FNORM, 0 DCA OVER TAD AC1 TAD KM10 SPA CLA JMP NOTBIG JMS I [AR1 ISZ ACEXP JMP FNORM+2 NOTBIG, TAD OVER SMA CLA JMP NOBUMP ISZ AC3 JMP NOBUMP ISZ AC2 JMP NOBUMP ISZ AC1 JMP FNORM+1 L7777 NOBUMP, TAD ACEXP SPA JMP UNDERF /UNDERFLOW OR ZERO DCA ACEXP L7775 TAD AC1 SMA SZA CLA JMP I FNORM JMS AL1 JMP NOBUMP-1 KM10=. UNDERF, SPA SNA SZL CLA TAD AC1 SNA TAD AC2 SNA TAD AC3 SZA CLA ERR050, OERROR /UNDERFLOW JMS NFIX JMP I FNORM AL1, 0 TAD AC3 CLL RAL DCA AC3 TAD AC2 RAL DCA AC2 TAD AC1 RAL DCA AC1 JMP I AL1 FPDIV, ISZ FFLAG ERR030, OERROR TAD ACSIGN TAD OPSIGN DCA ACSIGN TAD OPEXP CIA TAD ACEXP TAD [177 DCA ACEXP DCA OCNTR TAD (-35 DCA FNORM DIVLP, L4000 AND OP1 TAD AC1 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 AC1 TAD OPEXP DCA AC2 TAD OCNTR DCA AC3 JMP I [FLOOP NFIX, 0 TAD AC1 SNA CLA JMP ZFIXEX FIXLUP, TAD ACEXP TAD (-233 SMA CLA JMP FIXEXT JMS I [AR1 ISZ ACEXP JMP FIXLUP ZFIXEX, DCA ACEXP DCA ACSIGN DCA AC1 DCA AC2 DCA AC3 FIXEXT, TAD AC3 JMP I NFIX MULT10, 0 JMS AL1 TAD AC3 DCA OP3 TAD AC2 DCA OP2 TAD AC1 DCA OP1 JMS AL1 JMS AL1 JMS I (OADD JMP I MULT10 FIXCON, 1544 1433 6750 LIST7, 12^40+22 LIST70 -"O+337^100-"N+337 PAGE OFLIN, 0 TAD [-11 DCA DNUMBR JMS DECONV TAD OCHAR TAD [-".+200 SZA CLA JMP FIGO1 OGETC TAD DNUMBR DCA FXR1 JMS DECON TAD DNUMBR CIA TAD FXR1 FIGO1, DCA FXR1 TAD C233 DCA ACEXP FINT FNOR FPUT I [OTEMP FEXT TAD DNUMBR TAD [11 SNA CLA ERR150, OERROR TAD OCHAR TAD [-"E+200 SZA CLA JMP FIGO2 OGETC L7775 DCA DNUMBR JMS DECONV L0002 TAD DNUMBR SPA CLA JMP .-14 TAD ACSIGN CLL RAL TAD AC3 SZL CIA TAD FXR1 DCA FXR1 FIGO2, FINT FGET I [OTEMP FEXT TAD FXR1 SNA JMP FLINGO SPA CLA JMP FIGO4 TAD FXR1 CIA DCA FXR1 TAD M1000 FIGO4, TAD [FDIV I [TEN DCA .+2 FIGO3, FINT HLT FEXT ISZ FXR1 JMP FIGO3 FLINGO, CIF CDF JMP I OFLIN DNUMBR, 0 DECONV, 0 DCA AC3 DCA AC2 DCA AC1 DCA ACSIGN TAD OCHAR TAD [-"++200 SNA JMP .+6 CLL RTR SZA CLA JMP .+4 L4000 DCA ACSIGN OGETC JMS DECON JMP I DECONV DECON, 0 OTESTN M1000, NOP JMP I DECON JMS I [MULT10 DCA OP1 DCA OP2 TAD OCHAR TAD [-60 DCA OP3 JMS I [OADD OGETC ISZ DNUMBR JMP DECON+1 ERR160, OERROR OGETLN, 0 OTESTN C233, 233 ERR370, OERROR TAD [-6 DCA DNUMBR JMS DECONV TAD AC2 SZA CLA JMP OGETLN+3 TAD AC3 SPA SNA JMP OGETLN+3 CDF DCA I [LINENO TAD I [LINENO IAC SPA CLA JMP OGETLN+3 CIF CDF JMP I OGETLN OPRINC, 0 CIF CDF JMS I (XPRT1 JMP I OPRINC XGETL2, XGET5-1 /CR XGET4-1 /BELL XGET3-1 /SPACE PAGE OFLOUT, 0 TAD ACSIGN SPA CLA TAD (55-40 TAD [40 OPRINTC TAD AC1 SZA CLA JMP FOGO1 TAD (60 OPRINTC JMP FLOXIT FOGO1, JMS I (FIXUP TAD (-7 DCA OCNTR TAD (NUMBUF-1 DCA FXR1 JMP .+5 FOGO2, TAD AC1 AND [177 DCA AC1 JMS I (MULT10 TAD AC1 CLL RTL RTL RTL AND (17 TAD (60 DCA I FXR1 ISZ OCNTR JMP FOGO2 TAD (NUMBUF-1 DCA FXR1 L0002 TAD I (DECEXP SNA JMP FOGO4 SPA JMP FOGO3 TAD (-10 SPA CLA JMP FOGO5 FOGO3, CLA TAD I FXR1 OPRINTC TAD (".-200 OPRINTC TAD [-6 DCA OCNTR TAD I FXR1 OPRINTC ISZ OCNTR JMP .-3 TAD ("E-200 OPRINTC TAD I (DECEXP SPA CLA L0002 TAD ("+-200 OPRINTC TAD I (DECEXP SPA CIA ISZ OFLOUT FLOXIT, CIF CDF JMP I OFLOUT FOGO4, TAD (".-200 OPRINTC TAD (60 OPRINTC FOGO5, TAD (-7 DCA OCNTR TAD (NUMBUF+6 FOGO6, DCA TEMPX TAD I TEMPX TAD [-60 SZA CLA JMP FOGO7 ISZ OCNTR L7777 TAD TEMPX JMP FOGO6 FOGO7, TAD I (DECEXP TAD OCNTR SPA CLA JMP .+4 TAD I (DECEXP CMA DCA OCNTR L7776 FOGO8, CMA TAD I (DECEXP SZA JMP .+3 TAD (".-200 OPRINTC DCA I (DECEXP TAD I FXR1 OPRINTC ISZ OCNTR JMP FOGO8 JMP FLOXIT TEN, 2045 0 0 MODL2, MODF5-1 /CR MODF2-1 /BELL MODF4-1 /RUBOUT MODF4-1 /_ MODF1 /CHAR MODF1-1 /FORM MODF3-1 /LINE FEED LIST70, 13^40+34 LIST71 337-"S^100-"T+337 337-"O^100-"P+337 PAGE FIXUP, 0 TAD ACEXP TAD .+2 DCA ACEXP CLA SKP /THIS IS 7610 OR -170 FIXUP4, TAD DECEXP DCA DECEXP FIXUP1, TAD AC1 RTL SZL CLA JMP FIXUP2 JMS I (AL1 L7777 TAD ACEXP DCA ACEXP JMP FIXUP1 FIXUP2, TAD ACEXP SMA SZA JMP FIXUP3 CLA JMS I [AR1 JMS I [AR1 JMS I [AR1 JMS I [AR1 JMS I (MULT10 TAD ACEXP TAD FIXC4 DCA ACEXP L7777 JMP FIXUP4 FIXUP3, TAD (-5 SPA JMP FIXUP5 FIXUP7, CLL CLA TAD (-40 DCA OCNTR FIXUP8, TAD AC1 TAD (5400 SMA DCA AC1 CLA TAD AC3 RAL DCA AC3 TAD AC2 RAL DCA AC2 TAD AC1 RAL DCA AC1 ISZ OCNTR JMP FIXUP8 TAD AC1 AND (377 DCA AC1 L0001 JMP FIXUP4 FIXUP5, DCA OCNTR SKP JMS I [AR1 ISZ OCNTR JMP .-2 TAD AC1 TAD (5400 SMA CLA JMP FIXUP7 CLL TAD (2166 TAD AC3 DCA AC3 SZL ISZ AC2 SKP ISZ AC1 TAD AC1 TAD (5400 SZA CLA JMP I FIXUP TAD [200 DCA AC1 DCA AC3 ISZ DECEXP FIXC4, 4 JMP I FIXUP DECEXP, 0 NUMBUF, ZBLOCK 7 FATNC=NUMBUF OTEMP=NUMBUF+3 FIX2, 0 FINT FSLE FADD I (FIXCON FSGE FSUB I (FIXCON FEXT JMS I (NFIX CLL RAR TAD ACSIGN RAL SZL CIA DCA FIXUP CLL TAD AC1 SNA TAD AC2 SZA CLA CLL CML TAD FIXUP JMP I FIX2 LIST75, 17^40+35 LIST76 337-"G^100-"O+337 337-"S^100-"U+337 337-"B^100 PAGE OSQR, FINT FPUT FSINZ FSNE FJMP SQEXIT FEXT TAD ACSIGN SPA CLA ERR020, OERROR TAD ACEXP TAD (7600 CLL SPA CML RAR TAD [200 DCA ACEXP TAD (-10 DCA SQCNT SQLOOP, FINT FPUT FSINZZ FGET FSINZ FDIV FSINZZ FADD FSINZZ FEXT L7777 TAD ACEXP DCA ACEXP ISZ SQCNT JMP SQLOOP SQEXIT, FEXT OPOPJ SQCNT, 0 OTAN, FINT FPUT I (OTEMP FEXT OPUSHJ COS FINT FPUT I (FATNC FGET I (OTEMP FEXT OPUSHJ FSIN FINT FDIV I (FATNC FEXT OPOPJ OCOS, FINT FADD FSINC7 FSKP OFSIN, FINT FDIV FSINC1 FPUT FSINZ FEXT OPUSHJ FFIX L4000 TAD ACSIGN DCA ACSIGN FINT FADD FSINZ FEXT ISZ ACEXP ISZ ACEXP FINT FSINXX, FPUT FSINZ FEXT DCA ACSIGN FINT FSUB I (OFLTONE FSGT FJMP FSINOK FGET FSINZ FEXT OPUSHJ 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 OPOPJ 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 OFLTONE, 2014 OFLZERO, 0 0 0 PAGE OFEXP, FINT FDIV FEXPC1 FPUT I (FEXPU FEXT OPUSHJ INT L4000 TAD ACSIGN DCA ACSIGN FINT FPUT FEXPI FADD I (FEXPU FPUT I (FEXPF FMUL I (FEXPF FADD FEXPC2 FPUT I (FEXPU FGET FEXPI FEXT JMS I (FIX2 CIA IAC DCA FEXPI 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 FEXPI DCA ACEXP FINT FNOR FEXT OPOPJ FEXPI, 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;0;0 OLOG, JMS I PHIGHWD SPA SNA CLA ERR010, OERROR 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 FADD I (FLZERO FEXT OPOPJ 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 FIX1, 0 /FIELD 0 'INTEGER' JMS I PFIX2 CIF CDF JMP I FIX1 MODL1, MODF5-1 /CR MODF1+5 /BELL PHIGHWD,HIGHWD /RUBOUT PFIX2, FIX2 /_ MODF4-1 /CHAR PAGE ATNSGN, 0 OATN, 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 (OFLTONE FDIV I (FATNT FPUT I (FATNT ATNLOW, FGET I (OFLZERO 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 (OFLTONE FMUL I (FATNT FADD I (FATNC FPUT I (FATNT FGET I (FATNAX FSUB I (OFLTONE FSGT FJMP ATNBIG FGET I (FSINC7 FSUB I (FATNT FPUT I (FATNT ATNBIG, FGET I (FATNT FEXT TAD ATNSGN DCA ACSIGN OPOPJ FATNAX=FSINZ FATNT=FSINZZ FATNTT=FEXPI 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 XCCR, 15 7 177 137 0 14 12 OINT, TAD ACSIGN SMA CLA JMP OFFIX FINT FPUT I (OTEMP FEXT OPUSHJ FFIX FINT FCMP I (OTEMP FSNE FJMP .+4 FGET I (OTEMP FSUB I (OFLTONE FJMP .+2 FGET I (OTEMP FEXT OFFIX, JMS I (FIX2 FINT FNOR FEXT OPOPJX, CIF CDF JMP I (XPOPJ PAGE IF4, 2 /< 6 /> 12 /= 5 /<= 11 />= 4 /<> ORND, JMS I (AL1 /FLAC=FLAC*2 JMS I (OADD /FLAC=FLAC+FLAC*2=FLAC*3 CDF TAD I (FRNDX+2 /MULT BY 2^17 MOD 2^27 CLL RTL RTL RTL DCA I (FRNDX TAD I (FRNDX RAR TAD AC2 AND (7740 DCA I (FRNDX+1 RAL TAD AC1 TAD I (FRNDX DCA I (FRNDX TAD AC3 DCA I (FRNDX+2 TAD (200 DCA ACEXP DCA ACSIGN TAD I (FRNDX AND (7 DCA AC1 TAD I (FRNDX+1 DCA AC2 OPOPJ OTESTX, 0 TAD OTESTX CIF CDF DCA I (OTEST2 JMP I (OTEST2+1 OPUSHX, 0 TAD I OPUSHX CIF CDF DCA I (T3 TAD OPUSHX IAC JMP I (OPUSJ1 OGETCX, 0 CIF CDF JMS I (GETCX1 JMP I OGETCX OERRX, 0 CLA CIF CDF TAD OERRX DCA I (XERROR JMP I (XERROR+1 XPAKL2, XPACK2-1 /CR XPACK3-1 /BELL XPACK7-1 /RUBOUT XPACK7-1 / XPACK5-1 /@ XXPAK-1 /SPACE (KLUDGE!!) LIST15, 52^40+34 LIST16 -"S+337^100-"A+337 -"V+337^100-"E+337 LIST16, 53^40+36 LIST17 -"U+337^100-"N+337 -"S+337^100-"A+337 -"V+337^100-"E+337 LIST17, 54^40+37 LIST18 -"C+337^100-"A+337 -"T+337^100-"A+337 -"L+337^100-"O+337 -"G+337^100 LIST18, 7^40+35 LIST19 -"C+337^100-"H+337 -"A+337^100-"I+337 -"N+337^100 LIST19, 3^40+36 LIST20 -"R+337^100-"A+337 -"N+337^100-"D+337 -"O+337^100-"M+337 LIST20, 6^40+34 LIST21 -"O+337^100-"P+337 -"E+337^100-"N+337 LIST21, 4^40+36 LIST22 -"O+337^100-"U+337 -"T+337^100-"P+337 -"U+337^100-"T+337 LIST22, 5^40+35 LIST23 -"C+337^100-"L+337 -"O+337^100-"S+337 -"E+337^100 LIST23, 55^40+36 LIST24 -"R+337^100-"E+337 -"N+337^100-"A+337 -"M+337^100-"E+337 LIST71, 11^40+33 LIST72 337-"E^100-"N+337 337-"D^100 PAGE XENTER, 0 /OS/8 DIRECTORY 'ENTER' DCA TEMPX1 /BLOCKS NEEDED GETCAT TAD TEMPX1 /ENTER OR CLOSE? SNA CLA JMP ENTXIT DCA FOUND MLOOP, TAD I XR1 SNA CLA JMP MEMPTY TAD [3 BUMPXR MLOOP2, TAD I XR1 CIA TAD BLOCK DCA BLOCK ISZ ENTRIES JMP MLOOP TAD FOUND SNA CLA JMP ENTXIT+1 TAD TEMPX DCA BLOCK TAD XR1 DCA TEMPX TAD [4 BUMPXR TAD XR1 TAD [-DIRBUF-370 SMA CLA JMP ENTXIT+1 ISZ XENTER MLOOP3, TAD I TEMPX /BUMP UP CATALOG TO MAKE ROOM DCA I XR1 CLA CLL CMA RAL TAD XR1 DCA XR1 CLA CMA TAD TEMPX DCA TEMPX TAD TEMPX CLL CML CIA TAD FOUND SZL SNA CLA JMP MLOOP3 TAD FOUND DCA XR1 TAD NAMEX DCA I XR1 TAD NAMEX+1 DCA I XR1 TAD NAMEX+2 DCA I XR1 TAD EXTEN /".EX" EXTENSION DCA I XR1 DCA I XR1 CLA CMA BUMPXR DCA I XR1 /0 LENGTH TAD XR1 DCA FOUND CLA CMA TAD I [DIRBUF /# OF ENTRIES DCA I [DIRBUF TAD BLOCK /CLOSE CHANGES IT DCA BLKHLD TAD TEMPX1 ENTXIT, CLOSE TAD BLKHLD /RESTORE BLOCK DCA BLOCK CIF CDF JMP I XENTER MEMPTY, TAD FOUND /FIRST FIT - NOT BEST FIT SZA CLA JMP MLOOP2 TAD I XR1 CIA DCA TEMPX TAD TEMPX1 CLL CIA TAD TEMPX SNL CLA JMP MNOCHG CLA CLL CMA RAL TAD XR1 DCA FOUND TAD BLOCK DCA TEMPX MNOCHG, TAD TEMPX JMP MLOOP2+2 XSETPT, 0 TAD I [DIRBUF DCA ENTRIES TAD I [DIRBUF+1 DCA BLOCK TAD I [DIRBUF+4 CIA DCA WASTE TAD [DIRBUF+4 DCA XR1 JMP I XSETPT XGETCAT, 0 CLA CLL IAC /READ DECTAPE DIRBUF 7400 2 SETPT JMP I XGETCAT BLKHLD=. FLOOK, 0 /GET CATALOG AND LOOKUP GETCAT DIRSCH ERROX CIF CDF JMP I FLOOK /THAT WAS EASY LIST82, 24^40+22 LIST83 337-"I^100-"F+337 LIST25, 57^40+37 LIST26 -"F+337^100-"I+337 -"L+337^100-"E+337 -"L+337^100-"O+337 -"G+337^100 LIST26, 60^40+34 LIST14 -"C+337^100-"H+337 -"R+337^100-"$+337 PAGE XDIRSCH, 0 SETPT SCHLP, TAD I XR1 SNA CLA JMP SKPMTF CLA CMA TAD XR1 DCA XR1 CLA CLL CMA RTL DCA XBUMPXR TAD [NAMEX-1 DCA XR3 SRCWDL, TAD I XR3 CIA TAD I XR1 SZA CLA JMP NXTFIL ISZ XBUMPXR JMP SRCWDL TAD EXTEN CIA TAD I XR1 SZA CLA JMP NXTFIL BUMPXR TAD I XR1 SNA JMP SKPMTF+4 DCA FILEN ISZ XDIRSCH JMP I XDIRSCH NXTFIL, TAD XBUMPXR CIA BUMPXR SKPMTF, TAD I XR1 CIA TAD BLOCK DCA BLOCK ISZ ENTRIES JMP SCHLP JMP I XDIRSCH XBUMPXR, 0 TAD WASTE TAD XR1 DCA XR1 JMP I XBUMPXR XGTNM1, DCA NAMEX DCA NAMEX+1 DCA NAMEX+2 DCA TEMPX SKP NLOOP, OGETC CIF CDF JMS I [TSTCH1 JMP NDONE TAD TEMPX TAD [-6 SMA CLA JMP NLOOP TAD TEMPX CLL RAR TAD [NAMEX DCA WASTE TAD OCHAR AND [77 SZL JMP .+4 CLL RTL RTL RTL TAD I WASTE DCA I WASTE ISZ TEMPX JMP NLOOP NDONE, TAD OCHAR TAD [-15 SZA CLA ERROX TAD TEMPX SNA CLA ERROX CIF CDF JMP I XGETNAM CAT1, 0 TAD I XR1 SNA JMP DEMPTY DCA NAMEX TAD I XR1 DCA NAMEX+1 TAD I XR1 DCA NAMEX+2 TAD EXTEN CIA TAD I XR1 SZA CLA /DON'T FORGET TO CLEAR AC!!! JMP DEMPTY-1 BUMPXR TAD I XR1 SNA CLA JMP DEMPTY+1 TAD NAMEX JMS I (TWOPRT TAD NAMEX+1 JMS I (TWOPRT TAD NAMEX+2 JMS I (TWOPRT TAD [15 OPRINTC JMP DEMPTY+1 BUMPXR DEMPTY, ISZ XR1 ISZ ENTRIES SKP ISZ CAT1 CIF CDF JMP I CAT1 QLIS2, QCOMCK-1 /, QNEXTC-1 /' QUOCHK-1 /" QDONE-1 /CR QLIS1, QNEXTC-1 /\ , QNEXTC-1 /' QNEXTC-1 /" QDONE-1 /CR QNEXTC-1 /\ PAGE DTAPE, 0 /ENTER WITH AC=1 FOR READ TAD [DR128 DCA DRET /READ/WRITE RETURN AFTER SEARCH TAD [CIF CDF /SAVE CALLING FIELD RDF DCA DXIT DGR, CLA CMA JMS DGET DCA DCORE /FIRST CORE LOCATION-1 OF TRANSFER JMS DGET DCA DWDS / -NUMBER OF WORDS TO BE TRANSFERRED JMS DGET /GET BLOCK NO. DCA DTEM /AND STORE /INITIATE SEARCH DTS1, TAD [DTBLOK /DTBLOK TO 7755 (CA) CDF DCA I DCAA TAD [DINT-1 DCA MCOM /INTERRUPT RETURN TAD I [ERLINE /IF WE'RE RUNNING, WE SNA CLA /SHOULD USE UNIT 1 (FILES), JMP UNIT0 /EXCEPT FOR THE SPECIAL CASE TAD I [CHAINP /OF CHAIN, WHICH USES UNIT 0 (PROGRAMS) TAD PMCHAIN1 /CHECK IF CHAIN SZA CLA UNIT1, TAD [1000 /USE UNIT1 UNIT0, TAD [614 /SET TO SEARCH,NORMAL,REVERSE DTLA /LOAD STATUS A TAD [10 DTLB /FIELD 1 CIF CDF TAD I [LOOK /SET BUSY FLAG DCA TEMPX TAD I TEMPX /GET STATUS TAD [1000 DCA I TEMPX TAD [DXIT /FAKE RETURN ADDRESS JMP I [RUN9X /AND DISMISS DXIT, HLT /RETURN TO PROPER FIELD JMP I DTAPE DTEM, DGET, 0 /PICK UP ARGUMENTS TAD I DTAPE ISZ DTAPE JMP I DGET DR128, TAD [20 /WRITE (NOT READ),(40-20) TAD [30 /READ NORMAL, CANCEL SEARCH (20+10) DTXA /SET FUNCTION TAD DCORE /1ST CORE LOC.-1 OF TRANSFER CDF DCA I DCAA /TO 7755(CA) ISZ MCOM /POINT INTERRUPT RETURN TO DATA DGO, CLA CLL TAD DWDS / -NUMBER OF WORDS TO READ TAD [200 /FULL PAGE READ? SNL CLA /YES, SET WC TO -128 SNL /SKIP OVER IF CRAP IN AC DR127, DTXA /SEND READ OR WRITE TAD D7600 /SET WORD COUNT FOR 1 PAGE CDF DCA I DWC /-128 TO 7754 (WC) DTXA /IN CASE WE MISSED IT BEFORE JMP DIS /EXIT JMP DTS3A DINT, DTRB /READ STATUS B SPA CLA JMP DER /ERROR FLAG CLA CLL TAD DWDS /BUMP COUNT AND CHECK FOR MORE TAD [200 /128 WORD PAGE DCA DWDS /SAVE FOR NEXT TIME SNL JMP DGO /GET NEXT PAGE TAD [600 /COMPLEMENT MOTION AND DIRECTION DTXA CDF TAD I [DTQ1 /GET POINTER TO QUEUE DCA TEMPX TAD I TEMPX /GET USER # TAD [USER0-1 /BUILD POINTER TO STATUS DCA TEMPX TAD I TEMPX AND [6777 /CLEAR BUSY DCA I TEMPX JMP DIS /FINISH INTERRUPT PMCHAIN1, -CHAIN1 DCAA, 7755 /POINTER TO CURRENT ADDRESS DWC, 7754 /POINTER TO WORD COUNT DWDS, 0 / -WORDS TO TRANSFER DTBLOK, 0 /BLOCK NUMBER DEPOSITED HERE BY CONTROL DCORE, 0 /STARTING ADDRESS-1 DRET, 0 /DR128 IF WRITE, OR DR128+1 IF READ DTS3A, DTRB /READ STATUS B RTL /LOOK AT BIT 2 SPA CLA /END ZONE? JMP DTURNX /YES (MOTION BIT=0), TURN DTRB SPA CLA JMP DER /ERROR FLAG BIT 0=1 DTRA D7000, RTL RTL /FOR-REV STATUS (BIT 3) IN LINK D7600, 7600 /GROUP 2 CLA TAD DTBLOK CIA TAD DTEM /LINK COMP. IF REQUIRED BLK NO. SNA /IS BIGGER I.E. MUST GO FORWARD JMP DTFIND /FOUND BLOCK CHECK DIRECTION CIA SNL IAC /GO 2 MORE BLOCKS BEFORE TURNING SNL CLA DTURN, TAD [400 /TURN IF HERE JMP DR127 /XOR TO A STATUS AND DISMIS DTFIND, SNL CLA /TEST DIRECTION JMP DR127 /DONT TURN YET, STILL IN REVERSE JMP I DRET /GO DO READ OR WRITE DTURNX, TAD [600 /REVERSE OUT OF END ZONE JMP DR127 DER, DTRA /ERROR ROUTINE, READ STATUS A AND [200 /STOP TAPE IF RUNNING, I.E. SET BIT 4 TO 0 TAD [2 /DON'T CLEAR ERRORS (BIT 10=1) DTXA DTRB /ERROR STATUS B HLT LIST72, 14^40+37 LIST73 -"R+337^100-"E+337 -"S+337^100-"T+337 -"O+337^100-"R+337 -"E+337^100 XCLOSE, 0 /OS/8 'CLOSE' DCA TEMPX /LENGTH (0 FOR DELETE) DIRSCH /FIND THE NAME JMP NODLET /NOT THERE TAD I [DIRBUF+4 TAD XR1 TAD [-5 DCA XR3 CLA CLL CML RTL TAD WASTE CMA JMS SQUISH DCA I XR3 /MAKE AN EMPTY TAD FILEN DCA I XR3 TAD FOUND /MOVE POINTER TO TEMPORARY FILE CLL CIA /(IF NECESSARY) TAD XR3 SZL CLA JMP NODLET CLA CLL CMA RTL TAD I [DIRBUF+4 TAD FOUND DCA FOUND NODLET, TAD TEMPX /CLOSE FILE? SNA CLA JMP CONSOL TAD TEMPX CIA DCA I FOUND ISZ FOUND ISZ FOUND TAD TEMPX TAD I FOUND DCA I FOUND CONSOL, SETPT CONLP, TAD I XR1 SNA CLA JMP CONMTF TAD [3 BUMPXR TAD I XR1 SZA CLA JMP CONLPT TAD I [DIRBUF+4 TAD [-5 SQCOMN, JMS SQUISH ISZ I [DIRBUF JMP CONSOL CONMTF, TAD I XR1 SNA JMP SQTRIV DCA TEMPX TAD XR1 DCA TEMPX1 ISZ ENTRIES SKP JMP EOCLOS TAD I XR1 SZA CLA JMP CONLP+3 TAD I XR1 TAD TEMPX DCA I TEMPX1 SQTRIV, CLA CLL CMA RAL JMP SQCOMN CONLPT, ISZ ENTRIES JMP CONLP ALT, 175 176 33 EOCLOS, DECTAPE DIRBUF -400 2 JMP I XCLOSE SQUISH, 0 TAD XR1 DCA XR2 TAD I XR1 DCA I XR2 TAD XR1 TAD [-DIRBUF-377 SZA CLA JMP .-5 JMP I SQUISH CAT0, 0 GETCAT CIF CDF JMP I CAT0 TWOPRT, 0 DCA NAMEX TAD NAMEX CLL RTR RTR RTR JMS ONEPRT TAD NAMEX JMS ONEPRT JMP I TWOPRT ONEPRT, 0 AND [77 SNA JMP I TWOPRT TAD [-40 SPA TAD [100 TAD [40 OPRINTC JMP I ONEPRT DTCHKX, 0 /CHECK IF USER ALREADY HAS TAPE IOF TAD I [DECK IAC DCA XR3 TAD I [DTQ1 DCA OP3 TAD I OP3 CIA TAD XR3 CIF SNA CLA JMP I [XDTG1 TAD XR3 JMP I DTCHKX PAGE 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 657 /MO 605 /LE 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 -"D+200 /MOD -"N+200 /LEN TERMS, 40 /SPACE 0 53 /+ 1 55 /- 2 52 /* 3 57 // 4 136 /^ 5 50 /( 6 133 /[ 7 51 /) 10 135 /] 11 74 /< 1 76 /> 13 75 /= 14 FUNL3, FSIN COS ATN FEXP LOG ABS SQR SGN INT RND FFIX TAN MID CAT MOD LEN PRNTL6, PRINT8-1 /; PRINT5-1 /, 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-4 /\ MUST BE PRINTABLE LIST24, 56^40+34 LIST25 -"K+337^100-"I+337 -"L+337^100-"L+337 UNKWN+1 /ENTER NEW COMMAND HERE RANDOM UNKWN+1 /OUTPUT FUDGE CLOSE0 OPEN CHAIN LINPUT END ON READY /STOP RESTOR READ RETURN GOSUB FOR XPOPJ /DEF XPOPJ /DIM AND REM GOTO IF INPUT PRINT0 XPOPJ /DATA LET NEXT COMGOL, UNKWN 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 ERR650 ERR320 ERR330 ERR340 ERR350 ERR640 ERR370 ERR380 ERR390 ERR400 ERR410 ERR420 ERR430 ERR440 ERR450 ERR460 ERR470 ERR490 ERR500 ERR510 ERR520 ERR530 ERR540 ERR550 ERR560 ERR600 ERR610 ERR620 ERR630 ERREND=. LIST77, 21^40+33 LIST78 -"D+337^100-"E+337 -"F+337^100 LIST78, 22^40+33 LIST79 -"D+337^100-"I+337 -"M+337^100 LIST79, 22^40+33 LIST80 -"R+337^100-"E+337 -"M+337^100 LIST80, 10^40+36 LIST81 -"L+337^100-"I+337 -"N+337^100-"P+337 -"U+337^100-"T+337 LIST81, 23^40+34 LIST82 -"G+337^100-"O+337 -"T+337^100-"O+337 LIST83, 25^40+35 LIST84 -"I+337^100-"N+337 -"P+337^100-"U+337 -"T+337^100 LIST84, 26^40+35 LIST85 -"P+337^100-"R+337 -"I+337^100-"N+337 -"T+337^100 LIST85, 27^40+34 LIST86 -"D+337^100-"A+337 -"T+337^100-"A+337 LIST86, 30^40+33 LIST87 -"L+337^100-"E+337 -"T+337^100 LIST87, 31^40+34 LIST88 -"N+337^100-"E+337 -"X+337^100-"T+337 LIST88, 33^40+33 LIST89 -"T+337^100-"A+337 -"B+337^100 LIST89, 34^40+34 LIST90 -"S+337^100-"T+337 -"E+337^100-"P+337 LIST90, 35^40+34 LIST91 -"T+337^100-"H+337 -"E+337^100-"N+337 LIST91, 36^40+22 LIST92 -"T+337^100-"O+337 LIST92, 37^40+22 LIST93 -"F+337^100-"N+337 LIST93, 40^40+34 LIST94 -"L+337^100-"I+337 -"S+337^100-"T+337 LIST94, 42^40+33 LIST95 -"B+337^100-"Y+337 -"E+337^100 LIST95, 50^40+33 LIST96 -"N+337^100-"E+337 -"W+337^100 LIST96, 42^40+37 LIST97 -"S+337^100-"C+337 -"R+337^100-"A+337 -"T+337^100-"C+337 -"H+337^100 LIST97, 43^40+36 LIST98 -"D+337^100-"E+337 -"L+337^100-"E+337 -"T+337^100-"E+337 LIST98, 44^40+34 LIST99 -"E+337^100-"D+337 -"I+337^100-"T+337 LIST99, 45^40+33 LIST10 -"K+337^100-"E+337 -"Y+337^100 LIST10, 46^40+34 LIST11 -"T+337^100-"A+337 -"P+337^100-"E+337 LIST11, 47^40+33 LIST12 -"R+337^100-"U+337 -"N+337^100 LIST12, 22^40+11 LIST13 -"'+337^100 LIST13, 41^40+11 LIST15 -"_+337^100 DIRBUF, ZBLOCK 400 INTR8A=.-1 INTR8I=.-2 INTR80=.-3 /4 POWER FAIL/AUTO RECOVER TEMPS INTR8F=.-4 LIST14, 51^40+33 A0000, 0 -"O+337^100-"L+337 -"D+337^100 INTRRV, CAF /RECOVER - CLEAR ALL AAACDF, CIF CDF INTRV2, TAD I PAUSER MTON JMS I PINTRPL CLA TAD PINTR8 DCA I [2 TAD INTR8F AND [7 CLL RTL RAL TAD AAACDF DCA INTR88 TAD INTR8F AND [70 TAD CCIF DCA INTR89 TAD INTR8F RAL CLA INTR88, CDF INTR89, CIF TAD INTR8A /AND AC ION JMP I INTR80 /AND EXIT PINTRPL, INTRPL-1 PAUSER, AUSER CCIF2, CIF SWAP PINTR8, INTR8E PINTRRV, INTRRV 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 TAD CCIF2 DCA I A0000 /SET "CIF SWAP" TAD PINTRRV DCA I [2 /AND SET ADDRESS HLT INTR82, TAD INTR8A /GET THE AC AGAIN CCIF, CIF JMP I .+1 /GO TO REAL INTERRUPT ROUTINE INTRPT LIST73, 15^40+34 LIST74 -"R+337^100-"E+337 -"A+337^100-"D+337 LIST74, 16^40+36 LIST75 -"R+337^100-"E+337 -"T+337^100-"U+337 -"R+337^100-"N+337 LIST76, 20^40+33 LIST77 -"F+337^100-"O+337 -"R+337^100 COMGO1, LIST START /CR BYE DELETE EDIT KKEY TAPE RUN NEW OLD SAVE UNSAVE CATLOG RENAME KILL DATLOG UNKWN+1 /CHR FUDGE!! ORG1=.+1 IFNZRO .-4744&4000 PAGE /USER DEFINITIONS LIMIT=7776 /HIGHEST CORE POSITION SWAPR=ENSWAP-STSWAP+1 /SWAP LENGTH ORG=. /USER STARTING ORIGIN BUFFER=40 BUFCOM=100 LINE0=162 LINE1=164 TOP=LIMIT FIELD 2 PAGE 0 CONBEG, 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 5641 /NA 5545 /ME 1515 /-- CONEND=. USRPTR, USRLST CORPTR, 0 USRPT2, 0 CORPT2, 0 BEGUSR, 0 CURFLD, 0 BEGDEV, 0 USRCTR, 0 SS, 0 BEGCOR, 0 KLTOP, 0 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 PAGE /*SYSTEM ENTRY POINTFOR INITIALIZATION* BEGIN, KCC 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 CDF 20 JMS I (BEG003 OS8ERM /BAD O/S8 DEVICE JMP I (BEGMV4 /DO NOT SET UP ANY THING OS8KSK, CLA JMP OS8DSK IAC IAC OS8DSK, IAC OS8DTA, IAC OS8RK8, IAC TAD (OS8LST-1 DCA OS8PTR CDF 20 TAD I OS8PTR DCA OS8PTR /POINT TO BOOTSTRAP OS8LP1, CDF 20 TAD I OS8PTR ISZ OS8PTR CDF DCA I OS8PT2 ISZ OS8PT2 JMP OS8LP1 CDF 20 JMS I (BEG003 OS8MSG /O/S8 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 20 TAD (600 DTXA DTCA /REWIND TAPE DTSF JMP .-1 TAD (TAPMM DCA OS8AB JMP OS8DSK-2 DISKM, CDF 10 TAD (DSKMM DCA OS8AB JMP OS8DSK-1 PAGE 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 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, CDF 20 KCC TAD (BEGIOT DCA BEG012 TAD (-4 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 (-"5 SMA SZA JMP I (BEG005 TAD (5 SPA SNA JMP I (BEG005 CIA DCA BEGUSR BEG008, JMP I (BEGX08 CORDON, CDF 20 TAD (7745 DCA 0 /RESTORE THE BLOODY TEXT! L7776 TAD BEGCOR SMA CLA JMP .+5 JMS I (BEG003 NOCOR /NOT ENOUGH CORE FOR EDU25 CIF CDF JMP I (7600 /BACK TO OS/8 MONITOR TAD BEGUSR IAC SNA CLA JMP BEG010 BEG009, JMS I (BEG003 BEGM4 /DC02? JMS I (BEG001 TAD (-"Y SNA JMP BEG010+1 TAD (331-316 SNA CLA JMP BEG010 JMS I (BEG003 BEGME JMP BEG009 BEG010, L7777 DCA BEGDEV TAD BEGDEV SNA CLA JMP I (BEGCK0 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 BEG12A, 400 BEG012, 0 BEG013, 0 BEGIN1, ERRLST BEGIN2, ERRLST-ERREND BEGMV1, MVPAG BEGMV2, 7600 BEGMV3, -156 PAGE BEG015, TAD BEGUSR IAC SNA CLA JMP I (BEGCK0 BEG15E, JMS I (BEG003 BEGM7 /STANDARD? JMS I (BEG001 TAD (-"Y SNA JMP I (BEGCK0 TAD (331-316 SNA CLA JMP BEG15A JMS I (BEG003 BEGME JMP BEG15E BEG15A, TAD BEGUSR DCA BEG15B TAD (BEGIOT DCA BEG15C TAD (4361 /TEXT "#1" DCA I (BEGM5A BEG15D, ISZ BEG15B JMP BEG014 JMP I (BEGCK0 BEG15C, 0 BEG15B, 0 BEG014, JMS I (BEG003 BEGM5 /DEVICE CODE JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RTL RTL DCA I BEG15C JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 IAC CLL RTL RAL TAD I BEG15C DCA I BEG15C ISZ BEG15C ISZ I (BEGM5A JMP BEG15D /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 PAGE BEG016, JMS BEG003 BEGME JMP I (BEG014 BEG005, JMS BEG003 BEGME JMP I (BEG006 BEG007, JMS BEG003 BEGME JMP I (BEG008 BEG001, 0 KSF JMP .-1 KRB TAD (-203 SNA JMP I (BEG002 TAD (203 TLS TSF JMP .-1 AND (177 TAD (200 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 PAGE BEGCK0, L0001 TAD BEGUSR SMA CLA JMP I (BEGOLD /ONLY ONE USER--WHY BOTHER HIM W/DUMB QUESTIONS? JMS I (BEG003 BEGMQ JMS I (BEG001 TAD (-"N SNA JMP I (BEG500 /GO ASK FOR IT TAD (-"Y+"N SNA CLA JMP I (BEGOLD /THIS WAS AN AFTERTHOUGHT, QUITE FRANKLY JMS I (BEG003 BEGME JMP BEGCK0 /ASK HIM AGIN PAGE LBLK=SS OLNUM=USRPT2 NUNUM=CORPT2 BEGER0, CDF 20 JMS I (BEG003 WNGDM BEG500, CDF 20 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 CLA TSF JMP .-1 TAD (20 /20 LOGICAL BLOCKS 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 L7776 TAD CURFLD SNA 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 /THE FOOL HAS AN 8/E WITH DC02 CDF TAD (KL8JMP+1&177+5600 DCA I BEGKL3 ISZ BEGKL3 TAD (KL8FIX DCA I BEGKL3 CDF 20 JMP BEG550 BEGKL2, KL8FIX KL8FRST, 0 BEGKL3, KL8JMP CDF 10 DCA I (INTRRV /NOT AN 8/E BEG550, CDF 20 TAD (USRLST /NOW WE SORT FOR FIELDS TO MAKE IT EASY DCA USRPTR L0003 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 I (USRLST+1 BEG610, DCA CURFLD DCA BEG602 TAD (CONEND 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 L0004 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 L0004 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 SPA 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 L0004 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 (BEG003 BEGM6A JMS I (BEG001 TAD (-"Y SZA CLA 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 20 TAD BEGCOR DCA I (BGCORS 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 20 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 IAC DCA I (AUSER CDF 20 BEG75X, TAD BEGCOR CLL RTL RAL TAD (CDF DCA BEG756 TAD BEG756 TAD (-6221 SNA CLA JMP BEG760 DCA BEG751 DCA BEG752 BEG755, CDF 20 TAD I BEG751 ISZ BEG751 NOP BEG756, CDF 30 DCA I BEG752 ISZ BEG752 JMP BEG755 L7777 TAD BEGCOR DCA BEGCOR JMP BEG75X BEG60X, 0 BEG751=USRCTR BEG752=USRPTR BEG760, TAD BEGDEV SNA CLA JMP BEG76X CDF DCA I (XOUTL6+3 DCA I (XOUTL6+4 DCA I (XOUTL6-3 DCA I (INTRP2-2 DCA I (INTRP2+4 DCA I (INTRP5 DCA I (INTRP5+1 DCA I (INTRP5+2 CDF 10 DCA I (INTRV2-2 JMP I (BEG800 BEG76X, CDF 10 TAD (TLS DCA I (AAACDF+1 DCA I (AAACDF+2 TAD (MTLS DCA I (INTRV2-1 JMP I (BEG800 PAGE USRLST, 0 PAGE BEGOLD, L7777 TAD BEGCOR /COUNT DOWN BY ONE FOR BREVITY OF LISTS 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 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 X=100 BGL22, 12^X+10 22^X+10 BGL21, 12^X+20 BGL31=BGL21 BGL41=BGL21 BGL51=BGL21 BGL61=BGL21 BGL71=BGL21 BGL23, 12^X+6 22^X+5 32^X+5 BGL24, 12^X+4 22^X+4 32^X+4 42^X+4 BGL25, 12^X+4 22^X+3 32^X+3 42^X+3 52^X+3 BGL33, 12^X+20 23^X+10 33^X+10 BGL32, 12^X+20 23^X+20 BGL42=BGL32 BGL52=BGL32 BGL62=BGL32 BGL72=BGL32 BGL34, 12^X+10 22^X+10 33^X+10 43^X+10 BGL35, 12^X+5 22^X+6 32^X+5 43^X+10 53^X+10 BGL44, 12^X+20 23^X+20 34^X+10 44^X+10 BGL43, 12^X+20 23^X+20 34^X+20 BGL53=BGL43 BGL63=BGL43 BGL73=BGL43 BGL45, 12^X+20 23^X+10 33^X+10 44^X+10 54^X+10 BGL55, 12^X+20 23^X+20 34^X+20 45^X+10 55^X+10 BGL54, 12^X+20 23^X+20 34^X+20 45^X+20 BGL64=BGL54 BGL74=BGL54 BGL56, 12^X+20 23^X+20 34^X+10 44^X+10 55^X+10 65^X+10 BGL65, 12^X+20 23^X+20 34^X+20 45^X+20 56^X+20 BGL75=BGL65 BGL77, 77^X+20 BGL76, 12^X+20 23^X+20 34^X+20 56^X+20 45^X+20 BGLD1, 0;0;0 BGL25 BGL24 BGL23 BGL22 BGL21 0;0;0 BGL35 BGL34 BGL33 BGL32 BGL31 0;0;0 BGL45 BGL44 BGL43 BGL42 BGL41 0;0;0 BGL55 BGL54 BGL53 BGL52 BGL51 0;0;0 BGL65 BGL64 BGL63 BGL62 BGL61 0;0;0 BGL75 BGL74 BGL73 BGL72 BGL71 0040 BEGIOT, 0120 0120 0120 0120 PAGE BEG800, CDF 20 TAD I BEG804 JMS BEG900 TAD (-4 JMS BEGZER TAD (READY JMS BEG900 TAD (-10 JMS BEGZER L7777 JMS BEG900 JMS BEG900 TAD I BEG805 TAD (6006-10 JMS BEG900 TAD I BEG802 JMS BEG900 TAD (-5 JMS BEGZER TAD (BUFFER TAD I BEG803 JMS BEG900 TAD (BUFFER 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 L7775 JMS BEGZER TAD (LINE1 TAD I BEG803 JMS BEG900 TAD (LINE1 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 TAD (1617 /"NO" JMS BEG900 TAD (1605 /"NE" JMS BEG900 JMS BEG900 TAD (XREADC JMS BEG900 TAD (XPRNTC JMS BEG900 TAD (XFREE2 JMS BEG900 TAD (XFREE3 JMS BEG900 TAD BEGBAS JMS BEG900 TAD BEGBAS TAD (400 DCA BEGBAS TAD (-13 JMS BEGZER ISZ BEG802 ISZ BEG802 ISZ BEG802 ISZ BEG803 ISZ BEG803 ISZ BEG803 ISZ BEG804 ISZ BEG804 ISZ BEG804 ISZ BEG805 ISZ BEGUSR JMP BEG800 JMP I (FINISH BEG801, ORG1 /KLUDGE TO MAKE EXTRA ROOM BEG802, BEGLST BEG803, BEGLST+2 BEG804, BEGLST+1 BEG805, BEGIOT-1 BEGBAS, 5400 BEGZER, 0 DCA BEGZCT JMS BEG900 ISZ BEGZCT JMP .-2 JMP I BEGZER BEGZCT, 0 BEG900, 0 CDF 10 DCA I BEG801 CDF 20 ISZ BEG801 JMP I BEG900 PAGE BEGLST,0 PAGE OS8ERM, TEXT "_ILLEGAL OS/8 DEVICE FOUND_NO BOOTSTRAP POSSIBLE!__" OS8MSG, TEXT "_TO BOOTSTRAP BACK " OS8M1, TEXT "OS/8 " OS8M2, TEXT "MONITOR:_ LOAD ADDRESS 07600_ AND START__" DSKMM, TEXT "DISK " TAPMM, TEXT "TAPE " BEGME, TEXT %_INVALID RESPONSE_% BEGM1, TEXT %__EDUSYSTEM 25% *.-1 "-&77^100+V TEXT % BASIC__% BEGM2, TEXT %_NUMBER OF USERS (1 TO 5)?% BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% NOCOR, TEXT %__NOT ENOUGH CORE FOR EDUSYSTEM 25--12K REQUIRED% BEGM5, TEXT %_TELETYPE #1 DEVICE CODE?% BEGM5A=BEGM5+5 BEGM7, TEXT %_STANDARD REMOTE TELETYPE CODES (Y OR N)?% 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)?% *7400 FINISH, TAD (CONEND DCA XPNT TAD BGCORS CLL RTL RAL TAD (CDF DCA XCDF XCDF, 0 DCA I XPNT /CLEAR FIELD ISZ XPNT JMP .-2 L7777 TAD BGCORS DCA BGCORS L7777 TAD BGCORS SZA CLA JMP FINISH /ANOTHER FIELD TO WIPE STILL CIF CDF JMP I (ENTRY /WHEW! BGCORS, 0 XPNT, 0 $*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$*$* Version as of 4 November 1972.Thank God It's off my Back!