/EDUSYSTEM 25 BASIC /TC08 MNEMONICS : DTSF= 6771 DTLB= 6774 DTXA= 6764 DTRB= 6772 DTRA= 6761 /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 L0002=CLL CLA CML RTL /DON'T BE TEMPTED TO USE THESE. MICRO-PROGRAMMING ROTATES AND IAC'S /ARE THE DEVIL'S HANDIWORK. /(IN OTHER WORDS, IT'S A NO-NO ON A STRAIGHT 8) /L0003=CLL CLA CML IAC RAL /L0004=CLL CLA IAC RTL 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 SWAP=10 BUF=20 /USER DECTAPE BUFFERS /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 / CHANGING THE SWAP AREA??????? /BE SURE TO TAKE A LOOK AT BEG800 /TO MAKE SURE THE AREAS ARE ALIGNED PROPERLY /WITH THE DUMMY HERE!!!! 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, 0 /LINE NUMBER LASTLN, 0 /LAST LINE POINTER MODE=LASTLN /FOR MINI-STRINGS SPACSW, 0 /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 0 /DATA POINTER 0 /DATA TEMPORARY 0 /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 EXTEN, 560 /EXTENSION OF FILE ON DECTAPE 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 IBLKH, 0 OPNTR, 0 O3, 0 OBLK, 0 OBLKH, 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 LOOK, USER0-1 /USER BEING RUN OR LOOKED AT /SET TO USER4-5+#USERS IN INIT LOOKST, USER0-1 /TO RESET LOOKING FLARGP, FLARG /POINTER TO TEMP FLAC INTEGE, FIX /FIX THE FLAC ROUTINE /KEEP THE NEXT 8 LOCATIONS TOGETHER PLEASE. CCR, 15 /CR C7, 7 /BELL C177, 177 /RUBOUT C137, 137 /BACK ARROW LSTMOD, -1 /SET BY *INPUT* IFNZRO STSWAP-15 STSWM1, C14, 14 /FF CLF, 12 /LINE FEED M12, -12 /-10 DECIMAL C77, 77 /RIGHT MASK M6, -6 /MESSAGE LENGTH C10, 10 M10, -10 M100, -100 /CHARACTER TEST C7700=M100 /LEFT MASK M4, -4 /CHARACTER COUNT C40, 40 C3, 3 /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 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 .+4 /O.K. TO LOOK AT NEXT /IF PDP8E, AND NOT DC02 - ASSUME KL8E. NEXT THREE WORDS ARE: / CIF 20 / JMP I .+1 / KL8FIX0 /SEE BEG002 AND BEG540 FOR DETAILS. KL8JM0, CIF /NO INTERRUPTS UNTIL LOOK IS ISZ'D TAD LOOKST DCA LOOK /RESET POINTER KL8LF0, 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, -USER7+10 /LAST STATUS WORD : SUBTRACT NUMBER OF USERS /DURING INIT /*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 STSWM1 DCA XREG2 /POINT TO SWAP AREA TAD (STSWAP-ENSWAP-1 DCA TEMP2 /SWAP COUNT JMP I DFIND STARTP, ENSWAP-STSWAP+1 /SPACE BETWEEN PAGE /ERROR ROUTINE /HERE IS WHERE ERROR MESSAGES ARE PRINTED /IT IS CALLED BY A DISMISSAL WITH THE PC SET TO /ERRORX AND THE ERROR ADDRESS IN LSTMOD ERRORX, JMS I (IOFIX /CLEAN UP FILES TAD I LOOK AND (7767 /CLEAR ERROR FLAG DCA I LOOK 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 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 L7777 /WHAT? TAD M4 /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 L7776 /IN JMS I (READY1 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 L7775 JMS I (READY1 /PRINT "READY" 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 VARSET ISZ SPACSW /KEEP SPACES M40, SMA SZA CLA /TSTCCR LEAVES AC=0 SO THIS IS A 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 VARSET, TAD STARTV DCA LASTV /RESET VARIABLES AFTER INPUTTING TEXT ION JMP START GETCX1, 0 /*GETC* FOR FIELD 1 GETC CIF CDF SWAP JMP I GETCX1 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 JMS I (XOUTL /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 KCM40, SMA SZA CLA JMP .+3 /NO ECHO HERE TAD SIN JMS I (XOUTL /ECHO BREAK CHAR - CR AND BELL KEY6, JMS KEY4 /STORE CHAR JMP ANYINP /BREAK HERE KEY3, TAD C7 JMS I (XOUTL /2 BELLS FOR ILLEGAL CHAR TAD C7 JMS I (XOUTL 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 KCM40 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 PRINT3, DCA SPACSW GETC JMP I (PRIN10 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 JMP I .+1 /NO SPACE-PATCH IN EXTRA WORDS CHKPAT /TO SET "D0" EXTENSION CHKPT1, CLL RAR TAD IBLKH 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 /*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 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 (100 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 SZA CLA /NO SECOND CHANCE ON FUNCTION DCA PT1 TSTCCR /"NEXT" MUST BE LAST ON LINE HERE OR WE JMP I NEXERR /FIND THIS NEXT FOREVER IN "FIND" /MUST BE LAST ALSO OR INITIALIZATION WILL /WIPE HIS PROGRAM [AND MAYBE THE SYSTEM!] TAD PT1 TAD FOR1 SZA CLA /RIGHT VARIABLE? JMP FOR4 /NO! 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 FOR1, 0 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 ABS, CDF SWAP DCA I (ACSIGN POPJ 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 /CALL MESSAGE WRITER IN FIELD 1 READY1, 0 PUSHA /SAVE MESSAGE NUMBER FREE13 /MAKE SURE THERE'S ROOM POPA /RESTORE MESSAGE NUMBER CIF CDF SWAP JMS I .+2 JMP I READY1 READY2 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 PAGE MANCOM, 0 DCA FLTXR2 /SAVE AC JMS COMPUSH /SAVE TEXT POINTERS TAD (LIST7 /START AT BEGINNING OF LIST CDF SWAP /IN FIELD 1 COMLP1, DCA T2 /LIST POINTER L0001 DCA T1 /LETTER POINTER TAD I T2 /GET -UNIQUE COUNT-1 RTR / AND C7 / CLL RAR / CMA / DCA CNTR / JMS COM11 /UNIQUE? JMP COM3 /YES - TRY REST ISZ T2 /GET NEXT COMMAND IN LIST TAD I T2 / SZA /END OF LIST? JMP COMLP1 /NO - GO ON JMS COMDUMP /YES - DUMP THE POINTERS COM5, CDF /YES - RETURN FAILURE JMP I MANCOM /AC=0 COM3, TAD I T2 /GET -FULL LENGTH-2 AND C7 / IAC / CMA / TAD T1 /T1=UNIQUE COUNT+1 DCA CNTR /-NO. OF CHARS TO GO-1 JMS COMPUSH /SAVE TEXT POINTERS JMS COM11 /LONG FORM OF COMMAND? COMK4, 4 JMS COMDUMP /THROW OUT SHORT POINTERS TAD I T2 RTL6 RTL AND C77 /GET CODE TAD (-32 /CORRECT IT DCA FLTXR /AND SAVE IT TAD FLTXR2 SNA JMP .+4 /NO DOUBLE CHECK TAD FLTXR SZA CLA JMP COM7 /DOUBLE CHECK FAILS CDF JMS COMDUMP /DUMP PDL JUNK TAD FLTXR JMP I MANCOM COM7, JMS COMPOP /RESET POINTERS TO ENTRY VALUES JMP COM5 /TAKE FAILURE RETURN COM11, 0 /COMMAND COMPARISON DCA COM12 /SET POINTERS UNUSED SWITCH COMLP2, CDF SWAP ISZ CNTR /-NO. OF CHARS TO GO-1 SKP JMP I COM11 /SUCCESS RETURN FROM COM11 L0001 TAD T1 RAR TAD T2 DCA XREG3 TAD I XREG3 SZL JMP .+3 RTL6 RAL AND C77 SNA TAD TSTCON TAD (-137 TAD CHAR SZA CLA /SAME SO FAR? JMP COM13 /NO GO L7777 DCA COM12 /SET SWITCH FOR POINTERS USED CDF GETC /NEXT CHAR ISZ T1 /LETTER POINTER JMP COMLP2 /LOOP COM13, CDF SWAP /BE SURE TO RETURN WITH DF=1 ISZ COM11 /FAILURE RETURN FROM COM11 ISZ COM12 /HAVE THE TEXT POINTERS BEEN USED? JMP I COM11 JMS COMPOP /COMPOP RETURNS WITH DF=1 TAD M10 /FOOL COMDUMP INTO BACKING UP JMS COMDUMP /OVER SAVED POINTERS JMP I COM11 COMPOP, 0 /RESTORE TEXT POINTERS FROM PDL POPA DCA CHAR POPF TEXTP CDF SWAP JMP I COMPOP COM12, /THIS SWITCH IS NEVER IN USE WHEN COMPUSH IS CALLED COMPUSH, 0 /SAVE POINTERS CDF PUSHF TEXTP /SAVE TEXT POINTERS TAD CHAR / PUSHA / JMP I COMPUSH COMDUMP, 0 /DUMP PDL ENTRIES TAD COMK4 TAD PDLXR DCA PDLXR JMP I COMDUMP 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 CVARKIL /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 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 CITPRNT,ITPRNT TAD LASTLN DCA LINEPC /AND GO BACK ONE JMP I GETLIM LIMGT2, TAD LASTLN /1ST = 2ND JMP LIMGT3 CXDELET,XDELET CVARKIL,VARKILL 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 TAD C3 TAD AXOUT FLGET /GET LIMIT FLARG FINT FSUB I FLARGP FPUT I FLARGP FEXT GETSGN /SIGN OF DIFFERENCE NEXT1, HLT /SKIP IF DONE JMP NEXT2 /NOT DONE L7777 TAD AXOUT DCA T1 UDF DCA I T1 /NOT INITIALIZED NOW 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 JMS RUN4 /UNINITIALIZE THE *NEXT* STATEMENTS 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 IMMED, JMS RUN4 L7777 TAD COMBUF DCA LINEPC L7777 DCA LINENO /IMMEDIATE MODE JMS I (OTPACK JMP RUN8+1 PIOFX, IOFIX RUN4, 0 CLA TAD CCR /SET END OF LINE FOR GETNXT DCA CHAR TAD ERLINE FIND /FIND THE NEXT STATEMENTS 1 /- NEXT CODE JMP I RUN4 /OUT OF TEXT DCA ERLINE /SAVE FOR RESTART PUSHJ GETVAR SNA CLA TSTCCR JMP ERR460 UDF DCA I AXOUT /NOT INITIALIZED NOW JMP RUN4+1 PAGE /EXPRESSION EVALUATOR ECALL, 0 TAD SORTCN PUSHA TAD LASTOP PUSHA TAD EFOP PUSHA TAD ECALL PUSHA /RETURN ADDRESS GETC EVAL, DCA LASTOP /0 IS END TAD EVAL1 PUSHA /SAVE EVAL1 DCA EVAL1 /0 EVAL1 TESTC JMP ETERM1 /INITIAL TERMINATOR JMP ENUM /NUMBER JMP EVAR /VARIABLE JMP I (QUOTES /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 (FLIN /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 TAD (-15 SNA JMP PRIN11+1 TAD CCR 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 PRIN10 FREE2 TAD C40 PRINTC JMP PRINT9+1 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 FREE2 TAD C40 PRINTC /SPACES TO FINISH ZONE PRINT5, TAD PPRINT TAD (-XPRNTC SZA CLA JMP PRNT5A TAD C7 TAD PRNTC1 TAD CCR SPA JMP .-2 SZA CLA JMP PRINT5-3 /KEEP GOING PRNT5B, GETC /GO BY THE "," JMP PRINT1 PRNT5A, FREE2 PRINTC JMP PRNT5B /*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 CCM40, SMA SZA CLA /AC=0 SO ITS A SKP RAR ISZ T3 JMP .-2 TAD C10 MTON /TURN ON PROPER USER CLA TAD XREG3 XOUTL6, HLT /IF NOT DC02, /XOUTL6-3 AND XOUTL6+3 ARE SET TO ZERO IN BEG760 DCA TELSW /SET BUSY TAD I (AUSER MTON /ALL ON AGAIN 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 CCM40 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 FUPAR1, 2055 0 0 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 CIF SWAP /DO DECTAPE AND STATUS STOUGH JMS I (IERDTA JMS I (IOFIX /RESET FILES TAD (ERRORX DCA PC /SET FOR RESTART JMP I IERROR IERROR, 0 L7777 TAD CCM40 TAD IPTR0 DCA XREG3 TAD CCM40 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 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 (-40 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 JMS I (READY1 /PRINT "$ DELETED" POPA DCA XPACKC /RESTORE ADDRESS TAD PACKST DCA AXIN POPF TEXTP DCA CHAR JMP XPACK1+3 /*READC* ROUTINE XREADC, 0 UDF CIF /NO INTERRUPTS WHILE MESSING WITH IPTRO /OR HIS BUFFER - ELSE WE'RE SKROOD!!!! 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 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 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 CHKPAT, TAD (460 DCA EXTEN TAD IBLK /FILE OPEN? JMP I (CHKPT1 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 JMP I XGETC XGET1, UDF TAD I AXOUT /GET NEXT CDF DCA GTEM /SAVE PARTIAL L7777 DCA XCT /INDICATE PARTIAL TAD GTEM RTL6 RAL JMP XGET2 XGET3, TAD SPACSW /SPACE TEST SZA CLA JMP I XGETC /KEEP SPACES JMP XGETC+1 /IGNORE SPACES XGET4, TAD C7 /BELL XGET6, DCA CHAR JMP I XGETC XGET5, TAD CCR /CR JMP XGET6 /*GETNXT* ROUTINE NXTGET, 0 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 USER0, 0 USER1, 1 USER2, 2 USER3, 3 USER4, 4 USER5, 5 USER6, 6 USER7, 7 XPAKL1, 15 /THE NEXT 6 LOCATIONS MUST STAY TOGETHER 7 /BELL 177 /RUBOUT XGETL1, 137 /BACK ARROW 100 /USED IN XGETL 40 /BE DAMN SURE THE NEXT WORD IS NEGATIVE!!! /INTERRUPTS HERE FIRST INTR8E, CIF SWAP JMP I .+1 INTR81 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 VARKIL, 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 I (IMMED /IMMEDIATE MODE TAD (COMGO1 DCA T1 CDF SWAP TAD I T1 CDF DCA T1 JMP I T1 /*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 GOSUB1, POPA DCA LINENO FINDLN AFORE, FOREXT POPA JMP I AFORE 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 PXFREE DCA FREESV /SAVE XFREE ADDRESS DCA USER /START AT USER 0 DCA TEMP1 /NO TTY'S TO TURN ON AT FIRST TAD TADINT 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? /IF NOT DC02, /INTRP2-2 AND INTRP2+4 ARE SET TO ZERO IN BEG760 SKP /NO JMS I PKEY /READ TTY TAD TEMP1 MTON /USER ON AGAIN CLL RAR /SHIFT FOR NEXT USER SNA /FIRST TIME? TAD C4004 /YES - GET TTY #1 BIT TAD C4 DCA TEMP1 INTRP3, HLT /TTY? JMP .+3 /NO INTRP4, HLT /CLEAR ITS FLAG JMS I PTTY /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 /IF NOT DC02, /INTRP5 AND INTRP5+1 ARE SET TO ZERO IN BEG760 MTON /TURN ALL USERS ON AGAIN 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 PXFREE ISZ I PINTCN /COUNT INTERRUPTS DECKNI, DECKON /IF PDP 8E, AND NOT DC02 - ASSUME KL8E. NEXT THREE WORDS ARE: / CIF 20 / JMP I .+1 / KL8FIX1 /SEE BEG002 AND BEG540 FOR DETAILS. KL8JMP, TAD SAVLK /GET LINK BACK CLL RAL TAD SAVAC /AND THE AC ALSO KL8LFL, RMF ION JMP I 0 /EXIT FROM INTERRUPT C4004, 4004 C4, 4 TADINT, TAD INTRPL PKEY, KEY PTTY, TTY PXFREE, XFREE PINTCN, INTCNT SAVAC, 0 SAVLK, 0 T3SV, 0 XREG3S, 0 SRTCNS, 0 UDFSV, 0 FREESV, 0 MUSER, -1 /-1 FOR 1 USER, -2 FOR 2, ETC. /(SET IN INIT) 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 MTLS /USER 5 MTLS /USER 6 MTLS /USER 7 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 /*RTL6* ROUTINE XRTL6, 0 CLL RTL RTL RTL JMP I XRTL6 /POP THE AC ROUTINE XPOPA, 0 UDF TAD I PDLXR CDF JMP I XPOPA PAGE OPTABL, FGET I PT1 FADD I PT1 FSUB I PT1 FMUL I PT1 FDIV I PT1 FJMP 0 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 PRNTL4, 73 /; PRNTL1, 54 /, 47 /' PRNTL7, 42 /" 15 /CR 134 /\ /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 SETUPO, 0 TAD (XPUT DCA PPRINT TAD (OFREE2 DCA PFREE2 TAD (OFREE3 DCA PFREE3 JMP I SETUPO PRINT0, TAD CHAR TAD (200-"# SZA CLA JMP PRINT /OK AS IS TAD OBLK /THIS WILL WORK BECAUSE HE CAN'T USE BLOCK 0 CLL RAR TAD OBLKH SZA CLA GETC TSTCOM JMP I (ERR600 GETC JMS SETUPO TAD (460 DCA EXTEN 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 (FLOUT PRNTX2, L7777 JMP PRINT FREE2 TAD CCR PRINTC PRINT6, IAC POPJ PAGE /*OR* ROUTINE FOR USER STATUS WORD XOR, 0 TAD I XOR CMA AND I LOOK 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 L0001 /PRINT "NAME--" 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 FCN, 2330;0;0 /INTEGERIZING CONSTANT 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 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 AXPUT0, 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 AXPUT0 POPA TAD (-15 SZA CLA POPJ TAD CLF DCA T3 JMP XPUT3 CHAIN, JMS I (DTGRAB TAD (CHAIN1 DCA CHAINP JMP I (CHAIN2 PAGE C6777, 6777 /THIS MUST BE AT THE BEGINNING OF THE PAGE CHECK C200 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 JMS I (XOR /SET DECTAPE BUSY 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 CIF 0 /*** THIS IS REALLY AN IOF UNTILL JMP I DTFREE TAD I T3 /CLEAR DECTAPE BUSY C200, AND C6777 /THIS IS WHY C6777 MUST BE AT THE BEGINNING OF THE PAGE DCA I T3 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 BUF /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 C7400 TAD CHAR /GET THE FIRST HALF (AGAIN?) RTL RTL RAL JMP GEXIT GET1, TAD IPNTR /IS THERE ANY BUFFER? AND C177 C12M32, SZA CLA SMA SNL /DUMMY SMA SNL TO PRODUCE (12-32 JMP GET2 /GUESS SO TAD BASE /BUILD POINTER TO BUFFER TAD C200 DCA IPNTR TAD XGET /SAVE THE RETURN PUSHA JMS DTGRAB /GET THE DECTAPE TAD IPNTR /MOVE THE ARGS DCA IBUFF TAD IBLK DCA INBLK TAD IBLKH CLL RAR /LINK WILL HAVE THE HIGH ORDER ADDRESS ISZ IBLK /NEXT BLOCK, NEXT TIME SKP /THE NEXT 4 LOCATIONS ARE FOR THOSE WITH RK8E ISZ IBLKH /WITH 17777 PAGES CLA IAC /AC=1 FOR READ CIF SWAP JMS I (DTAPE /DO THE DECTAPE THING IBUFF, 0 7620 /READ 200 WORDS (ONE PAGE) INTO FIELD 2 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 BUF /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 SNA /IGNORE NULLS JMP XGET+1 TAD M12 /AND LINE FEEDS CLL RTR /AND FORM FEEDS SNA JMP XGET+1 RTL TAD C12M32 /CHECK FOR ^Z. 12-32=7760=SZA CLA SMA SNL SZA JMP .+6 ISZ XGET /SKIP RETURN FOR EOF DCA IBLK /CLEAR FILE OPEN DCA IBLKH 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 LENTH 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 LENTH SZA CLA TAD OMAX /ANYBODY ELSE IS LIMITED TO 64 TAD C7700 SPA SNA CLA /TOO BIG 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 CLL RAL DCA OBLK RAL DCA OBLKH 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 CLOSE1 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 CLL RAL /GET THE TAPE BLOCK*2 FOR PAGES DCA IBLK RAL DCA IBLKH DCA I3 /CLEAR THE SWITCH DCA IPNTR /AND THE POINTER OUTOUT, JMS I (DTFREE /GIVE UP THE TAPE POPJ RESTOR, TSTEND ERR280, ERROR DCA DATAPC TAD CCR DCA DATAPC+4 POPJ FLTONE, 2014 FLZERO, 0 0 0 ERR330, ERROR PAGE XPUT0, 0 IFNZRO XPUT0-7200 CDF BUF 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 .+4 DCA OBLK /CLEAR FILE DCA OBLKH ERR640, ERROR TAD BASE DCA OPNTR JMS I (DTGRAB TAD BASE DCA OBUFF TAD OBLK DCA OUTBLK TAD OBLKH CLL RAR /OBLKH MUST BE EITHER 0 OR 1 NOTHING ELSE. ISZ OBLK SKP /RK8E AGAIN ISZ OBLKH CIF SWAP JMS I (DTAPE OBUFF, 0 7620 /WRITE 200 WORDS FROM FIELD 2 OUTBLK, 0 JMS I (DTFREE JMP I XPUT0 PUT1, AND C177 DCA I OPNTR ISZ OPNTR CDF JMP I XPUT0 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 /SET "E0" EXTENSION DCA EXTEN CIF CDF SWAP /UNPACK THE NAME 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 CDF 0 L0002 TAD ALINE0 DCA BUFR TAD (XGET DCA PREADC JMP I (START /RETURN TO COMMAND INPUT! XPRNTC, 0 IOF JMS I (XOUTL ION JMP I XPRNTC PAGE OPUS, POPA DCA T3 CDF CIF 10 JMP I T3 INTCNT, 0 RANDOM, TAD FRNDX+1 TAD INTCNT DCA FRNDX TAD INTCNT DCA FRNDX+1 POPJ CLOSE0, TAD (460 /SET "D0" EXTENSION DCA EXTEN CLOSE1, TAD OBLK /ANY FILE TO CLOSE? CLL RAR TAD OBLKH /THIS WILL WORK BECAUSE HE CAN'T USE BLOCK 0 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! DCA OBLKH 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 CCR /** NAMEX IS AT LOCATION 15 TAD NAME+1 DCA I (NAMEX+1 TAD NAME+2 DCA I (NAMEX+2 CDF TAD DECK TAD (560 /SET "EX" EXTENSION DCA EXTEN 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? PCAT0, CAT0 /ENTER WITH 0 SHOULD ALWAYS SKIP 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 PCAT0 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 DCA T1 /SET EITHER '.E0' OR '.D0' TAD CHAR /CHECK FOR $ TAD (-"$+200 SNA CLA JMP DOL2 TAD DECK /ADD CURRENT USER TO EXTENSION DOL1, TAD T1 TAD (560 DCA EXTEN JMP I DOLCHK DOL2, GETC /SKIP OVER $ TAD C10 JMP DOL1 PAGE FIELD 1 *7400 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 DCA INTAC1 /JUST FOR *DECKON* 0 /DTSF IF TC08, DSKP IF RK8E JMP DIS JMP I MCOM /YES, GO TO IT OCNTR, 0 /FLT PT COUNTER XENTMP, 0 /!!!!! WARNING DON'T MOVE OFPNT OR ITS ENTRY POINT !!!!! *7 Z200, 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 CALL=JMS I . /CALL AN OVERLAY OVER ENTER XCALL OPRINTC=JMS I . /FIELD 1 PRINTC OPRINC OERROR= JMS I . /FIELD 1 ERROR CALL OERRX OGETC= JMS I . /FIELD 1 GETC OGETCX OTESTN= JMS I . /FIELD 1 TESTN OTESTX OPOPJ= JMP I . OPOPJX OPUSHJ= JMS I . OPUSHX DECTAP= JMS I . /DO READ OR WRITE DTAPE ERROX= JMP . ERR530, OERROR 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 TADCHR= JMS I . /TAD CHAR FROM FIELD 0 XTADCH TADEXT= JMS I . XTADEX /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 PSQUISH, SQUISH FOUND, 0 MCOM, 0 PPLINK, CALL /CALL LINK OVERLAY. MOVE THIS IF YOU CAN FIND ROOM CLINK^2 LINK Z10, 10 Z70, 70 Z100, 100 Z1000, 1000 Z6777, 6777 ZLOOK, LOOK ZRUN9X, RUN9X ZDTQ1, DTQ1 ZDIRBUF, DIRBUF ZDXIT, DXIT /POINTER TO DTAPE (RK8E) RETURN PXCALLB, -XCALLB-1 ZOERROR, OERROR DTSF1, DTSF /DTSF IF TC08, DSKP IF RK8E DTLOOK, 0 /ADDRESS OF DECTAPE USER STATUS WORD ZCDF, CDF /FOR RK8E HANDLER DCON, /DECTAPE (OR DISK) CONSTANTS D4000, /4000 DDR128, DR128 D6260, /6260 DDTBLK, DTBLOK D1400, /1400 DDINT, DINT-1 DDIRB, /DIRBUF-1 D614, 614 DM200, /-200 D20, 20 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 TADCHR 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 TADCHR 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 TADCHR 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 TADCHR 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 PAL1 L7777 TAD ACEXP DCA ACEXP JMP FIXUP1 PAL1, AL1 K5400, 5400 K2166, 2166 KM5, -5 K377, 377 PMULT10, MULT10 PFIXCON, FIXCON PNFIX, NFIX FIXUP2, TAD ACEXP KM40, SMA SZA CLA JMP FIXUP3 JMS I [AR1 JMS I [AR1 JMS I [AR1 JMS I [AR1 JMS I PMULT10 TAD ACEXP TAD FIXC4 DCA ACEXP L7777 JMP FIXUP4 FIXUP3, TAD ACEXP TAD KM5 SPA JMP FIXUP5 FIXUP7, CLL CLA TAD KM40 DCA OCNTR FIXUP8, TAD AC1 TAD K5400 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 K377 DCA AC1 L0001 JMP FIXUP4 FIXUP5, DCA OCNTR SKP JMS I [AR1 ISZ OCNTR JMP .-2 TAD AC1 TAD K5400 SMA CLA JMP FIXUP7 CLL TAD K2166 TAD AC3 DCA AC3 SZL ISZ AC2 SKP ISZ AC1 TAD AC1 TAD K5400 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 PFIXCON FSGE FSUB I PFIXCON FEXT JMS I PNFIX 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 IFNZRO .-1577 OSQR, FINT FPUT FSINZ FSNE FJMP SQEXIT FEXT TAD ACSIGN SPA CLA ERR020, OERROR TAD ACEXP TAD KK7600 CLL SPA CML RAR TAD [200 DCA ACEXP TAD KKM10 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 POTEMP FEXT OPUSHJ COS FINT FPUT I PFATNC FGET I POTEMP FEXT OPUSHJ FSIN FINT FDIV I PFATNC 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 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 KK7600, 7600 KKM10, -10 POTEMP, OTEMP PFATNC, FATNC OFLTONE, 2014 OFLZERO, 0 0 0 ALT, 175 176 33 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 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 LIST13, 41^40+11 LIST15 -"_+337^100 PAGE XDIRSCH, 0 CLA STL /READ FIRST BLOCK GETCAT 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 TADEXT CIA TAD I XR1 SZA CLA JMP NXTFIL BUMPXR TAD I XR1 SNA JMP SKPMTF+4 DCA FILEN ISZ XDIRSCH TAD BLOCK JMP I XDIRSCH NXTFIL, TAD XBUMPXR CIA BUMPXR SKPMTF, TAD I XR1 CIA TAD BLOCK DCA BLOCK ISZ ENTRIES JMP SCHLP JMS I [CATNEX JMP I XDIRSCH XBUMPXR, 0 TAD WASTE TAD XR1 DCA XR1 JMP I XBUMPXR XGETNAM, 0 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 TADCHR AND [77 SZL JMP .+4 CLL RTL RTL RTL TAD I WASTE DCA I WASTE ISZ TEMPX JMP NLOOP NDONE, TADCHR TAD [-15 SZA CLA ERROX TAD TEMPX SNA CLA ERROX CIF CDF JMP I XGETNAM XTADCH, 0 CDF TAD I [CHAR CDF SWAP JMP I XTADCH QLIS2, QCOMCK-1 /, QNEXTC-1 /' QUOCHK-1 /" QDONE-1 /CR QLIS1, QNEXTC-1 /\ , QNEXTC-1 /' QNEXTC-1 /" QDONE-1 /CR QNEXTC-1 /\ 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 CAT0, 0000 CLA STL /GET FIRST BLOCK GETCAT GETCAT CIF CDF JMP I CAT0 XCALL, 0000 /OVERLAY CALLING PROGRAM TAD I XCALL /BLOCK NUMBER TO READ ISZ XCALL DCA XCALLB TAD I XCALL /LINK ADDRESS DCA XCALL L0001 DECTAPE XENTER+1 /USE ENTER AS OVERLAY AREA 7610 /READ 200 WORDS INTO FIELD 1 XCALLB, 0000 JMP I XCALL PAGE DTAPE, 0 /ENTER WITH AC=1 FOR READ IOF /NO INT PLEASE TAD DDR128 DCA DRET /READ/WRITE RETURN AFTER SEARCH TAD ENTERF /SAVE CALLING FIELD RDF DCA DXIT+1 DGR, CLA CMA TAD I DTAPE ISZ DTAPE DCA DCORE /FIRST CORE LOCATION-1 OF TRANSFER TAD I DTAPE AND Z70 DCA DTFLD /SAVE FIELD TO BE READ INTO TAD I DTAPE AND D7600 /GET LENGTH IN PAGES ISZ DTAPE DCA DWDS / -NUMBER OF WORDS TO BE TRANSFERRED TAD I DTAPE /GET BLOCK NO. ISZ DTAPE DCA DTEM /AND STORE TAD DTSF1 DCA DTINTR+2 /PUT DTSF IN SKIP CHAIN /INITIATE SEARCH DTS1, TAD DDTBLK /DTBLOK TO 7755 (CA) CDF DCA I DCAA TAD DDINT /DINT-1 DCA MCOM /INTERRUPT RETURN TADEXT /SEE IF .DX OR .EX AND Z100 SZA CLA JMP UNIT0 /MUST BE .EX TAD PXCALLB /AND EXCEPT FOR CALL TAD DTAPE SZA CLA UNIT1, TAD Z1000 /USE UNIT1 UNIT0, TAD D614 /SET TO SEARCH,NORMAL,REVERSE DTLA /LOAD STATUS A TAD Z10 /DTBLOCK IS IN FIELD 1 DTLB JMP I DDTDIS /PUT HIM TO SLEEP FOR A WHILE DTEM, 0 /CHECK THE LIST OF ERRORS CAREFULLY SO THIS DOESN'T CONFLICT /WITH ERRORS IN FIELD 0. DXIT, DCA DTINTR+2 /ZAP DTSF IN SKIP CHAIN HLT /RETURN TO PROPER FIELD JMP I DTAPE DR128, TAD D20 /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) TAD DTFLD /FIELD OF BUFFER DTLB /TO DECTAPE REGISTER B ISZ MCOM /POINT INTERRUPT RETURN TO DATA DGO, TAD D7600 /SET WORD COUNT FOR 1 PAGE CDF DCA I DWC /-128 TO 7754 (WC) DR127, DTXA /IN CASE WE MISSED IT BEFORE JMP DIS /EXIT JMP DTS3A DINT, DTRB /READ STATUS B SPA CLA JMP DER1 /ERROR FLAG CLA CLL TAD DWDS /BUMP COUNT AND CHECK FOR MORE TAD Z200 /LOCATION 7 HAS LITTERAL 200, 128 WORD PAGE DCA DWDS /SAVE FOR NEXT TIME SNL JMP DGO /GET NEXT PAGE TAD [600 /COMPLEMENT MOTION AND DIRECTION DTXA JMP I DDTEND /WAKE HIM UP 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 DTFLD, 0 DDTDIS, DTDIS DDTEND, DTEND D774, 774 /ZERO ALL OF DECTAPE REGISTER A EXCEPT THE UNIT DTS3A, CDF TAD I DTLOOK CDF SWAP AND Z10 /LOOK AT ERROR FLAG SZA CLA JMP DTKILL /CTRL-C OR OTHER ERROR STOPS SERCH DTRB /READ STATUS B RTL /LOOK AT BIT 2 SPA CLA /END ZONE? JMP DTURNX /YES (MOTION BIT=0), TURN DTRB SPA CLA JMP DER1 /ERROR FLAG BIT 0=1 DTRA 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 /DON'T TURN YET, STILL IN REVERSE JMP I DRET /GO DO READ OR WRITE DTURNX, TAD [600 /REVERSE OUT OF END ZONE JMP DR127 DER1, TAD ZOERROR /AC IS CLEAR WHEN WE GET HERE DCA DXIT+1 DTKILL, DCA DTINTR+2 /REMOVE DTSF FROM SKIP CHAIN DTRA /GET REGISTER A AND D774 /GET HIS MOTION AND INTERRUPT ENABLE BITS DTXA /ZERO THEM BY DOING AN XOR JMP I DDTEND /HE WAKES UP WITH A CTRL-C PAGE *.-3 /BUMP BACK TO 3 LOCATIONS BEFORE PAGE BOUNDRY ENTERF, CDF CIF 0 JMP I XENTER XENTER, 0 /OS/8 DIRECTORY 'ENTER' DCA TEMPX1 /BLOCKS NEEDED DIRSCH /SEARCH DIRECTORY FOR DUPLICATE FILE. JMP NODLET /NO FILE TO DELETE L7776 /FOUND A FILE SO DELETE IT TAD XR1 DCA XR1 /RESTORE XR1 TO SIZE-2 TAD XR1 DCA XR3 DCA I XR3 /MAKE THIS AN EMPTY ENTRY L7775 TAD I [DIRBUF+4 /SQUISH OUT NAME.EX+WASTE JMS I PSQUISH /LEAVING THE EMPTY OF COURSE CONSOL, SETPT /NOW CLEAN UP THAT MESSY DIRECTORY TAD I XR1 SNA CLA JMP CONMTF /ITS AN EMPTY TAD [4 /ITS NOT. SO IGNORE IT BUMPXR ISZ ENTRIES /DONE? JMP CONSOL+1 /NOPE EOCLOS, CLA CLL /WRITE (L=0) OUT DIRECTORY TAD I [CATBLK /USE THE BLOCK WE READ IN GETCAT /ACTUALLY PUT CAT NODLET, TAD TEMPX1 SNA CLA JMP ENTXIT /ALL DONE EXIT DCA FOUND /CLEAR FOUND FOR SEARCH STL GETCAT /READ IN FIRST BLOCK MLOOP, TAD I XR1 SNA CLA JMP MEMPTY TAD [4 BUMPXR MLOOPC, ISZ ENTRIES JMP MLOOP CLA /AC IS NOT 0 AFTER SZL IN MEMPTY TAD FOUND SZA CLA JMP MLOOPF FLOOPF, DCA FOUND JMS I [CATNEX /IF ANOTHER CAT BLOCK EXISTS RETURNS TO LAST GETCAT+1 JMP I .+1 /NO ROOM PPLINK /TRY TO LINK DIRECTORIES ENTXIT, ISZ I [XENTER /OK EXIT CALL + 1 DIRSCH /SEARCH DIRECTORY FOR ENTRY NOP /IF SOMEONE OPENS A FILE WITH 0 LENGTH IT WILL COME HERE. JMP I .+1 ENTERF MEMPTY, TAD FOUND /SEE IF WE WERE ALREADY HERE SNA CLA JMP .+3 ISZ XR1 JMP MLOOPC CLL /MAKE SURE LINK IS 0 TAD I XR1 /-SIZE OF EMPTY TAD TEMPX1 /SIZE WE WANT. LINK SHOULD HAVE BEEN 0 AT MEMPTY SZL JMP MLOOPC /NOT BIG ENOUGH DCA XENTMP /SAVE SIZE OF NEW EMPTY IF ANY L7776 TAD XR1 DCA FOUND /AND WHERE IN THE BLOCK WE CAME FROM JMP MLOOPC /CONTINUE TO END OF BLOCK MLOOPF, TAD XR1 DCA TEMPX TAD [4 BUMPXR TAD XR1 TAD [-DIRBUF-370 SMA CLA JMP FLOOPF 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 TADEXT /".EX" EXTENSION DCA I XR1 DCA I XR1 CLA CMA BUMPXR TAD TEMPX1 CIA DCA I XR1 /PROPER LENGTH DCA I XR1 /MAKE AN EMPTY TAD XENTMP DCA I XR1 /OF NEW LENGTH CLA CMA TAD I ZDIRBUF /# OF ENTRIES DCA I ZDIRBUF DCA TEMPX1 /SET UP FOR NODLET JMP EOCLOS CONMTF, TAD I XR1 SNA JMP SQTRIV DCA TEMPX TAD XR1 DCA FOUND ISZ ENTRIES SKP JMP EOCLOS TAD I XR1 SZA CLA JMP CONSOL+4 /NOT A DOUBLE EMPTY TAD I XR1 TAD TEMPX DCA I FOUND /MAKE 1 EMPTY OUT OF 2 SQTRIV, L7776 /REMOVE AN EMPTY JMS I PSQUISH ISZ I ZDIRBUF /RESET NUMBER OF ENTRIES JMP CONSOL 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 LIST82, 24^40+22 LIST83 337-"I^100-"F+337 LIST12, 22^40+11 LIST13 -"'+337^100 XSETPT, 0 TAD I ZDIRBUF DCA ENTRIES TAD I [DIRBUF+1 DCA BLOCK TAD I [DIRBUF+4 CIA CLL /MAKE SURE L=0 FOR MEMPTY DCA WASTE TAD [DIRBUF+4 DCA XR1 JMP I XSETPT CATNEX, 0000 TAD I [DIRBUF+2 /SEE IF IT LINKS CLL RAL /MULTIPLY BY TWO STL /SET LINK FOR READ SNA JMP I CATNEX /NO LINKAGE RETURN SKP /ENTER GETCAT+1 IF LINKAGE EXISTS XGETCAT, 0 SNA /SEE IF ENTERED WITH SEGMENT NUMBER TAD [2 /ASSUME FIRST CAT BLOCK. DON'T L0002! DCA CATBLK /BLOCK NUMBER TO FETCH RAL /READ OR WRITE WAS IN LINK DECTAPE DIRBUF 7410 /400 WORDS IN FIELD 1 CATBLK, 2 SETPT JMP I XGETCAT SQUISH, 0 TAD XR1 DCA XR2 TAD I XR1 DCA I XR2 TAD XR1 TAD [-DIRBUF-377 SZA CLA JMP .-5 JMP I SQUISH CAT1, 0 TAD I XR1 SNA JMP DEMPTY DCA NAMEX TAD I XR1 DCA NAMEX+1 TAD I XR1 DCA NAMEX+2 TADEXT 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 TWOPRT TAD NAMEX+1 JMS TWOPRT TAD NAMEX+2 JMS TWOPRT TAD [15 OPRINTC JMP DEMPTY+1 BUMPXR DEMPTY, ISZ XR1 ISZ ENTRIES JMP .+3 JMS I [CATNEX ISZ CAT1 CIF CDF JMP I CAT1 FLOOK, 0 /GET CATALOG AND LOOKUP DIRSCH ERROX CIF CDF JMP I FLOOK /THAT WAS EASY 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 Z100 TAD [40 OPRINTC JMP I ONEPRT DTCHKX, 0 /CHECK IF USER ALREADY HAS TAPE IOF TAD I [DECK IAC DCA XR3 TAD I ZDTQ1 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-4 /, PRINT6-4 /' PRINT8 /" PRINT6-4 /CR PRINT6-4 /\ PRNTL2, PRINT5-4 /, PRINT6-1 /' PRINT2-1 /" PRINT6-1 /CR PRINT6-1 /\ PRNTL8, PRINT3-1 /" PRINT6-4 /CR PRINT9+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 READY /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 PDXIT, DXIT+1 /DECTAPE ERROR ERREND=. 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 LIST76, 20^40+33 LIST77 -"F+337^100-"O+337 -"R+337^100 DIRBUF, ZBLOCK 400 INTR80=.-1 /2 POWER FAIL/AUTO RECOVER TEMPS INTR8F=.-2 INTRRV, CAF /RECOVER - CLEAR ALL / TLS /IF NOT DC02 - SEE BEG760 / 0 /IF NOT 8-E - SEE BEG550 AAACDF, CIF CDF INTRV2, TAD I PAUSER MTON / 0 /IF NOT DC02 - SEE BEG760 JMS I PINTRP / MTLS /IF DC02 - SEE BEG760 CLA TAD PINTR8 DCA I [2 TAD INTR8F AND [7 CLL RTL RAL TAD AAACDF DCA INTR88 TAD INTR8F AND Z70 TAD CCIF DCA INTR89 TAD INTR8F RAL CLA INTR88, CDF INTR89, CIF TAD INTAC1 /AND AC ION JMP I INTR80 /AND EXIT PINTRPL, INTRPL-1 PAUSER, AUSER CCIF2, CIF SWAP PINTR8, INTR8E PINTRRV, INTRRV INTR81, DCA INTAC1 /SAVE AC 6634 /READ CARD READER TO CLEAR FLAG 6674 /AND CARD DONE FLAG CLA /AND CLEAR 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 INTAC1 /GET THE AC AGAIN CCIF, CIF JMP I .+1 /GO TO THE 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 LIST14, 51^40+33 A0000, 0 -"O+337^100-"L+337 -"D+337^100 COMGO1, LIST START /CR BYE DELETE EDIT KKEY TAPE RUN NEW OLD SAVE UNSAVE CATLOG RENAME KILL DATLOG UNKWN+1 /CHR FUDGE!! LIST72, 14^40+37 LIST73 -"R+337^100-"E+337 -"S+337^100-"T+337 -"O+337^100-"R+337 -"E+337^100 XTADEX, 0 CDF TAD I .+3 CDF SWAP JMP I XTADEX EXTEN DTDIS, CIF CDF 0 TAD I ZLOOK /SET BUSY FLAG DCA DTLOOK TAD I DTLOOK /GET STATUS AND Z6777 /DO AN OR TAD Z1000 DCA I DTLOOK TAD ZDXIT /FAKE RETURN ADDRESS JMP I ZRUN9X /AND DISMISS DTEND, CDF TAD I DTLOOK AND Z6777 /CLEAR BUSY DCA I DTLOOK JMP DIS /FINISH INTERRUPT MSERROR, TEXT "_ERROR" MSDELETED, TEXT "$ DELETED_" MSNAME, TEXT "NAME--" PAGE /ROUTINE TO PRINT EDU25'S MESSAGES READY2, 0 TAD RDYK1 /COMPUTE ADDRESS OF MESSAGE DCA OP3 TAD I OP3 DCA OP3 READY4, TAD I OP3 /GET CHARACTER RTR RTR RTR JMS READY3 TAD I OP3 /GET SECOND CHARACTER IN WORD JMS READY3 ISZ OP3 JMP READY4 READY5, CIF CDF JMP I READY2 READY3, 0 AND [77 SNA JMP READY5 TAD RDYK2 SNA TAD RDYK3 SPA TAD Z100 TAD RDYK4 OPRINTC JMP I READY3 RDYK1, RDYLST+5 RDYK2, -37 RDYK3, 15-337 RDYK4, 237 RDYLST, MSWHAT /-5 MSSTOP /-4 MSREADY /-3 MSIN /-2 MSERROR /-1 MSDELETED /0 MSNAME /1 MSWHAT, TEXT "WHAT?_" MSSTOP, TEXT "_STOP_" MSREADY, TEXT "_READY_" MSIN, TEXT "IN " /ON ANY ERROR, WE COME HERE. IF THE USER THAT CAUSED THE ERROR /WAS NOT WAITING FOR THE DECTAPE, WE CLEAR HIS INPUT WAIT BIT, SET /HIS ERROR BIT, AND LEAVE. IF HIS DECTAPE WAIT BIT IS ON, HE /EITHER ALREADY HAS THE DECTAPE , OR HE IS WAITING ON THE QUEUE. /SINCE HE IS WAITING, THE ERROR COULD ONLY HAVE BEEN CAUSED /BY AN INTERRUPT - ^C, KEYBOARD BUFFER FULL, OR THE LIKE. IF HE /IS AT THE TOP OF THE QUEUE, WE ASSUME HE HAS THE DECTAPE, AND /DON'T BOTHER HIM HERE EXCEPT FOR HIS INPUT WAIT AND ERROR BITS. /IF HOWEVER, HE WAS PUT TO SLEEP BY DTGRAB, AND IS STILL WAITING /TO GET AT THE DECTAPE ROUTINE, IT WOULD BE A SHAME TO MAKE HIM /WAIT FOR ALL THE USERS AHEAD OF HIM IN THE QUEUE (WHICH COULD BE /AS MANY AS SEVEN SEEKS FROM ONE END OF THE TAPE TO THE OTHER) /JUST TO FIND OUT THAT HE WAS TRYING TO CANCEL THE OPERATION ANYWAY. /IN THAT CASE, WE TURN OFF HIS DECTAPE WAIT BIT AND SQUISH HIM OUT /OF THE DECTAPE QUEUE. UNFORTUNATELY DTFREE WILL ONLY REMOVE HIM /IF HE IS ALREADY AT THE TOP OF THE QUEUE. IERDTA, 0 TAD I ITEMP2 DCA IERR1 /POINTER TO STATUS TAD I IERR1 AND Z1000 /DECTAPE WAIT? SNA CLA JMP IEREND /NO - RETURN TAD I [DECK CMA DCA IERR2 /-(USER#+1) TAD I ZDTQ1 DCA IERR3 /POINTER INTO QUEUE TAD I IERR3 /IS HIS ENTRY AT THE TOP? TAD IERR2 SNA CLA JMP IEREND /YES - RETURN /HERE'S WHERE WE SQUISH THE QUEUE IERLP, DCA IERR4 TAD I IERR3 /SWITCH QUEUE ENTRY WITH IERR4 BY WAY OF IERR5 DCA IERR5 TAD IERR4 DCA I IERR3 TAD IERR5 /IS THIS QUEUE ENTRY OUR USER? TAD IERR2 SNA CLA JMP IERFIN /YES - GO FINISH UP ALREADY TAD IERR3 /NO - POINT TO NEXT QUEUE ENTRY IAC AND I7607 DCA IERR3 TAD IERR5 /GO SWITCH WITH NEXT ENTRY JMP IERLP IERFIN, TAD I ZDTQ1 /INCREMENT QUEUE POINTER IAC AND I7607 DCA I ZDTQ1 TAD I IERR1 /TURN OFF DECTAPE WAIT AND Z6777 DCA I IERR1 IEREND, TAD I IERR1 /TURN OFF KEYBOARD WAIT AND I3767 TAD Z10 /AND TURN ON ERROR BIT. DCA I IERR1 CIF JMP I IERDTA /RETURN ITEMP2, TEMP2 IERR1, 0 /POINTS TO HIS STATUS IERR2, 0 /COMPLEMENTED USER # IERR3, 0 /POINTER INTO QUEUE IERR4, 0 /TEMP LOC FOR SQUSH IERR5, 0 /DITTO I7607, 7607 I3767, 3767 PAGE *.+1 PAGE /AN EXTRA PAGE (OR SO) FOR PATCHES ORG1=. /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 *20 USRPTR, USRLST CORPTR, 0 USRPT2, 0 CORPT2, 0 BEGUSR, 0 CURFLD, 0 BEGDEV, 0 USRCTR, 0 SS, 0 BEGCOR, 0 KLTOP, 0 KLSCH, 0 OS8PTR, 0 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 POINT FOR INITIALIZATION* BEGIN, NOP /SO WE CAN CHAIN BACK TO OURSELF KCC JMS I (SYSINI BEGINB, 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 OS/8 DEVICE JMP I (BEGMV0 /DO NOT SET UP ANY THING OS8KSK, CLA JMP OS8DSK OS8DSK, IAC OS8DTA, IAC OS8RK8, IAC TAD (OS8LST-1 DCA OS8PTR CDF 20 TAD I OS8PTR DCA OS8PTR /POINT TO BOOTSTRAP JMS I (BEG003 OS8MSG /OS/8 MESSAGE JMS I (BEG003 OS8AB, OS8M1 JMS I (BEG003 OS8M2 JMP I (BEGMV0 OS8LST, OSDRK8 OSDDTA OSDDSK USR=7700 /ENTRY POINT TO OS/8 USR FETCH=1 /FETCH DEVICE HANDLER L00KUP=2 /LOOK UP BLOCK NUMBER OF FILE CHA1N=6 /CHAIN TO PROGRAM ON "SYS:" ERRLDR, JMS I (BEG003 /COULDN'T FIND HANDLER OR W.L. LDRERR JMS I (BEG003 LDRER2 CIF CDF 0 JMP I (7605 /RETURN TO OS/8 ERRCHN, JMS I (BEG003 CHNERR JMP ERRLDR+2 BEG708, CIF 10 JMS I (USR /LOAD HANDLER AND FETCH /GET NUMBER OF DEVICE "SYS" DEVICE SYS SYSNO=.-1 4001 /NO NEED TO SAVE THE AREA FOR THE HANDLER JMP ERRCHN /ERROR - CAN'T CHAIN TAD SYSNO /LOAD DEVICE NUMBER CIF 10 JMS I (USR L00KUP BLOCK0, EDUNAM 0 JMP ERRCHN /ERROR - EDU25 NOT ON "SYS" TAD BLOCK0 /MOVE BLOCK NUMBER DCA STCHN /FOR USE BY CHAIN CIF 10 JMS I (USR CHA1N STCHN, 0 EDUNAM, FILENAME EDU25.SV /CALLING SEQUENCE / JMS I (BEG01Q / MSGADR /ADDRESS OF MESSAGE TO BE PRINTED / JMP NO /RETURNS HERE IF ANSWER IS "N" / JMP YES /RETURNS HERE IF ANSWER IS "Y" BEG01Q, 0 /ASK QUESTION - GET ANSWER TAD I BEG01Q /SKIP IF YES, NOT IF NO ISZ BEG01Q /OTHERWISE GIVE ERROR AND REPEAT QUESTION DCA .+2 JMS I (BEG003 0 JMS I (BEG001 TAD (-"Y SNA JMP BEG1QR TAD ("Y-"N SNA CLA JMP BEG1QR+1 JMS I (BEG003 BEGME JMP BEG01Q+4 BEG1QR, ISZ BEG01Q JMP I BEG01Q PAGE BEGMV0, 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, TAD (BEG009 DCA BEGXR1 TAD (KL8JM0 DCA BEGXR2 JMS BEG008 TAD (KL8JMP DCA BEGXR2 JMS BEG008 CDF 20 KCC TAD (BEGIOT DCA BEG012 TAD (-7 DCA BEG013 TAD (120 DCA I BEG012 ISZ BEG012 ISZ BEG013 JMP .-4 JMS I (BEG003 BEGM1 /INIT MESSAGE BEG006, JMS I (BEG003 BEGM2 /# USER MESSAGE JMS I (BEG001 TAD (-"8 SMA SZA JMP I (BEG005 TAD (10 SPA SNA JMP I (BEG005 CIA DCA BEGUSR JMP I (BEGX08 CORDON, TAD SIZFUJ /FUDGE CORE SIZE BY ADDING SOMETHING PATCHABLE TAD BEGCOR DCA BEGCOR CDF 20 TAD BEGUSR IAC SNA CLA JMP BEG010 JMS I (BEG01Q BEGM4 /DC02? BEG010, L7777 /BEGDEV=-1 IF NOT DC02 DCA BEGDEV /BEGDEV= 0 IF DC02 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 BEG008, 0 /UNPATCH SCHEDULER AND INTERRUPT ROUTINE L7775 /IN CASE WE COME HERE FROM A ^C DCA BEG013 CDF 20 TAD I BEGXR1 ISZ BEGXR1 CDF DCA I BEGXR2 ISZ BEGXR2 ISZ BEG013 JMP .-7 JMP I BEG008 BEG12A, 400 BEG012, 0 BEG013, 0 BEGIN1, ERRLST BEGIN2, ERRLST-ERREND BEGXR1, 0 BEGXR2, 0 SIZFUJ, 0 /PATCH THIS LOCATION TO USE LESS THAN MAXIMUM CORE PAGE BEG015, TAD BEGUSR IAC SNA CLA JMP I (BEG15I /ONE USER BEG15E, /SEE BEG15I FOR EXPLANATION / TAD (BEGM7B-1 /"REMOTE" / JMS I (BEGMFX JMS I (BEG01Q BEGM7 /STANDARD? SKP JMP I (BEG15I /MULTIPLE USER - STANDARD BEG15A, TAD BEGUSR DCA BEG15B TAD (BEGIOT DCA BEG15C TAD (4361 /TEXT "#1" DCA I (BEGM5A BEG15D, ISZ BEG15B SKP JMP I (BEG15H JMS BEG014 BEGM5 TAD SS TAD (10 DCA I BEG15C ISZ BEG15C ISZ I (BEGM5A JMP BEG15D BEG15C, 0 BEG15B, 0 BEG014, 0 TAD I BEG014 ISZ BEG014 DCA .+2 JMS I (BEG003 0 JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RTL RTL DCA SS JMS I (BEG001 TAD (-"7 SMA SZA JMP I (BEG016 TAD (7 SPA JMP I (BEG016 CLL RTL RAL TAD SS DCA SS JMP I BEG014 /FIGURE OUT HIGHEST CORE FIELD FOR HIM BEGX08, L0001 DCA BEGCOR /FIELD 1 TOP TO START WITH TAD (6221 DCA BEGCHK TAD CNOP CDF DCA I (0 CDF 10 TAD CNOP DCA I (0 BEGCHK, 0 TAD (1000 DCA I (0 CNOP, NOP TAD I (0 SKP /PDP-8 NXM BUG HLT /THIS SHOULD HAUL DOWN A PDP-8 CDF 10 /DOUBLE CHECK FOR PDP-8/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 BEG009, NOPUNCH *KL8JM0 ENPUNCH CIF TAD LOOKST DCA LOOK NOPUNCH *KL8JMP ENPUNCH TAD SAVLK CLL RAL TAD SAVAC NOPUNCH *BEG009+6 ENPUNCH BEG016, JMS BEG003 BEGME JMP I (BEG014+4 BEG005, JMS BEG003 BEGME JMP I (BEG006 BEG001, 0 KSF JMP .-1 KRB TAD (-203 SNA JMP I (BEG708 /CHAIN TO EDU25 FOR ^C TAD (203 TLS TSF JMP .-1 AND (177 TAD (200 JMP I BEG001 BEGMF1, 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 BEGMF2, 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 /SEE BEG15I FOR EXPLANATION //MOVE IN MIDDLE OF BEGM7 /BEGMFX, 0 / DCA BEGMF1 / TAD (BEGM7A-1 / DCA BEGMF2 / TAD (-4 / DCA CORPTR / ISZ BEGMF1 / ISZ BEGMF2 / TAD I BEGMF1 / DCA I BEGMF2 / ISZ CORPTR / JMP .-5 / JMP I BEGMFX PAGE /COMMENTED CODE WILL GENERATE DEVICE CODES FOR THE IDIOT, BUT /IT IS EASIER TO HAVE HIM TELL US THAN TO TRY TO EXPLAIN TO HIM /WHEN WE CAN GENERATE HIS CODES. //STANDARD USED CODES BEG15I, / JMS BEG15G /MOVE IN USED IOT'S / TAD (BEGM7C-1 /"UNUSED" / JMS I (BEGMFX / JMS I (BEG01Q / BEGM7 /"STANDARD UNUSED TTY CODES?" / JMP BEG15K /NO - GET CODES FROM TTY / TAD (6305 /YES - GENERATE THEM FROM 30 THRU 56 / DCA SS / JMP BEG15L /INSERT IF CODE NOT USED /BEG15M, TAD SS / TAD (20 /INCREMENT / DCA SS / TAD SS / TAD (-6605 / SZA CLA /LAST? / JMP .-7 /NO - LOOP / JMP BEG011 /DONE / / //INSERT IF IOT UNUSED /BEG15L, TAD SS / CIA / DCA BEG15G / TAD BEGUSR / DCA USRCTR / TAD CORPT2 / DCA CORPT2 / TAD BEG15G / TAD I CORPTR / SNA CLA / JMP BEG15M / ISZ CORPTR / ISZ USRCTR / JMP .-6 / TAD SS / JMS BEG15F / JMP BEG15M /NON-STANDARD USED CODES BEG15H, JMS BEG15G /MOVE IN USED IOT'S / TAD (BEGM7D-1 / JMS I (BEGMFX /"UNUSED" JMS I (BEG01Q / BEGM7A /"UNUSED TTY CODES?" BEGM9 /"ANY UNUSED TERMINALS?" JMP BEG011 /NO - DONE JMP .+4 BEG15K, JMS I (BEG01Q BEGM8 /"MORE?" JMP BEG011 /NO JMS I (BEG014 BEGM10 /"DEVICE CODE?" TAD SS TAD (6005 JMS BEG15F /INSERT IN PATCH JMP BEG15K /INSERT WORD INTO PATCH BEG15F, 0 DCA I KLTOP L7777 TAD KLTOP DCA KLTOP JMP I BEG15F /MOVE IOT'S FROM BEGIOT TO PATCH BEG15G, 0 CLA CLL IAC BSW /IS IT AN 8/E? TAD (-100 SZA CLA JMP I (BEGCK0 TAD (KL8FIX-1 DCA KLTOP TAD BEGUSR DCA USRCTR TAD (BEGIOT-1 DCA CORPTR TAD I CORPTR TAD (6005-10 JMS BEG15F ISZ CORPTR ISZ USRCTR JMP .-5 TAD KLTOP DCA KLSCH /SAVE ENTRY ADDRESS FOR SCHEDULER L0001 TAD KLTOP DCA CORPT2 TAD .-3 /INSERT L0001 JMS BEG15F TAD (KL8INT&177+5200 /INSERT JMP KL8INT JMS BEG15F JMP I BEG15G BEG011, TAD (CLA DCA I KLTOP BEGCK0, TAD BEGUSR IAC SNA CLA JMP I (BEGOLD /ONLY 1 USER, ASSUME ANSWER! JMS I (BEG01Q BEGMQ /SAME AMT OF STG FOR ALL USERS? JMP I (BEG500 /NO - GO ASK HIM JMP I (BEGOLD /YES - ALLOCATE IT FOR HIM 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 DCA CURFLD JMS I (BEG003 BEGMFL TAD (60 TAD CURFLD TLS CLA TSF JMP .-1 L7776 TAD CURFLD SPA JMP I (BEGXYZ /FUDGE FIELD 1 SNA CLA TAD BEGUSR /DELETE ONE BLOCK PER USER IN FIELD 2 TAD (20 /FOR USE AS DECTAPE BUFFERS 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 USER NUMBER DCA I USRPTR TAD BEGUSR TAD I USRPTR SMA SZA CLA JMP BEGER1 /NON-EXISTENT 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 DECIMAL CLL RAL RTL TAD OLNUM TAD OLNUM TAD NUNUM /PLUS NEW DIGIT DCA OLNUM /MAKES NEW NO JMP BEGINP DN, TAD OLNUM SNA SPA SZL JMP BEGER2 /JUNKY NO CIA TAD LBLK SPA JMP BEGER0 /TOO MUCH ASKED FOR DCA LBLK /NEW AMOUNT REMAINING TAD OLNUM ISZ USRCTR SKP JMP BEGR2 DCA I USRPTR ISZ USRPTR TAD LBLK SZA CLA /MORE TO COME IN THIS FIELD? JMP BEGXXX /SURE IS L7777 TAD CURFLD 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 JMP I (BEG540 /TO BED HUNGRY FOR IT EVERY NIGHT PAGE BEG540, CLA CLL IAC BSW TAD (-100 SZA CLA JMP BEG550-3 /NOT AN 8/E TAD BEGDEV SNA CLA JMP BEG550-1 /THE FOOL HAS AN 8/E WITH DC02 CDF TAD KLSCH DCA I BEGKL5 TAD KLTOP DCA I BEGKL6 CDF 20 TAD KL8FRST SZA CLA /FIRST TIME THROUGH JMP BEG550 /NO ISZ KL8FRST /SIGNIFY DONE ISZ BEGKL2 TAD I BEGKL1 DCA I BEGKL2 ISZ BEGKL1 /MOVE PATCH TO PROPER POSITION JMP .-4 CDF TAD (CIF 20 DCA I BEGKL3 ISZ BEGKL3 TAD (KL8JMP+2&177+5600 DCA I BEGKL3 TAD (CIF 20 DCA I BEGKL4 ISZ BEGKL4 TAD (KL8JM0+2&177+5600 DCA I BEGKL4 CDF 20 TAD KLTOP JMP BEG550-1 /SET TOP OF FIELD 2 BEGKL1, KL8LOD BEGKL2, KL8FIX-1 KL8FRST, 0 BEGKL3, KL8JMP BEGKL4, KL8JM0 BEGKL5, KL8JM0+2 BEGKL6, KL8JMP+2 CDF 10 DCA I (INTRRV /NOT AN 8/E DCA KLTOP BEG550, CDF 20 TAD (USRLST /NOW WE SORT FOR FIELDS TO MAKE IT EASY DCA USRPTR TAD (3 TAD (USRLST DCA CORPTR TAD BEGUSR DCA USRCTR DCA SS /SORT SWITCH FOR MODIFIED BUBBLE SORT BEG551, TAD USRPTR IAC DCA USRPT2 TAD CORPTR IAC DCA CORPT2 ISZ USRCTR SKP JMP BEG553 TAD I USRPT2 CIA TAD I CORPT2 SNA SPA CLA /DECREASING SORT ON FIELDS JMP BEG552 L7775 DCA SS /3 SWAP TAD I USRPTR DCA BEG554 TAD I CORPTR DCA I USRPTR TAD BEG554 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 BEG554, 0000 PAGE BEG600, TAD (BEGLST DCA USRPT2 TAD (USRLST DCA USRPTR TAD BEGUSR DCA USRCTR L7777 DCA BEG603 TAD I (USRLST+1 BEG610, DCA CURFLD DCA BEG602 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 /FIELD 2? TAD CURFLD SZA CLA JMP .+6 ISZ BEG603 JMP .+4 L7776 TAD KLTOP JMP .+3 L7776 TAD BEG602 DCA I USRPT2 ISZ USRPT2 TAD SS CIA TAD BEG602 DCA BEG602 TAD BEG602 DCA I USRPT2 ISZ USRPT2 ISZ USRCTR JMP NXUSR L7777 TAD CURFLD /WAS LAST USER IN FIELD 1? SZA CLA JMP I (BEG700 L7777 /YES - DROP HIS LOWER BOUNDRY TAD USRPT2 /TO END OF LAST SWAP AREA DCA BEG602 JMS BEGF1S DCA I BEG602 JMP I (BEG700 BEG602, 0 /TOP BEG603, 0 /SWITCH FOR FIRST FIELD 2 USER 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 BEGXYZ, JMS BEGF1S /CALCULATE NUMBER OF BLOCKS IN FIELD 1 CIA /SUBTRACT FROM 4K AND (7400 /ROUND DOWN TO NEAREST INTEGRAL BLOCK CLL RAL RTL RTL DCA LBLK /TO GET NUMBER OF BLOCKS JMP I (BEGXXX BEGF1S, 0 /CALCULATE SIZE OF EDU25 IN FIELD 1 CLA TAD BEGUSR DCA LBLK TAD (SWAPR /ADD SIZE OF ALL SWAP REGIONS ISZ LBLK JMP .-2 TAD (ORG1 /TO AREA ALREADY TAKEN UP BY EDU25 JMP I BEGF1S PAGE BEG700, TAD (BEGLST DCA USRPTR DCA SS TAD BEGUSR DCA USRCTR TAD (4 TAD (BEGLST DCA USRPT2 BEG7X1, ISZ USRCTR SKP JMP BEG703 TAD I USRPTR CIA TAD I USRPT2 SNA JMP I (BEGER0 /MULTIPLE ASSIGNMENTS FOR ONE USER SMA CLA /ASCENDING SORT ON USER NUMBERS JMP BEG702 TAD (-4 DCA SS BEG701, TAD I USRPTR DCA CORPTR TAD I USRPT2 DCA I USRPTR TAD CORPTR DCA I USRPT2 ISZ USRPTR ISZ USRPT2 ISZ SS JMP BEG701 ISZ SS TAD (-4 BEG702, TAD USRPT2 DCA USRPTR TAD (4 TAD USRPTR DCA USRPT2 JMP BEG7X1 BEG703, TAD SS SZA CLA JMP BEG700 /MORE TO COME TAD (BEGLST DCA USRPTR /NOW TAKE OUT USER NOS. TAD BEGUSR DCA USRCTR IAC TAD (BEGLST DCA USRPT2 BEG704, L7775 DCA SS TAD I USRPT2 DCA I USRPTR ISZ USRPTR ISZ USRPT2 ISZ SS JMP .-5 ISZ USRPT2 /SKIP OVER USER NO. ISZ USRCTR JMP BEG704 JMS I (BEG01Q BEGM6A JMP I (BEG708 /OH NO--ALL THIS FOR NOTHING! /ALL'S WELL - PRINT "END OF DIALOGUE" AND MOVE IN OS/8 BOOTSTRAP / AND PAGE 7600 INTO FIELD 0 JMS I (BEG003 BEGM6 BEGMV4, CDF 10 TAD I BEGMV1 /MOVE PAGE 37 FIELD 0 INTO ITS SPOT CDF DCA I BEGMV2 ISZ BEGMV1 ISZ BEGMV2 ISZ BEGMV3 JMP BEGMV4 OS8LP1, CDF 20 TAD I OS8PTR ISZ OS8PTR CDF DCA I OS8PT2 ISZ OS8PT2 JMP OS8LP1 JMP I (BEG750 OS8PT2, 7756 /INTO RIM LOCATIONS BEGMV1, MVPAG BEGMV2, 7600 BEGMV3, -156 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 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 TAD (10 DCA I (AUSER CDF 20 TAD BEGDEV SNA CLA JMP BEG76X CDF DCA I (XOUTL6+3 DCA I (XOUTL6-3 DCA I (INTRP2-2 DCA I (INTRP2+4 DCA I (INTRP5 DCA I (INTRP5+1 CDF 10 DCA I (INTRV2+1 JMP I (BEG800 BEG76X, TAD (17 MTON L0001 MINT CLA /TURN ON INTERRUPTS CDF 10 TAD (TLS DCA I (INTRRV TAD (MTLS DCA I (INTRV2+2 JMP I (BEG800 BEG60X, 0 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 IAC DCA I USRPTR /USER NUMBER ISZ USRPTR TAD I SS CLL RTR RTR RTR AND (7 /SET FIELD DCA I USRPTR ISZ USRPTR TAD I SS AND (17 IAC DCA I USRPTR /NUMBER OF BLOCKS ISZ SS ISZ USRPTR ISZ USRCTR JMP BEGOL1 JMP I (BEG540 /CONTINUE ON...WE'VE ANSWERED QUESTIONS FOR HOM NOW. BGLD1, BGL28 BGL27 BGL26 BGL25 BGL24 BGL23 BGL22 BGL21 BGL38 BGL37 BGL36 BGL35 BGL34 BGL33 BGL32 BGL31 BGL48 BGL47 BGL46 BGL45 BGL44 BGL43 BGL42 BGL41 BGL58 BGL57 BGL56 BGL55 BGL54 BGL53 BGL52 BGL51 BGL68 BGL67 BGL66 BGL65 BGL64 BGL63 BGL62 BGL61 BGL78 BGL77 BGL76 BGL75 BGL74 BGL73 BGL72 BGL71 0040 BEGIOT, 0120 0120 0120 0120 0120 0120 0120 PAGE X=100 /THE ENTRIES IN THIS TABLE ARE AS FOLLOWS: /LABELS INDICATE NUMBER OF FIELDS AND NUMBER OF USERS. / E.G. THE ENTRIES AT BGL32 ARE USED TO ALLOCATE / A 2 USER SYSTEM IN A 16K (HIGHEST FIELD=3) / MACHINE. /THERE IS ONE ENTRY FOR EACH USER IN THE CONFIGURATION. /EACH ENTRY CONTAINS THE FOLLOWING INFORMATION: / USER NUMBER MINUS ONE / USER FIELD / NUMBER OF BLOCKS MINUS ONE FOR THIS USER /E.G. THE ENTRIES AT BGL32 ARE: / BGL32, 03^X+17 / 12^X+15 /THIS INDICATES: / USER 1 IS IN FIELD 3 WITH 20 BLOCKS / USER 2 IS IN FIELD 2 WITH 16 BLOCKS BGL21, 02^X+16 BGL31, BGL41, BGL51, BGL61, BGL71, 03^X+17 BGL22, 02^X+6 12^X+6 BGL32, 03^X+17 12^X+15 BGL42, BGL52, BGL62, BGL72, 04^X+17 13^X+17 BGL23, 02^X+6 12^X+5 21^X+3 BGL33, 02^X+14 13^X+7 23^X+7 BGL43, 04^X+17 13^X+17 22^X+14 BGL53, BGL63, BGL73, 05^X+17 14^X+17 23^X+17 BGL24, 02^X+3 12^X+3 22^X+3 31^X+3 BGL34, 03^X+7 13^X+7 22^X+5 32^X+5 BGL44, 03^X+17 12^X+13 24^X+7 34^X+7 BGL54, 05^X+17 14^X+17 23^X+17 32^X+13 BGL64, BGL74, 06^X+17 15^X+17 24^X+17 33^X+17 BGL25, 02^X+2 12^X+2 22^X+2 31^X+2 42^X+1 BGL35, 03^X+5 12^X+5 23^X+4 33^X+4 42^X+4 BGL45, 02^X+12 14^X+7 24^X+7 33^X+7 43^X+7 BGL55, 05^X+17 14^X+17 22^X+12 33^X+7 43^X+7 BGL65, 06^X+17 15^X+17 24^X+17 33^X+17 42^X+12 BGL75, 07^X+17 16^X+17 25^X+17 34^X+17 43^X+17 BGL26, 01^X+2 12^X+1 22^X+1 32^X+1 42^X+1 52^X+1 BGL36, 03^X+5 13^X+4 23^X+4 32^X+4 42^X+4 51^X+2 BGL46, 04^X+7 14^X+7 23^X+7 33^X+7 42^X+4 52^X+4 BGL56, 05^X+17 12^X+11 24^X+7 34^X+7 43^X+7 53^X+7 BGL66, 06^X+17 15^X+17 24^X+17 32^X+11 43^X+7 53^X+7 BGL76, 07^X+17 16^X+17 25^X+17 34^X+17 43^X+17 52^X+11 BGL27, 02^X+1 12^X+1 22^X+1 32^X+1 41^X+1 52^X+0 61^X+0 BGL37, 02^X+4 13^X+3 23^X+3 33^X+3 43^X+3 52^X+3 61^X+2 BGL47, 04^X+7 14^X+7 23^X+5 33^X+4 43^X+4 52^X+4 62^X+3 BGL57, 02^X+10 15^X+7 25^X+7 34^X+7 44^X+7 53^X+7 63^X+7 BGL67, 06^X+17 15^X+17 22^X+10 34^X+7 44^X+7 53^X+7 63^X+7 BGL77, 07^X+17 16^X+17 25^X+17 34^X+17 42^X+10 53^X+7 63^X+7 BGL28, 02^X+1 12^X+1 21^X+1 31^X+0 42^X+0 52^X+0 62^X+0 72^X+0 BGL38, 03^X+3 12^X+3 22^X+3 33^X+2 43^X+2 53^X+2 63^X+2 71^X+1 BGL48, 02^X+7 14^X+5 24^X+4 34^X+4 43^X+3 53^X+3 63^X+3 73^X+3 BGL58, 04^X+7 14^X+7 23^X+7 33^X+7 42^X+7 55^X+5 65^X+4 75^X+4 BGL68, 06^X+17 15^X+7 25^X+7 34^X+7 44^X+7 53^X+7 63^X+7 72^X+7 BGL78, 07^X+17 16^X+17 25^X+17 34^X+7 44^X+7 53^X+7 63^X+7 72^X+7 PAGE BEG800, CDF 20 TAD I BEG804 JMS I (BEG900 TAD (-4 JMS BEGZER TAD (READY JMS I (BEG900 TAD (-10 JMS BEGZER L7777 JMS I (BEG900 JMS I (BEG900 TAD I BEG805 TAD (6006-10 JMS I (BEG900 TAD I BEG802 JMS I (BEG900 TAD (-5 JMS BEGZER TAD (BUFFER TAD I BEG803 JMS I (BEG900 TAD (BUFFER TAD I BEG803 JMS I (BEG900 TAD (BUFFER TAD I BEG803 JMS I (BEG900 TAD (BUFFER-40 TAD I BEG803 JMS I (BEG900 TAD (BUFFER-40 TAD I BEG803 JMS I (BEG900 L7775 JMS BEGZER TAD (LINE1 TAD I BEG803 JMS I (BEG900 TAD (LINE1 TAD I BEG803 JMS I (BEG900 TAD I BEG804 JMS I (BEG900 TAD (LINE0 TAD I BEG803 JMS I (BEG900 TAD (BUFCOM TAD I BEG803 JMS I (BEG900 JMS I (BEG900 JMS I (BEG900 TAD (1617 /"NO" JMS I (BEG900 TAD (1605 /"NE" JMS I (BEG900 JMS I (BEG900 TAD (560 /"E0" JMS I (BEG900 TAD (XREADC JMS I (BEG900 TAD (XPRNTC JMS I (BEG900 TAD (XFREE2 JMS I (BEG900 TAD (XFREE3 JMS I (BEG900 TAD BEGBAS JMS I (BEG900 TAD BEGBAS TAD (400 DCA BEGBAS TAD (-12 JMS BEGZER L0001 JMS I (BEG900 TAD (0203 JMS I (BEG900 TAD (5555 JMS I (BEG900 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 BEG802, BEGLST BEG803, BEGLST+2 BEG804, BEGLST+1 BEG805, BEGIOT-1 BEGBAS, 0000 /BUFFERS BEGIN AT 0 IN FIELD 2 BEGZER, 0 DCA BEGZCT JMS I (BEG900 ISZ BEGZCT JMP .-2 JMP I BEGZER BEGZCT, 0 PAGE BEGLST, 0 PAGE BEG801, ORG1 /KLUDGE TO MAKE EXTRA ROOM BEG900, 0 CDF 10 DCA I BEG801 CDF 20 ISZ BEG801 JMP I BEG900 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__" BEGME, TEXT %_INVALID RESPONSE_% BEGM1, TEXT %__EDUSYSTEM 25 BASIC__% BEGM2, TEXT %_NUMBER OF USERS (1 TO 8)?% BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% BEGM5, TEXT %_TELETYPE #1 DEVICE CODE?% BEGM5A=BEGM5+5 BEGM7, TEXT %_STANDARD REMOTE TELETYPE CODES (Y OR N)?% /BEGM7A=BEGM7+4 /BEGM7B, TEXT %D REMOTE% /*.-1 /BEGM7C, TEXT %D UNUSED% /*.-1 /BEGM7D, TEXT % _UNUSED% /*.-1 BEGMFL, TEXT %_FIELD% BEGMXX, TEXT %_THERE ARE % BEGMX1, TEXT % BLOCKS LEFT IN THIS FIELD._ YOUR ALLOCATION FOR USER #% BEGTTI, TEXT % WILL BE HOW MANY BLOCKS?% BEGM6, TEXT %__END OF DIALOGUE_% WNGDM, TEXT %_BLOCK SIZES DON'T WORK--HAVE TO START AGAIN__% BEGMQ, TEXT %_STANDARD USER STORAGE ALLOCATION (Y OR N)?% BEGM6A, TEXT %_IS THE ABOVE CORRECT (Y OR N)?% BEGM8, TEXT % MORE?% BEGM9, TEXT %_ANY UNUSED TERMINALS (Y OR N)?% BEGM10, TEXT %_DEVICE CODE?% LDRERR, TEXT %_"EDU" NOT ASSIGNED TO 0S/8 DEVICE_OR IT'S WRITE LOCKED% LDRER2, TEXT %__RETURNING TO OS/8_% CHNERR, TEXT %_"SYS:EDU25.SV" NOT FOUND% BEGMRK, TEXT %__IS THE SYSTEM DEVICE AN RK8E (Y OR N)?% PAGE LINK=XENTER+1 PLINK, SETPT ISZ ENTRIES SKP JMP LINKF /TAPE FULL LINK2, TAD I XR1 SNA CLA JMP .+3 TAD (3 BUMPXR TAD I XR1 CIA TAD BLOCK DCA BLOCK ISZ ENTRIES JMP LINK2 /IGNORE ALL BUT THE LAST ENTRY TAD I XR1 /SEE IF IT'S AN EMPTY SZA CLA JMP LINKF /ITS NOT TAPE FULL TAD I XR1 /IT IS, SEE IF ITS BIG ENOUGH DCA LINKS /SAVE SIZE OF EMPTY TAD LINKS CLL TAD TEMPX1 SZL CLA JMP LINKF /ITS NOT BIG ENOUGH TAD I (CATBLK /SEE IF ON THE LAST BLOCK TAD (-14 SZL CLA JMP LINKF /NO WHERE TO LINK TO L0002 TAD I (CATBLK CLL RAR DCA I (DIRBUF+2 /LINK THE BLOCK ISZ I (DIRBUF /RESET # ENTRIES TAD BLOCK DCA LBLOCK /SAVE BLOCK GETCAT HITS IT CLL TAD I (CATBLK GETCAT /WRITE IT OUT TAD LBLOCK DCA I (DIRBUF+1 /SET UP STARTING BLOCK NUMBER DCA I XR1 /MAKE AN EMPTY TAD LINKS DCA I XR1 /OF THE RIGHT SIZE STA DCA I (DIRBUF /1 ENTRY FOR THIS BLOCK DCA I (DIRBUF+2 /ZERO LINK L0002 TAD I (CATBLK GETCAT /L=0 SO WRITE CALL CENTER^2 MLOOP /GOOD LINK RETURN TO MLOOP LINKF, CALL CENTER^2 ENTERF /FAILURE RETURN LBLOCK, 0 LINKS, 0 GCATS, 0 PAGE SYSINI, 0 JMP I SYSINI CENTER=27 CLINK=30 *7200 FINISH, CDF 20 TAD I XPNT /GET ADDRESS OF TOP OF SWAP REGION DCA XPNT CDF 10 DCA I XPNT /CLEAR THIS STUFF ISZ XPNT JMP .-2 CDF 20 TAD KLTOP CIA TAD FIN001 DCA XPNT DCA I FIN001 ISZ FIN001 NOP ISZ XPNT JMP .-4 FIN002, TAD BGCORS CLL RTL RAL TAD FINCDF DCA XCDF XCDF, 0 DCA I XPNT /CLEAR FIELD ISZ XPNT JMP .-2 L7777 TAD BGCORS DCA BGCORS L7777 TAD BGCORS SZA CLA JMP FIN002 /ANOTHER FIELD TO WIPE STILL FINENT, CIF CDF JMP I .+1 ENTRY FINCDF, CDF XPNT, BEG801 FIN001, FIN003 BGCORS, 0 FIN003, /PRECEDING THIS CODE IN FIELD 2 IS THE FOLLOWING: / CLA /ENTRY FROM INTERRUPT ROUTINE / 6XX5 /UNUSED CODES / . / . / . / JMP KL8INT / L0001 /ENTRY FROM SCHEDULER / 6XX5 /USED CODES / . / . / . / *7755 KL8LOD, /FIX THE POINTERS EVENTUALLY KL8FIX, CLA MQA IAC MQL CIF CDF IOF /DISABLE INTRPT TEMPORARILY (UNTIL LOOK IS ISZ'D) TAD I PLOOKS /RESET POINTER DCA I PLOOK JMP I .+1 /INTERRUPT ON AGAIN AFTER THIS JUMP KL8LF0 /BACK TO SCHEDULER KL8INT, TAD I PSAVLK /RESTORE LINK CLL RAL TAD I PSAVAC /RESTORE AC CIF CDF JMP I .+1 KL8LFL /BACK TO INTERRUPT ROUTINE PSAVLK, SAVLK PSAVAC, SAVAC PLOOKS, LOOKST PLOOK, LOOK PAGE $