/EDUSYSTEM 25 / /DEC-S8-ED25B-B-LA / /THE INFORMATION IN THIS LISTING IS SUBJECT TO CHANGE WITHOUT /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL /EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO /RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS LISTING. / /THE SOFTWARE DESCRIBED IN THIS LISTING IS FURNISHED TO THE /PURCHASER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM /AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S COPYRIGHT /NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE /BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR /THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT /IS NOT SUPPLIED BY DIGITAL. / /COPYRIGHT (C) 1972,1973,1975 BY DIGITAL EQUIPMENT CORPORATION. /EDUSYSTEM 25 BASIC /VERSION 03.00 10 MARCH 1975 /MARK BRAMHALL /DIGITAL EQUIPMENT CORP. /BARRY SMITH /STEVE POULSEN /OREGON MUSEUM OF SCIENCE & INDUSTRY /JOHN O'DONNELL /YALE UNIVERSITY /MARK ROSENTHAL /JAMES DEMPSEY /DIGITAL EQUIPMENT CORP. /STEVE JOHNSON /DIGITAL EQUIPMENT CORP. /EDUSYSTEM 25 BASIC IS FOR THE PDP-8/E, -8/F, -8/M, -8/I, -8/L WITH /12K OR MORE MEMORY AND EITHER THE DC02 OR PT08(KL8E) OPTION /AND TC08 DECTAPE CONTROLLER WITH TU56 OR TWO TU55 TRANSPORT(S) /OR RK8E DISK /NOTE: START ADDRESS IS 20200. /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 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 /DECTAPE IOTS. DTXA=6764 DTLB=6774 DTRB=6772 DTRA=6761 DTCA=6762 DTLA=6766 DTSF=6771 /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 KFIND, 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 NPRNT5 /CLEAR FORMAT SWITCH TAD I LOOK /GET STATUS IOF /NO INTERRUPTS JMS DECKON /PUT HIM ONDECK CDCHNG=. /THE FOLLOWING TWO LOCATIONS BECOME / NOP / TAD PC /IF THE CDR IS NOT USED. CPL000=. CPV000=NOP CIF 10 CPL001=. CPV001=TAD PC JMP I XCTRLC /CHECK FOR CTRL/C FROM CARD. CTRLRT, DCA 0 /RESTART LOCATION L7776 /NUMBER OF COMMANDS THEN LOOK DCA PC ION JMP I 0 /GO TO IT... XCTRLC, CTRLCHK 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 NPRNT5 IS NOT 0 THEN LEADING SPACES ARE NOT PRINTED /NPRNT5 IS SET TO 0 AT THE END OF THE ROUTINE ITPRNT, 0 CIF PF JMP I .+1 NITPRNT NPRNT5, 0 /0 TO PRINT LEADING BLANKS NITPRET,JMP I ITPRNT /RETURN POINT, JUMPED TO BY ITPRNT IN PF /COMMAND BUFFER ECHOING ROUTINE /IT IS IN THIS FIELD BECAUSE IT REFERENCES MANY FIELD 0 ROUTINES /CR USER IS ON DECK AT THIS POINT CRBECHO,TAD SPACSW /GET SPACE SWITCH, USED IN GETC PUSHA /SAVE IT'S VALUE ISZ SPACSW /ZERO IS IGNORE SPACES JMS I AOTPACK /SETUP POINTERS FOR GETC SKP /FIRST GETC HAS BEEN ISSUED BY OTPACK GETC /GET CHAR FROM COMMAND BUFFER, STORE IN CHAR FREE2 /MAKE SURE THERE'S ROOM PRINTC /PRINT IT TSTCCR /CR YET? JMP .-4 /NOPE, KEEP GOING POPA /RESTORE SPACSW VALUE DCA SPACSW JMS I AOTPACK /RESTORE POINTERS FOR FUTURE GETC'S POPJ /RETURN FROM PAKLIN AOTPACK, OTPACK /LINK TO CDR COMMAND HANDLER. CDR, CIF 10 JMP I .+1 PFCDR DECKCHK, 0 /ENTRY FROM INTERRUPT HANDLING ROUTINE AND C7700 /CHECK WAIT BITS. SZA CLA JMP I DECKCHK TAD I LOOK JMS DECKON JMP I DECKCHK /*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 SWPCDF 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 SWPCDF 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 STARTO /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 SWPCNT DCA TEMP2 /SWAP COUNT JMP I DFIND STARTP, ENSWAP-STSWAP+1 /SPACE BETWEEN LPCHNG=. LOL000=. LOV000=NCDORG-1-ENSWAP+STSWAP-1 CDCHNG=. COL000=. COV000=LPTORG-1-ENSWAP+STSWAP-1 STARTO, ORG1-1-ENSWAP+STSWAP-1 /THE START OF THE /1ST SWAP AREA MINUS THE LENGTH /OF A SWAP AREA. NCDORG REPLACES ORG1 /AS THE BASE ADDRESS OF THE TABLE IF /THERE IS NO CDR IN USE. SWPCNT, STSWAP-ENSWAP-1 SWPCDF, XUDF+1 /COME HERE ON CTRL/C FROM TERMINAL OR CDR. CDCHNG=. /THE FOLLOWING TWO LOCATIONS BECOME / NOP / NOP /IF A CDR IS NOT USED. CPL100=. CPV100=NOP CDRCTC, CIF 10 CPL101=. CPV101=NOP JMS I AXCT /GO CHECK IF CDR ASSIGNED TO THIS USER. ERR004, JMS I XERR /HANDLE PROGRAM STOPPING. JMP I XKYXIT /GO TAKE EXIT FROM KEY ROUTINE. AXCT, XCT1 XERR, IERROR XKYXIT, SUPRET /COME HERE WHEN LPT COMMAND IS RECOGNIZED. /IMMEDIATELY GO TO BANK 1. LPT, CIF 10 JMP I .+1 LPTCOM /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, TAD PDLST /RESET THE STACK. DCA PDLXR 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 SORTCN TAD M4 DCA LSTMOD TAD LSTMOD SMA SZA JMP ERROR2 /TRUE ERROR SZA CLA L7777 /WHAT? TAD M4 /STOP SKP ERROR2, L7777 JMS I (RDYPCH /PRINT ERROR MESSAGE TAD LSTMOD 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 (RDYPCH 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 (RDYPCH /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 TAD I PACKND TAD KM26 CLL CIA TAD AXIN /IS THE PROGRAM TOO LARGE? SZL CLA JMP I XERR60 /YES. TSTCCR JMP M40+1 JMS I (XDELET /DELETE OLD LINE UDF 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 XERR60, ERR060 KM26, -26 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" JMP I XCDCTC /CHECK CDR AND HANDLE PROGRAM STOP. CDCHNG=. /THE FOLLOWING 2 LOCATIONS ARE CHANGED TO / TAD LSTMOD / SNA /IF A CDR IS NOT USED. CPL200=. CPV200=TAD LSTMOD KEY7, CIF SWAP /GO CHECK FOR CDR ASSIGNED TO THIS USER AND CPL201=. CPV201=SNA JMS I XCDSUP /IF SO SUPPRESS HIS TTY INPUT. /CTRL/C IS NOT SUPPRESSED. IT IS TAKEN /CARE OF PRIOR TO THIS. JMP KEY6 /RETURN HERE IF LSTMOD IS ZERO. CDF SWAP /RETURN HERE IF LSTMOD IS NONZERO. 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 CLA JMP KEY3 /ILLEGAL CHAR CIF 10 /GO CONVERT LOWER CASE ALPHA JMS I XLWMAP /TO UPPER CASE. 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 SUPRET, 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 XLWMAP, LWRMAP XCDSUP, CDRSUP XCDCTC, CDRCTC 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 PAGE /*READ* AND *INPUT* COMMANDS INREAD, 0 SZA CLA JMP INREA3 /RE-ENTRY CIF 10 JMP I .+1 PATINR PUSHJ /GET A VARIABLE GETVAR SZA CLA JMP ERR500 /WAS FUNCTION TAD MODE /SET TO IGNORE LEADING SPACES IF NECESSARY DCA SPACSW TAD LINENO /SAVE THE CURRENT LINE NO. PUSHA 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 POPA /RESTORE THE CURRENT LINE NO. DCA LINENO 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 I XINPT1 /DONE INPUT2, PUSHJ /GET LINE OF INPUT GETINP L7777 JMP INPUT2-2 XINPT1, INPUT1 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 CIF 10 JMP I .+1 /GO TO PATCH THAT CORRECTS A PLOC /STRING COMPARISON ERROR. PRET, 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 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 XNORUM /STACK HAS OVERFLOWED. JMP I PCHK XNORUM, NOROOM /*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 POPJ 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 GETCX1, 0 /ENTRY FOR GETC FROM FIELD 1. GETC CIF CDF SWAP JMP I GETCX1 /PART OF PATCH TO USE READY1. PUSPOP, 0 0 CIF CDF 10 JMP I PUSPOP 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 /DO L/T ISZ PT1 JMP LLIST5 FREE2 TAD CCR PRINTC LLIST3, JMS GETLIN /GET A LINE JMP LLIST4 /WE ARE DONE FREE13 TAD LINENO JMS I CITPRNT /PRINT THE NUMBER GETC FREE2 PRINTC /PRINT THE LINE TSTCCR JMP .-4 /UNTIL A CR JMP LLIST3 /LOOP LLIST4, TAD PT1 SZA CLA JMP I CSAVDON /SEE IF THIS IS A 'SAVE' TAD M100 DCA PT1 LLIST6, FREE2 L4000 PRINTC /DO L/T ISZ PT1 JMP LLIST6 JMP I CTAPE GETLIN, 0 TAD CCR /FAKE OUT GETNXT! DCA CHAR GETNXT /GET NEXT LINE JMP I GETLIN /OUT OF TEXT POPA DCA T3 /GET LIMIT TAD T3 PUSHA /SAVE LIMIT TAD LINENO CIA TAD T3 SMA CLA ISZ GETLIN /OK JMP I GETLIN GETLIM, 0 TSTCCR JMP LIMGT1 /NOT ALL DCA LASTLN /START AT 0 L3777 JMP LIMGT3 LIMGT1, GETLN /GET A LINE NUMBER TAD LINENO DCA LASTLN /AND SAVE IT TSTCOM JMP LIMGT2 /ONLY ONE LINE GETC GETLN /GET LINE NUMBER TAD LINENO LIMGT3, PUSHA /UPPER LIMIT TAD LASTLN DCA LINENO /LOWER LIMIT TSTCCR JMP EDIT+2 /JUNK LIMGT4, FINDLN /FIND THE LINE 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 FIND /FIND A *DEF* FUNC11, 11 /-DEF CODE ERR170, ERROR /OUT OF TEXT CLA COMMAN /GET WORD TAD (-5 /DOES FN FOLLOW THE DEF? SZA CLA JMP FNC11A /NO, SET UP SEARCH FOR NEXT DEF. TAD CHAR /YES, IS THE LETTER AFTER THE FN THE TAD FUNC17 /ONE WE ARE LOOKING FOR? SZA CLA JMP FNC11A /NO, SET UP FURTHER SEARCHING. TAD ERLINE /YES. 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 /COME HERE TO SET UP SEARCHES FOR MORE DEF STATEMENTS. FNC11A, TAD KFNC11 /SET UP RETURN ADDR FOR FIND. DCA I KFIND JMP I .+1 /ENTER FIND AT THE GETNXT STATEMENT. XFIND1 KFNC11, FUNC11 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 LPCHNG=. /IF THERE IS NO LPT THEN THE FOLLOWING 3 LOCATIONS /BECOME: / TAD C10 /SET UP THE OUTPUT IOT. / TAD XIOT / DCA XOUTL6 LPL000=. LPV000=TAD C10 CIF 10 LPL001=. LPV001=TAD XIOT JMP I .+1 LPL002=. LPV002=DCA XOUTL6 LPTCHK LPCKRT, 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 (RDYPCH /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 CDCHNG=./IF A CDR IS NOT USED THEN THE FOLLOWING 3 /LOCATIONS BECOME /XREAD1, L7777 / TAD XREADC / DCA PC /SET TO REDO ROUTINE. CPL300=. CPV300=L7777 XREAD1, CIF 10 CPL301=. CPV301=TAD XREADC JMP I .+1 /CHECK FOR INPUT FROM CARDS. CPL302=. CPV302=DCA PC CRXRD1 XREAD2, 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 MORRUM NOROOM, TAD STARTV DCA LASTV /WIPE OUT VARIABLES--OVERFLOW ERR100, ERROR /NO ROOM MORRUM, 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 (NPRNT5 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 LPCHNG=. /IF AN LPT IS NOT USED THE NEXT 3 LOCATIONS ARE: / DCA FREESV /SAVE XFREE ADDRESS. / DCA USER /START WITH USER ZERO. / DCA TEMP1 /SET NO TTYS TO TURN ON AT FIRST. LPL100=. LPV100=DCA FREESV CIF 10 LPL101=. LPV101=DCA USER JMP I .+1 LPL102=. LPV102=DCA TEMP1 LPTFLG LPFLRT, 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, DECKCHK /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 RDYPCH, 0 CIF 10 JMP I .+1 RDYPC1 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 JMS I (FLOUT PRNTX2, L7777 JMP PRINT FREE2 TAD CCR PRINTC PRINT6, IAC POPJ /TABLE USED FOR CONVERTING OCTAL TO DECIMAL /FOR OUTPUT. DECIMAL PRNTLL, -1000 -100 -10 OCTAL /THIS ROUTINE IS CALLED AFTER AN LPT FLAG HAS BEEN /SERVICED AND ANOTHER CHARACTER IS TO BE OUTPUT. OTTY, 0 DCA USER /SET UP LPT USER NO. JMS I RTTY /SEND OUT THE NEXT CHAR. CIF 10 JMP I OTTY /RETURN. RTTY, TTY 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 (RDYPCH 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 CIF 0 /USED AS IOF UNTIL JMP I DTFREE. 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 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 LENGTH EVAL-1 JMS I INTEGER /FIX IT SPA SNA SZL ERR650, ERROR /TOO BIG OR TOO LITTLE LENIN, DCA OMAX /SAVE LENGTH TAD DECK /USER 0 CAN OPEN ANY LENGTH SZA CLA TAD OMAX /ANYBODY ELSE IS LIMITED TO 64 TAD C7700 SPA SNA CLA /TOO BIG, SCREW HIM! LENOK, TSTEND /SHOULD BE END JMP LENIN-1 TAD M100 /MAKE SURE EXTENSION IS CORRECT JMS I (DOLCHK /(HE COULD HAVE SAID 'OPEN $') TAD OMAX /PUT LENGTH FOR ENTER IN AC CIF CDF SWAP JMS I (XENTER /ENTER AND CLOSE ERR630, ERROR 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 /AXPUT0 POINTS TO XPUT0. AXPUT0 IS ALSO A CLA INSTRUC- /TION SO XPUT0 SHOULD NOT BE MOVED. 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, JMS I (DOLCHK /SET UP THE EXTENSION. PUSHJ /GET THE PROGRAM NAME GETNAM JMS I (DTGRAB /GET THE TAPE 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 /*UDF* ROUTINE XUDF, 0 CDF 20 /TO USER'S FIELD JMP I XUDF /PART OF THE INPUT COMMAND HANDLER. INPUT1, TSTEND JMP I XINRE1 POPA DCA DATAPC+4 POPF DATAPC+1 POPJ XINRE1, INREA1+1 PAGE OPUS, DCA T3 POPA CIF 10 JMP I .+1 OPUS1 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 FCCHNG=. /IF COMMON FILE EXTS ARE DESIRED THE NEXT /LOCATION IS: / NOP DPL000=. DPV000=NOP 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 FCCHNG=. /IF COMMON FILE EXTS ARE DESIRED THE NEXT /LOCATION IS: / NOP DPL001=. DPV001=NOP 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 /THE FOLLOWING CODE IS ASSEMBLED AT 7600 BUT LOADED AT /7400 IN BANK 1. IT IS MOVED IN INITIALIZATION TO 07600. /THIS PROCEDURE IS NECESSARY BECAUSE OS/8 WILL NOT LOAD /OVER THE TOP PAGES OF BANKS 0 & 1. 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 CDCHNG=. /THE FOLLOWING LOCATION BECOMES / JMP DIS /IF A CDR IS NOT USED. CPL400=. CPV400=JMP DIS JMP CDRICK /CHECK FOR CARD INTERRUPT. 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 CDRICK, RCSI /IS THERE A CARD READER INTERRUPT? JMP DIS /NO. JMP I .+1 /YES. CRINTCHK PAGE / THIS ROUTINE CAN NOT BE MOVED BECAUSE ITS POINTER /IS ALSO A CONSTANT OF 200. 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 JMP I .+1 /CHECK THE MAGNITUDE OF THE EXPONENT. EXPCHK EXCKRT, 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 / THE FOLLOWING THREE INSTRUCTIONS ARE THE EXIT /FROM THE DECTAPE ROUTINE. TODIS, TAD [2 DTXA JMP DIS 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, 13^40+33 LISTCDR 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 K32 /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, JMP I .+1 /EXIT TODIS 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 K602 /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 K32, 32 K602, 602 DTS3A, CDF TAD I DTLOOK CDF SWAP AND Z10 /LOOK AT ERROR FLAG SZA CLA JMP DTKILL /CTRL-C OR OTHER ERROR STOPS SEARCH 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 /DONT TURN YET, STILL IN REVERSE JMP I DRET /GO DO READ OR WRITE DTURNX, TAD K576 /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 / AND ONE HELL OF A HANGOVER K576, 576 / NOTE THAT THE REMAINING LOCATIONS ON THIS PAGE /ARE NOT AVAILABLE. SEE NEXT PAGE OF CODE. 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 /" ERR350-1 /CR PRINT2+4 /\ MUST BE PRINTABLE LIST24, 56^40+34 LIST25 -"K+337^100-"I+337 -"L+337^100-"L+337 LPCHNG=. /IF THERE IS NO LPT THE NEXT LOCATION IS: / UNKWN+1 LPL200=. LPV200=UNKWN+1 LPT RANDOM UNKWN+1 /OUTPUT, UNDEFINED AS A COMMAND. /ONLY USABLE IN AN OPEN STATEMENT. CLOSE0 OPEN CHAIN LINPUT CDCHNG=. /THE FOLLOWING LOCATION BECOMES / UNKWN+1 /IF A CDR IS NOT USED. CPL500=. CPV500=UNKWN+1 CDR /CDR ON READY /STOP & END RESTOR READ RETURN GOSUB FOR XPOPJ /DEF XPOPJ /DIM AND REM GOTO IF INPUT /INPUT, USED AS A COMMAND OR IN /AN OPEN STATEMENT. PRINT0 XPOPJ /DATA LET NEXT COMGOL, UNKWN / THE ERROR LIST ENTRIES ARE MODIFIED DURING INIT- /IALIZATION. ALL VALUES IN THE LIST ARE SHIFTED /RIGHT ONE BIT WITH THE LOW ORDER BIT BEING LOST. /THIS PROCEDURE ELIMINATES NEGATIVE ENTRIES WHICH /WOULD TERMINATE THE SEARCH. ANOTHER EFFECT IS THAT /ERRORS DEFINED AT AN EVEN LOCATION AND THE FOLLOWING /LOCATION ARE TREATED AS THE SAME ERROR. ALSO IF /AN ERROR IS DEFINED AT A LOCATION IN ONE BANK, NO /OTHER ERROR CAN BE DEFINED AT THAT LOCATION IN ANY /OTHER BANK. 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 PINTRPL / MTLS /IF DCO2 - 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 CDCHNG=. /THE FOLLOWING 2 LOCATIONS BECOME / 6634 /READ CDR CHAR TO CLEAR DATA READY FLAG. / 6674 /CLEAR THE CARD DONE FLAG. /IF A CDR IS NOT USED. CPL600=. CPV600=6634 NOP CPL601=. CPV601=6674 NOP CLA /CLEAR THE AC SPL /POWER FAIL INTERRUPT? JMP INTR82 /NO RAR RIB DCA INTR8F /AND FLAGS TAD I A0000 DCA INTR80 /AND LOCATION TAD CCIF2 DCA I A0000 /SET "CIF SWAP" TAD PINTRRV DCA I [2 /AND SET ADDRESS HLT INTR82, TAD INTAC1 /GET THE AC AGAIN CCIF, CIF JMP I .+1 /GO TO REAL INTERRUPT ROUTINE INTRPT LIST73, 15^40+34 LIST74 -"R+337^100-"E+337 -"A+337^100-"D+337 LIST74, 16^40+36 LIST75 -"R+337^100-"E+337 -"T+337^100-"U+337 -"R+337^100-"N+337 LIST14, 51^40+33 A0000, 0 -"O+337^100-"L+337 -"D+337^100 /THIS LIST GIVES THE COMMANDS THAT ARE /LEGAL ONLY IN IMMEDIATE MODE. 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--" /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 CHAR 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 IN 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 WITH 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 OTHER 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 (OH - SO PAINFULLY) OUT OF THE /DECTAPE QUEUE. UNFORTUNATELY DTFREE WILL ONLY REMOVE HIM IF HE IS /ALREADY AT THE TOP OF THE QUEUE. IERDTA, 0 /AND YOU THOUGHT COBOL WAS WORDY!! 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 SQUISH IERR5, 0 /DITTO I7607, 7607 I3767, 3767 /FOLLOWING IS FOR STRING COMPARES. PLOC, DCA SAVPTM TAD I AT1 STL SNA CML TAD SAVPTM CIF SNA JMP I .+4 CLA CMA RAR JMP I .+1 IF6 PRET AT1, T1 SAVPTM, 0 LISTCDR, 11^40+33 LISTLP -"C+337^100-"D+337 /CDR KEYWORD LITERAL -"R+337^100 LISTLP, 2^40+33 LIST72 -"L+337^100-"P+337 -"T+337^100 /PATCHES FOR USING READY1. OPUS1, DCA OPUS2 TAD I AT3 CDF 10 JMP I OPUS2 OPUS2, 0 / OPUSHA, 0 DCA OPUS2 TAD APUSHA OPUSA1, CIF CDF DCA I APUSP1 TAD OPUS2 JMS I APUSPO JMP I OPUSHA / OPOPA, 0 DCA OPUS2 TAD OPOPA DCA OPUSHA TAD APOPA JMP OPUSA1 / RDYPC1, CDF DCA PAT2 TAD I APATCH JMS OPUSHA TAD PAT2 CIF CDF JMP I AREADY PAT2, 0 / PATINR, TAD I AINREAD JMS OPUSHA OPUSHJ PRIN10 JMS OPOPA CIF CDF DCA I AINREAD DCA I AMODE JMP I AINREG / AT3, T3 APUSHA, PUSHA APUSP1, PUSPOP+1 APUSPO, PUSPOP APOPA, POPA APATCH, RDYPCH AREADY, READY1+1 AINREAD, INREAD AMODE, MODE AINREG, INREAD+6 /PRINT A NUMBER ROUTINE. THIS ROUTINE PRINTS A /DECIMAL VALUE INTHE RANGE 0-2047. NPRNT5 /IN FIELD 0 IS 0 TO INDICATE THAT LEADING SPACES /ARE TO BE OUTPUT AND A TRAILING SPACE AS WELL. /NPRNT5 NON-0 MEANS PRINT JUST THE VALUE WITH /NO LEADING SPACES OR 0'S AND WITHOUT THE /TRAILING SPACE. NITPRNT, DCA NT1 /SAVE THE VALUE. DCA NFLTXR L7775 /SET UP NO. OF DIGITS COUNTER. DCA NCNTR TAD NPRNTLL /SET UP POINTER TO POWERS OF TEN TABLE. DCA NT2 NPRNT1, DCA NT3 JMP .+3 ISZ NT3 /ADD ONE TO DIGIT. DCA NT1 TAD NT1 TAD I NT2 /SUBTRACT A POWER OF TEN. SMA JMP .-5 CLA ISZ NT2 /SET UP POINTER TO NEXT POWER OF TEN. TAD NT3 SZA /IS THIS DIGIT 0? JMP NPRNT2 /NO. TAD NFLTXR /YES,HAS A DIGIT ALREADY BEEN OUTPUT? SNA CLA JMP NPRNT3 /NO, GO CHECK FOR LEADING SPACES. NPRNT2, ISZ NFLTXR /YES,SET THE DIGIT ALREADY OUTPUT FLAG. TAD NC60 /OUTPUT THIS DIGIT (0 OR OTHERWISE). NPRNT4, NPRINTC NPRNT7, ISZ NCNTR /DONE? JMP NPRNT1 /NO. TAD NT1 /YES, PRINT THE LOW ORDER DIGIT. TAD NC60 NPRINTC TAD I ANPRNT5 /DO WE WANT A TRAILING SPACE? SZA CLA JMP NPRNT6 /NO. TAD NC40 /YES. NPRINTC NPRNT6, DCA I ANPRNT5 /CLEAR THE SPACE SWITCH (USE SPACES IS DEFAULT). CIF F0 /RETURN. JMP I .+1 NITPRET NPRNT3, TAD I ANPRNT5 /DO WE WANT A LEADING SPACE? SZA CLA JMP NPRNT7 /NO. TAD NC40 /YES. JMP NPRNT4 XNPRINTC, 0 NPRINTC=JMS XNPRINTC OPRINTC /OUTPUT A CHARACTER. CDF F0 JMP I XNPRINTC NPRNTLL, PRNTLL /ADDRESS OF DECIMAL LIST IN F0 ANPRNT5, NPRNT5 /ALSO IN F0 NC40, 40 NC60, 60 NT1, 0 NT2, 0 NT3, 0 NFLTXR, 0 NCNTR, 0 / / THIS ROUTINE CONVERTS LOWER CASE ALPHA TO UPPER CASE /ALPHA. NON-ALPHAS IN THE RANGE 140-177 (OCTAL) /ARE ILLEGAL. / LWRMAP, 0 TAD I XSIN TAD KKM140 /IS THE CHAR < 140? SPA JMP LWRRET /YES, RETURN. SNA /NO, IS IT = 140? JMP LWRERR /YES, AN ILLEGAL CHAR. TAD KM32 /NO, IS IT > 172? SMA SZA JMP LWRERR /YES, AGAIN A BAD CHAR. TAD K132 /CONVERT TO UPPER CASE. DCA I XSIN LWRRET, CLA /RETURN. CIF JMP I LWRMAP LWRERR, CLA /HANDLE BAD CHAR. CIF JMP I XKEY3 XSIN, SIN XKEY3, KEY3 KKM140, -140 KM32, -32 K132, 132 0 /SPARE LOCATION. /THIS ROUTINE CHECKS THE MAGNITUDE OF THE EXPONENT /DURING EXPONENTIATION. EXPCHK, FINT FPUT I XEXPI /SAVE THE EXPONENT. FADD FK127 /IS THE EXPONENT .GE. 127? FSGT FJMP FERR4 /YES. FSUB FK256 /NO. IS IT .LT. -129? FSLE FJMP FERR5 /YES. FGET I XEXPI /NO. IT IS IN LEGAL BOUNDS. FJMP I .+1 /CONTINUE. EXCKRT FERR4, FEXT /ISSUE ERROR 4 ON OVERFLOW. JMP I .+1 ERR040 FERR5, FEXT /ISSUE ERROR 5 ON UNDERFLOW. JMP I .+1 ERR050 FK127, 2077 /FLOATING 127 7400 0 FK256, 2114 /FLOATING 256 0 0 XEXPI, FEXPI *.+45 NCDORG=. /THIS DEFINITION IS USED TO DEFINE THE /BOTTOM OF THE SWAP AREAS WHEN NEITHER /A CDR NOR AN LPT IS USED. ERRCDR=ERRCHK /WHAT? OR UNRECOGNIZED COMMAND ERROR ERRCHAR="? /USE QUESTION MARK FOR BAD COLUMNS CRDCOLS=47 /MINIMUM NUMBER OF COLUMNS PER CARD, DECIMAL 39 F0=0 /MNEMONIC FOR CIFS AND CDFS PF=10 /PATCH FIELD, FIELD ONE /ONLY THESE CR8/CM8 IOTS ARE USED RCSF=6631 RCRB=6634 RCNO=6635 /CM8E ONLY RCSD=6671 RCSE=6672 RCRD=6674 RCSI=6675 /CM8E ONLY RCTF=6677 /CM8E ONLY L0003=CLA STL IAC RAL /USED WITH RCNO /LINE PRINTER IOTS PCLF=6662 /LINE PRINTER CLEAR FLAG PSIE=6665 /LINE PRINTER INTERRUPT ENABLE (INIT CLEARS INT EN) PCIE=6667 /LINE PRINTER INTERRUPT DISABLE. PSKF=6661 /LPT SKIP ON DONE . PSTB=6664 /LPT LOAD & PRINT. PSKE=6663 /SKIP ON LPT HARDWARE ERROR. /THIS ROUTINE ASSIGNS AND RELEASES THE LPT. / LPTCOM, TAD LPUSER /IS THE LPT ALREADY ASSIGNED? SMA CLA JMP LPRELS /YES, GO CHECK FOR RELEASE. TAD I [DECK /NO, CAN THIS USER LEGALLY TAD LGLLPT /ASSIGN THE LPT? DCA LGLPT1 CDF 10 TAD I LGLPT1 CDF SZA CLA JMP LPTERR /NO. CIF 10 /DISABLE INTERRUPTS TEMPORARILY. PSKE /IS THERE AN LPT HARDWARE ERROR? SKP /NO. OPOPJ /YES, LEAVE OUTPUT ON THE TERMINAL. TAD I [DECK /SET THE USER NO. IN THE ASSIGNING DCA LPUSER /LOCATION. L0003 /ENABLE INTERRUPTS FROM THE LPT. PSIE CLA OPOPJ /RETURN. LPRELS, TAD I [DECK /DOES THIS USER HAVE THE LPT? CIA TAD LPUSER SZA CLA JMP LPTERR /NO. /YES, THEN RELEASE THE LPT. CIF 10 /DISABLE INTERRUPTS WHILE CHECKING /FOR OUTPUT DEVICE BUSY. TAD I LPTLSW /IS THE DEVICE BUSY? SNA JMP RELNOW /NO. DCA DLYSWT /YES,SET FOR RELEASE WHEN FLAG COMES UP. OPOPJ /RETURN. RELNOW, JMS LPREL1 /RELEASE THE LPT. OPOPJ /RETURN. LPTERR, CIF 0 /ON ERRORS, ISSUE "WHAT?" OR JMP I .+1 /ERROR 48. ERRCDR LPUSER, -1 /-1 IF NOT ASSIGNED. USER NO. WHEN /ASSIGNED. LGLLPT, LPLGTB LGLPT1, 0 LPTLSW, TELSW DLYSWT, 0 /RELEASE THE LPT ROUTINE. LPREL1, 0 PCIE /DISABLE INTERRUPTS FROM AN LP08. STA /SET LPT TO UNASSIGNED STATE. DCA LPUSER DCA DLYSWT /CLEAR THE DELAYED RELEASE SWITCH. JMP I LPREL1 /THIS ROUTINE TESTS IF THE OUTPUTTING USER HAS THE /LPT. IF SO, IT SETS THE LPT IOT IN THE IOT LOCATION. /IF NOT, IT SETS THE TTY IOT IN THE IOT LOCATION. LPTCHK, TAD LPUSER /DOES THIS USER HAVE THE LPT? CIA TAD I [DECK SZA CLA JMP NOTLPT /NO. TAD LPTIOT /YES SET UP THE LPT IOT. LPTCK1, DCA I XXOTL6 CIF 0 JMP I XLPRET NOTLPT, TAD Z10 /STORE THE TTY IOT. TAD I XXIOT JMP LPTCK1 LPTIOT, PSTB XXOTL6, XOUTL6 XLPRET, LPCKRT XXIOT, XIOT /TABLE OF LPT LEGAL USERS. LPLGTB, 0 /0 MEANS LEGAL USER. 0 /NON-0 MEANS ILLEGAL. 0 /DEFAULT IS LEGAL. 0 0 0 0 0 /THIS ROUTINE TESTS THE LPT FLAG. IF IT IS /UP, IT OUTPUTS ANOTHER CHARACTER. IF NOT, IT /RETURNS TO THE TTY FLAG SERVICE ROUTINE. LPTFLG, DCA I XFRESV /SAVE XFREE ADDRESS. PSKE /IS THERE AN LPT HARDWARE ERROR? SKP /NO. JMP LPTBAD /YES. LPTFL1, PSKF /IS THE LPT FLAG UP? JMP NOLPTF /NO. PCLF /YES, CLEAR IT. CDF 10 TAD I XLPUSR SPA /IS THE INTERRUPT SPURIOUS? JMP LPTSPR /YES. DCA LPSAVE /NO, SAVE THE LPT USER NO. TAD I XDLSWT /IS THE LPT DELAYED RELEASE SZA CLA /SWITCH SET? LPTFL2, JMS I XLPRL1 /YES, RELEASE THE LPT. TAD LPSAVE /OUTPUT ANOTHER CHAR. CIF CDF JMS I XTTY NOLPTF, DCA I XUSER /START TTY SERVICE AT USER 0. DCA I XTEMP1 /START WITH CODE 0 IF DC02. CIF 0 JMP I .+1 LPFLRT /COME HERE IF SPURIOUS INTERRUPT. LPTSPR, CDF 0 /CONTINUE WITH THE TTYS. CLA JMP NOLPTF /COME HERE ON LPT HARDWARE ERROR. LPTBAD, CDF 10 TAD I XLPUSR /IS THE LPT ASSIGNED? CDF 0 SPA CLA JMP LPTFL1 /NO, IGNORE THE ERROR CONDITION. CDF 10 TAD I XLPUSR /YES, SAVE THE LPT USER NO. DCA LPSAVE JMP LPTFL2 /GO RELEASE THE LPT AND SEND REMAINING /OUTPUT TO THE USER'S TERMINAL. XLPUSR, LPUSER XLPRL1, LPREL1 XFRESV, FREESV XUSER, USER XTEMP1, TEMP1 LPSAVE, 0 XTTY, OTTY XDLSWT, DLYSWT LPTORG=. /THIS DEFINES THE BOTTOM OF THE SWAP AREAS /WHEN THE LPT IS USED BUT THE CDR IS NOT. /THIS ROUTINE CHECKS TO SEE IF THE USER THAT WAS /JUST PUT ON DECK HAD THE CARD READER AND /GENERATED AN ERROR 6. ER6CHK, TAD I [DECK /DID THIS USER CAUSE AN ERROR /6 FROM CARDS? TAD ER6FLG SZA CLA JMP I XCTCOK /NO. IAC /YES, RESET THE ERROR 6 FLAG. DCA ER6FLG CDF 10 /RELEASE THE CDR. STA DCA I VCRUNO DCA I VCRRDY /SET THE CDR INPUT BUFFER TO READY. TAD VER060 /SET UP RESTART ADDRESS TO HANDLE CDF 0 JMP I .+1 /ERROR 6. CTRLEX ER6FLG, 1 /1 IS INITIAL AND INACTIVE VALUE. /- USER NO. IS VALUE IF ERROR OCCURRED. XCTCOK, CTLCOK VCRRDY, CRBRDY VER060, ERR060 /CARD READER PACKC ROUTINE /AS SIMILAR AS POSSIBLE TO XPACKC /ENTER WITH ASCII-240 IN AC XCRPACKC, 0 ISZ CRPKFLG /-1 OR 0, 0 IF LEFT SIX FIRST JMP XCRPK1 TAD CRPKPRT /FROM LAST CALL CRUDF, CDF PF /PATCHED BY PFCDR DCA I CRPKPTR /STORE IT CDF PF JMP I XCRPACKC /RETURN XCRPK1, CLL RTL /MOVE TO LEFT-MOST SIX BITS RTL RTL DCA CRPKPRT TAD CRPKPTR /IS THE BUFFER OVERFLOWING? CIA TAD CRPKEND SNA CLA JMP CRNORM /YES, ISSUE ERROR 6, ETC. L7777 /SET FLAG FOR NEXT CALL DCA CRPKFLG ISZ CRPKPTR /THE ISZ IS HERE TO SIMULATE AUTO-INDEX JMP I XCRPACKC /RETURN CRNORM, CDF 10 TAD I VCRUNO /SET THE ERROR 6 FLAG TO MINUS THE CIA /CDR USER NO. DCA ER6FLG JMP I XCRPACKC VCRUNO, CRUNO CRPKPTR, 0 /INITIALLY SET BY NEWLINE CRPKFLG, 0 /DITTO CRPKPRT, 0 /TEMP CRPKEND, 0 /SET BY CDR /CHARACTER TRANSLATION TABLE FOR THE OS-8 BASIC /MARK SENSE CARDS. TRTAB, /0 IN ROWS 12-0 0021 /NUL 1 2223 /2 3 2425 /4 5 2627 /6 7 3031 /8 9 /1 IN ROWS 12-0 2043 /0 C 4651 /F I 5457 /L O 6265 /R U 7004 /X $ /2 IN ROWS 12-0 1442 /, B 4550 /E H 5356 /K N 6164 /Q T 6772 /W Z /3 IN ROWS 12-0 3632 /> : 0106 /! & 7500 /] NUL(@) 0000 /NUL(FORM) NUL(RUBOUT 1) 0000 /NUL(RUBOUT 2) NUL(RUBOUT 3) /4 IN ROWS 12-0 1641 /. A 4447 /D G 5255 /J M 6063 /P S 6671 /V Y /5 IN ROWS 12-0 3400 /< NUL 0000 /NUL NUL 0000 /NUL NUL 0000 /NUL NUL 0000 /NUL NUL /6 IN ROWS 12-0 3303 /; # 0705 /' % 7337 /[ ? 0000 /NUL(TAB) NUL(_) 0000 /NUL(CONT) NUL(CONT) /7 IN ROWS 12-0 7435 /\ = 1315 /+ - 1217 /* / 7610 /^ ( 1102 /) " /CDR COMMAND HANDLER /ASSIGNS CARD READER IF IT'S NOT ALREADY ASSIGNED, /ISSUES ERROR MESSAGE IF IT IS ALREADY ASSIGNED /DF IS STILL F0 /THIS IS NOT A CRITICAL SECTION BECAUSE RUNNING USER IS "NON-INTERRUPTABLE" PFCDR, TAD CRUNO /GET CR USER NO SMA CLA /IT'S -1 IF CDR NOT ASSIGNED JMP CRUCHCK /IF IT IS ASSIGNED TAD I [DECK /CAN THIS USER LEGALLY ASSIGN TAD XLGTAB /THE CDR? DCA LGLPTR CDF 10 TAD I LGLPTR CDF 0 SZA CLA JMP CDRERR /NO. TAD I ALOOK /GET ADDRESS OF USER STATUS WORD DCA ACRUSW /USED BY CRDDONE TO CLEAR IP WAIT BIT TAD I AXUDF1 /GET CDF FOR USER FIELD FROM XUDF ROUTINE CDF 10 DCA I XCRUDF /PUT IT INLINE IN CRPACKC CDF 0 TAD I AALINE0 /END OF COMMAND BUFFER TAD CM12 /TO ALLOW FOR NEXT STATEMENT IN IMMED. MODE CDF 10 DCA I XCRPKN CDF 0 DCA ABBREV /SET SWITCH FOR COMPLETE KEYWORDS. TAD I [DECK /GET NUMBER OF THIS USER JMP ASCRUNO /FINISHED CRUCHCK,TAD I [DECK /SEE IF CR USER IS TRYING TO DEASSIGN CDR CIA /COMPARE USER ONDECK TO CRUNO TAD CRUNO SZA CLA JMP CDRERR /ANOTHER USER TRYING TO ASSIGN IT STA /DEASSIGN IT ASCRUNO,DCA CRUNO OPOPJ /RETURN FROM CDR STATEMENT CDRERR, JMP I .+1 /USE SAME ERROR AS BAD LPT COMMAND. LPTERR CRUNO, -1 /INITIAL VALUE=UNASSIGNED ACRUSW, 0 CM12, -12 XCRUDF, CRUDF XCRPKN, CRPKEND ALOOK, LOOK AXUDF1, XUDF+1 AALINE0, ALINE0 ABBREV, 0 XLGTAB, LGLTAB LGLPTR, 0 /EXTENSION OF READC ROUTINE TO CHECK IF CR USER AND CDR INPUT CRXRD1, TAD I [DECK /NO OF USER ON DECK CIA /EQUAL TO CRUNO? TAD CRUNO SNA CLA JMP CRBCHCK /YEAP CRXRRET,L7777 /RETURN TO XREAD1 TAD I AXREADC /CODE PATCHED OVER IN XREAD1 DCA I APC CIF F0 JMP I .+1 XREAD2 CRBCHCK,TAD CRBRDY /IT'S CR USER, IS COMMAND BUFFER READY? (SET BY CRDDONE) SZA CLA JMP CRECHCK /YEAP TAD I ACOMBUF /ADDRESS OF COMMAND BUFFER FROM SWAP AREA IN FIELD F0 CDF 10 DCA I XCRPKP /INITIALIZES IT DCA I XCRPKF /DITTO CDF 0 JMS NEWCARD /TRY TO START IT JMP CRXRRET /AND RETURN CRECHCK,TAD KEYFLG /DOES LINE CONTAIN A KEYWORD OR LINE NUMBER? SNA CLA /IF SO, BE SURE WE'RE IN COMMAND MODE BEFORE LOOKING AT IT JMP CRECF0 /NO KEYWORD DCA KEYFLG /WE WILL RETURN AGAIN SOON CIF F0 JMP I .+1 START /START -> PAKLIN -> READC -> CRXRD1 CRECF0, DCA CRBRDY CIF F0 JMP I .+1 CRBECHO XCRPKP, CRPKPTR XCRPKF, CRPKFLG ACOMBUF, COMBUF AXREADC, XREADC APC, PC /CARD DONE INTERRUPT HANDLER CRDDONE,RCRD /CLEAR CARD DONE FLAG TAD CRUNO /MAY BE SPURIOUS SPA CLA JMP DIS TAD COLCNT TAD DNCOLS /CHECK IF ALL COLUMNS WERE READ OR CARD IN WRONG SPA CLA /ACCEPT 39 OR 40 COLUMN CARDS JMS MSGGEN /0 IN AC IS CODE FOR "CARD IN WRONG" MESSAGE TAD LINFLG /WAS THERE A LINE NUMBER ON THIS CARD? TAD KEYDSP /WAS THERE A KEYWORD ON THIS CARD? SZA CLA /IF SO, SET FLAG FOR CRECHCK ISZ KEYFLG TAD CNTFLG /CHECK FOR CONTINUATION MARK READ ON THIS CARD SNA CLA JMP .+3 /NOPE JMS NEWCARD /YES, WE MUST READ MORE FOR THIS LINE TO BE COMPLETE JMP DIS ISZ CRBRDY /SIGNAL BUFFER READY CDF F0 L3777 /CLEAR IP WAIT BIT AND I ACRUSW /DF MUST BE F0 HERE DCA I ACRUSW TAD [77 JMS XCRPACKC /PUT CR AT EOL TAD [77 /MAKE SURE JMS XCRPACKC JMP DIS CRBRDY, 0 /CARD READER BUFFER READY FLAG KEYFLG, 0 /NON-ZERO IF A KEYWORD IN THIS LINE DNCOLS, -CRDCOLS /NEGATIVE NUMBER OF COLUMNS PAGE /CARD READER INTERRUPT CHECK AND SKIP CHAIN /F0 COMES HERE FIRST NOW INSTEAD OF INTR81 /EACH FLAG MUST BE CHECKED SEPARATELY AND CLEARED IF SPURIOUS CRINTCHK,RCSF /SKIP ON COLUMN DATA READY SKP JMP XCRRC1 RCSD /IS CARD DONE FLAG SET? SKP JMP CRDDONE RCTF /READY OR TROUBLE TRANS. FLAG MUST BE CAUSING INT., CLEAR THEM TAD I ACRUNO /TRY TO START IT IF IT'S ASSIGNED SMA CLA JMS NEWCARD JMP DIS ACRUNO, CRUNO /CARD READER READC ROUTINE XCRREADC, 0 CLA JMP DIS /WAIT FOR NEXT CHAR INTERRUPT, IF ANY XCRRC1, RCRB /RETURN FROM INTERRUPT DCA CRCHAR /READ DATA IN COLUMN BINARY, CLEAR FLAG TAD I ACRUNO /CHECK FOR SPURIUOS INTERRUPTS SPA CLA JMP DIS ISZ COLCNT TAD CRCHAR /CHECK IF COLUMN IS BLANK SNA JMP I XCRREADC /NORMAL RETURN IF SO STA /IS THIS COL. 1? TAD COLCNT SNA CLA JMP CTRLCS /YES, GO HANDLE COL 1. TAD CRCHAR RTR /CHECK FOR RUBOUT OR CONT. CHARS SMA /AT LEAST ROW 9 FOR THESE JMP NOTRC SNL /ROW 8 TOO JMP NOTRC RAR SZL CLA JMP DIS /RUBOUT, IGNORE THIS COLUMN; CAREFUL IN COLS 1-9 ISZ CNTFLG /CONT. CHAR CEJECT, JMS XCRREADC /TRICKY, HUH NOP /IN CASE BLANK JMP CEJECT /IGNORE REST OF CARD NOTRC, ISZ XCRREADC /SKIP RETURN IF NONBLANK CLA JMP I XCRREADC /RETURN CTRLCS, TAD CRCHAR /IS OT A CTRL/C? SMA CLA JMP I XSTABB /NO, CHECK THE OTHER BITS. TAD I ACRUNO /SET THE CTRL/C FLAG TO MINUS CIA /THE CARD READER USER NO. DCA CTRLCF STABRT, DCA CRCHAR /TAKE THE BLANK CHAR RETURN JMP I XCRREADC CRCHAR, 0 COLCNT, 0 /COLUMN COUNT CNTFLG, 0 /CONTINUATION CHARACTER FLAG XSTABB, SETABB /CHECK IF "CTRL/C" CAME FROM CARD READER FOR CR USER CTRLCHK, CLA TAD I [DECK /NO. OF USER ON DECK TAD CTRLCFLG /SET TO -CR USER IF CR CTRL/C DETECTED SNA CLA /NO MATCH JMP CTRLCY /YES JMP I XER6CK /CHECK FOR ERROR 6 FROM CDR. CTLCOK, TAD I XPC /PATCHED OVER JMP CTRLEX CTRLCY, IAC /SET FLAG TO NO CTRLC DCA CTRLCFLG TAD AERR4 /IN KEY (IT'S OK CAUSE HE IS RUNNING CTRLEX, CIF 0 JMP I XNJCDR CTRLCFLG, 1 /INITIAL AND UNACTIVE VALUE AERR4, CDRCTC XPC, PC XNJCDR, CTRLRT XER6CK, ER6CHK /NEWCARD ROUTINE /TRYS TO START CDR AND SETS CARD PARAMETERS IF SUCCESSFUL NEWCARD, 0 RCSE /SKIP IF READER READY, READ NEXT CARD JMP I NEWCARD /NOPE DCA COLCNT /ZERO COLUMN COUNT TAD ACOL2 /INITIALIZE CRREADC RETURN FOR FIRST CHAR INT. DCA XCRREADC DCA CNTFLG /CONTINUATION FLAG CDF PF /MOVE TO COL1 DCA LINFLG DCA KEYDSP CDF F0 /FOR CRXRRET JMP I NEWCARD ACOL2, COL2 /TABLE OF POINTERS TO LINKED LIST OF BASIC KEYWORDS KEYTBL, LISTEC /APPEND, USE ERRCHAR LIST71 /END LIST22 /CLOSE LIST76 /FOR LIST18 /CHAIN LIST75 /GOSUB LISTEC /CHANGE, USE ERRCHAR LIST81 /GOTO LIST85 /DATA LIST82 /IF LIST77 /DEF LISTEC /IFEND, USE ERRCHAR LIST86 /LET LIST93 /LIST LIST95 /NEW LIST7 /ON LISTEC /OVERLAY, USE ERRCHAR LIST19 /RANDOM LIST79 /REM LIST72 /RESTORE LIST11 /RUN LIST70 /STOP LIST78 /DIM LIST83 /INPUT LIST80 /LINPUT LIST87 /NEXT LIST14 /OLD LIST20 /OPEN LIST84 /PRINT LIST73 /READ LISTEC /REPLACE, USE ERRCHAR LIST74 /RETURN LIST15 /SAVE LIST16 /UNSAVE PAGE /DECBIN SUBROUTINE, DECIMAL-TO-BINARY ENCODER DECBIN, 0 /CONVERTS BIT POSITION IN CHAR INTO BINARY 0-12 DCA DBSAV /SAVE THE VALUE. DCA BINCNT /HOLDS CONVERTED VALUE TAD DBSAV /INPUT SNA /MAKE SURE IT'S NOT ZERO BEFORE YOU GO FURTHER JMP DBRET /RETURN IF IT IS ISZ BINCNT CLL RAL SNL JMP .-3 /KEEP ROTATING AND INCREMENTING UNTIL YOU HIT BIT SZA CLA /ARE THERE MORE MARKS? JMP I DECBIN /ERROR RETURN TAD BINCNT DBRET, ISZ DECBIN /NORMAL RETURN JMP I DECBIN BINCNT, 0 DBSAV, 0 /CARD CODE TO ASCII TRANSLATION ROUTINE TRANSC, 0 TAD CRCHAR /GET ROWS 12,11, AND 0 AS BINARY NUMBER RTL RTL AND [7 DCA DISP TAD DISP /MULTIPLY BY TEN (NO OF CHARS PER TOP THREE CODE) CLL RTL /*4 TAD DISP /+1=*5 CLL RAL /*2=*10 DCA DISP /SAVE IT FOR LATER TAD CRCHAR /NOW GET ROWS 1-9 INTO BINARY (0-9, 0 IF BLANK) USING DECBIN CLL RAL CLL RAL CLL RAL JMS DECBIN JMP I TRANSC /RETURN IF MORE THAN ONE MARK IN ROWS 1-9 TAD DISP /(0-9 FROM DECBIN)+(10*(ROWS 12-0 FROM DISP))=CHAR NO IN TABLE CLL RAR /LINK DETERMINES WHICH HALF OF WORD TO GET (TABLE IS PACKED) TAD ATRTAB /ADDRESS OF TABLE DCA DISP TAD I DISP SZL JMP .+4 RTR RTR RTR AND [77 SZA /TABLE ENTRIES ARE ZERO FOR INVALID COMBINATIONS ISZ TRANSC /SKIP RETURN IF CHAR IS OK JMP I TRANSC DISP, 0 ATRTAB, TRTAB /KEYWORD EXPANDER AND MESSAGE GENERATION ROUTINE /USES EDU 20/25 TABLE OF KEYWORDS IN FIELD 1 MSGGEN, 0 SPA SNA /IF BASIC KEYWORD CODE JMP CARDMSG /"CARD IN WRONG" ERR MSG TAD AMITM1 DCA PTR /STORE ADDRESS OF KEYWORD ADDRESS TAD I PTR DCA PTR TAD I XBBREV /IS ABBREVIATED MODE IN EFFECT? SNA CLA JMP MSGLNG /NO. TAD I PTR /YES. CLL RTR RAR AND K3 JMP .+3 MSGLNG, TAD I PTR /GET FIRST WORD IN ENTRY, CONTAINING # OF CHARS IN KEYWORD AND [7 /LENGTH IN LOW ORDER THREE BITS CIA ISZ PTR /SKIP WORD WHICH LINKS TO NEXT ENTRY DCA COUNT MSGJ, DCA CHARFLG /DETERMINES WHICH HALF OF WORD CHAR COMES FROM MSGCHAR,ISZ CHARFLG JMP CHAR2 TAD I PTR /GET WORD, IN FIELD 1 JMP CHARJ CHAR2, STA DCA CHARFLG /NEXT ONE FROM LEFT HALF OF NEXT WORD ISZ PTR /STARTS AS POS-1 TAD I PTR RTR RTR RTR CHARJ, CMA AND [77 /MASK OFF JMS XCRPACKC ISZ COUNT JMP MSGCHAR JMS XCRPACKC /PUT SPACE AFTER KEYWORD JMP I MSGGEN CARDMSG,TAD AWRNGMSG DCA PTR TAD DN14 /LENGTH OF "'CARD IN WRONG" JMP MSGJ-1 PTR, 0 COUNT, 0 CHARFLG, 0 DN14, -16 XBBREV, ABBREV K3, 3 AMITM1, KEYTBL-1 /ADDRESS OF KEYWORD ADDRESS TABLE AWRNGMSG, WRNGMSG-1 /DUMMY KEYWORD LINKED LIST ENTRY, PUTS ERRCHAR IN PLACE OF KEYWORD LISTEC, 11 /ONE CHARACTER IN THIS KEYWORD 0 /DUMMY -ERRCHAR+337^100 / THIS MESSAGE STARTS WITH A SINGLE QUOTE /SO THAT BASIC WILL HANDLE IT AS A REMARK. WRNGMSG, 7034 /'C 3615 /AR 3377 /D 2621 /IN 7710 / W 1520 /RO 2130 /NG / THIS ROUTINE TESTS IF TTY INPUT IS COMING IN FOR /THE CDR USER. CDRSUP, 0 TAD I [DECK /GET THE USER NO. FOR THIS INPUT. CIA CDF 10 TAD I YCRUNO /IS IT THE SAME AS THE CDR USER? CIF CDF SNA CLA JMP I YSUPPR /YES, DON'T USE THE INPUT. TAD I YLSMOD /NO, IS LISTING SUPPRESSED? SZA ISZ CDRSUP /NO. JMP I CDRSUP YCRUNO, CRUNO YSUPPR, SUPRET YLSMOD, LSTMOD PAGE / / THIS ROUTINE INTERPRETS THE MARK SENSE CARDS ON A COLUMN /BY COLUMN BASIS. COL. 1 IS ONLY USED FOR A CTRL/C AND /AND OTHER CONTROL MARKS AND /IS TRAPPED IN THE READ ROUTINE. COLS. 2-6 CONTAIN /KEYWORD BOXES IN THE UPPER 2 ROWS AND LINE NO. BOXES /IN THE LOWER 10 ROWS. COLS 7 & 8 EACH HAVE 12 KEYWORD /BOXES. COLS 9-40 CONTAIN BOXES TO MARK INDIVIDUAL /CHARACTERS. RUBOUT AND CONTINUATION CHARS ARE TRAPPED IN /THE READ ROUTINE. / COL2, CLA DCA KEYCNT DCA KEYERR COL26, JMS I XXCRRE JMP COL26A /IF BLANK, GO CHECK COL COUNT. TAD I XCRCHR /GET THE CHAR. AND K6000 /ISOLATE THE KEYWORD BOX BITS. JMS I XDCBIN /GET THE DECIMAL BIT POSITION(1 OR 2). JMP COL26B /IF MORE THAN ONE BIT SET, GO HAN- /DLE THE ERROR. SNA /WERE ANY BITS SET? JMP COL26C /NO, GO CHECK FOR LINE NO. TAD KEYCNT /YES, SET UP KEYWORD TABLE INDEX. DCA KEYCNT TAD KEYDSP /HAD A KEYWORD BOX ALREADY BEEN SEEN? SNA CLA JMP COL26D /NO. COL26B, ISZ KEYERR /SET KEYWORD ERROR SWITCH. SKP /GO CHECK FOR LINE NO. COL26D, ISZ KEYDSP /SET KEYWORD SEEN SWITCH. COL26C, TAD I XCRCHR AND K1777 /IS A LINE NO. BOX MARKED? SNA JMP COL26A /NO. CLL RTL /YES, GET ITS BIT POSITION JMS I XDCBIN /WITHIN ROWS 0 TO 9. JMP LNOERR /MULTI-MARKS IN ROWS 0-9. TAD K17 /CONVERT TO INTERNAL CODE. JMS I XXCRPC /PACK THE CHAR. ISZ LINFLG /SET THE LINE NO. SEEN FLAG. COL26A, TAD KEYDSP /HAS A KEYWORD BEEN SEEN? SZA CLA JMP COL26E /YES. STL CLA RTL /NO, ADD 2 TO KEYWORD TABLE INDEX. TAD KEYCNT DCA KEYCNT COL26E, TAD I XCLCNT /IS THIS COL 6? TAD MK6 SZA CLA JMP COL26 /NO. COL78, JMS I XXCRRE /YES, GET NEXT COL. JMP COL78B /IF NO BIT SET,CHECK COL NO. TAD I XCRCHR /GET THE CHAR. JMS I XDCBIN /GET THE BIT POSITION(1 TO 12). JMP COL78A /IF MORE THAN 1 BOX MARKED THEN /AN ERROR. SNA JMP COL78B TAD KEYCNT /SET UP TABLE INDEX. DCA KEYCNT TAD KEYDSP /HAS A KEYWORD BOX ALREADY SNA CLA /BEEN MARKED? JMP COL78C /NO. COL78A, ISZ KEYERR /YES, SET ERROR SWITCH. SKP COL78C, ISZ KEYDSP /SET KEYWORD SEEN SWITCH. COL78B, TAD KEYDSP /HAS A KEYWORD BEEN SEEN? SZA CLA JMP COL78D /YES, CHECK COL. TAD K14 /NO, ADD 12 TO INDEX. TAD KEYCNT DCA KEYCNT COL78D, TAD I XCLCNT /IS THIS COL 8? TAD MK8 SZA CLA JMP COL78 /NOT YET. TAD LINFLG /YES, WAS THERE A LINE NO. SZA CLA JMS I XXCRPC /YES, PACK A BLANK. TAD KEYERR /WAS THERE A KEYWORD ERROR? SZA CLA JMP CLKYER /YES. TAD KEYDSP /NO. SNA CLA /WAS ONE KEYWORD BOX CHECKED? JMP COL9 /NO. TAD KEYCNT /YES. JMS I XMSGEN /OUTPUT THE KEYWORD. COL9, DCA BLANKS /INITIALIZE BLANK COUNTER TO ZERO COL940, JMS I XXCRRE SKP /BLANK JMP .+3 /NO, NONBLANK ISZ BLANKS /DON'T STORE IT YET JMP COL940 TAD BLANKS SNA JMP .+6 /NO BLANKS TO BE STORED CIA DCA BLANKS JMS I XXCRPC ISZ BLANKS JMP .-2 JMS I XTRNSC TAD BADCHAR /RETURN IF BAD, AC = 0 JMS I XXCRPC /RETURN IF CHAR OK, ASCII VALUE IN AC JMP COL940 /COME HERE ON A KEYWORD ERROR. CLKYER, TAD BADCHAR /OUTPUT ERROR CHAR INSTEAD OF KEYWORD. JMS I XXCRPC JMP COL9 /GO HANDLE COLS 9 TO 40. /COME HERE ON MULTIPLE MARKS IN ROWS 0-9. /IN A LINE NO. COLUMN. LNOERR, TAD BADCHAR /OUTPUT THE ERROR CHARACTER. JMS I XXCRPC JMP COL26A BADCHAR, ERRCHAR-240 BLANKS, 0 /COUNT OF NUMBER OF CONSECUTIVE BLANK COLUMNS LINFLG, 0 /NON-ZERO IF LINE NUMBER ON THIS CARD KEYDSP, 0 /NON-ZERO IF KEYWORD ON THIS CARD KEYCNT, 0 MK8, -10 K14, 14 MK6, -6 K17, 17 KEYERR, 0 K6000, 6000 K1777, 1777 XXCRRE, XCRREA XCRCHR, CRCHAR XDCBIN, DECBIN XXCRPC, XCRPAC XCLCNT, COLCNT XMSGEN, MSGGEN XTRNSC, TRANSC /THIS TABLE INDICATES THE LEGAL USERS OF THE CDR. /0 MEANS LEGAL. NON-0 MEANS ILLEGAL. SET UP DURING /INITIALIZATION. LGLTAB, 0 0 0 0 0 0 0 0 PAGE / THIS ROUTINE RELEASES THE CDR ON A CTRL/C. XCT1, 0 TAD I [DECK /IS THIS USER THE ONE WITH THE CDR? CIA CDF SWAP TAD I WCRUNO SZA CLA JMP NOREL /NO. STA /YES, RELEASE THE READER. DCA I WCRUNO DCA I XCRRDY /RESET THE BUFFER READY SWITCH. NOREL, CIF CDF /RETURN JMP I XCT1 WCRUNO, CRUNO XCRRDY, CRBRDY /THIS ROUTINE SETS THE ABBREVIATION SWITCH /DEPENDING ON THE SETTINGS IN CARS COL 1. SETABB, TAD I CRDCHR AND K3000 SNA /ARE MARKS EXTRANEOUS? JMP I STEXIT /YES. AND Z1000 /DO WE WANT COMPLETE COMMANDS? SNA CLA IAC /NO. DCA I STABRV JMP I STEXIT CRDCHR, CRCHAR K3000, 3000 STEXIT, STABRT STABRV, ABBREV /A FEW SPARE LOCATIONS. 0 0 0 0 /USER DEFINITIONS ORG1=. LIMIT=7776 /HIGHEST CORE POSITION SWAPR=ENSWAP-STSWAP+1 /SWAP LENGTH BUFFER=40 BUFCOM=100 LINE0=162 LINE1=164 TOP=LIMIT FIELD 2 PAGE 0 *10 AI0, 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 RK8EIO, 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 JMP OS8DTA /16 = DTA: TAD KRK8E /IS SYS AN RK8E? SZA JMP OS8ERR /NO. TAD KIORK8 /YES, REPLACE THE RK8 IOT WITH DCA RK8EIO /THE RK8E IOT IN THE BOOT- JMP OS8RK8 /STRSP IMAGE. OS8ERR, CLA CDF 20 JMS I (BEG003 OS8ERM /BAD O/S8 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 /O/S8 MESSAGE JMS I (BEG003 OS8AB, OS8M1 JMS I (BEG003 OS8M2 JMP I (BEGMV0 OS8LST, OSDRK8 OSDDTA OSDDSK KRK8E, 160-230 KIORK8, 6743 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 A 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 OS8 ERRCHN, JMS I (BEG003 CHNERR JMP ERRLDR+2 BEG708, CIF 10 JMS I (USR /LOAD HANDLER AND FETCH /GET NUMBER OF DEVICE "SYS" TEXT %SYS% /NO DEVICE PSEUDO-OP IN PAL10 SYSNO=.-1 4001 /HE'S DEAD ANYWAY, SO NO NEED TO SAVE /THE AREA FOR THE DEVICE 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, TEXT %EDU25% /NO FILENAME PSEUDO-OP IN PAL10 2326 /"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 JMS I BGCMFL /CHECK FOR COMMON FILE EXTS. JMS I BGNOCR /CHECK FOR CARD READER USAGE. JMS I BGLPCK /CHECK FOR LPT USAGE. 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 /-1 SUBTRACTS 1 BANK FOR THE ACTUAL /CORE SIZE OF THE MACHINE. -2 SUBTRACTS /2, ETC. BGNOCR, BGCDR1 BGCMFL, BGCMF1 BGLPCK, BGLPT1 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 PDP8/L TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE TAD (1000 CDF TAD I (0 SZA CLA JMP I (CORDON /NO MORE CORE-PROBABLY A PDP-8/L ISZ BEGCOR /THIS FIELD WAS SUCCESSFUL TAD BEGCHK TAD (10 DCA BEGCHK JMP BEGCHK PAGE 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 PAGE BEG15I, /NON-STANDARD USED CODES BEG15H, JMS BEG15G /MOVE IN USED IOT'S JMS I (BEG01Q BEGM9 /"ANY UNUSED TERMINALS?" JMP BEG011 /NO - DUN JMP .+4 BEG15K, JMS I (BEG01Q BEGM8 /"MORE?" JMP BEG011 /NO - KAPUT! JMS I (BEG014 BEGM10 /"DEVICE CODE?" TAD SS TAD (6000 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 TAD (KL8FIX-1 DCA KLTOP CLA CLL IAC BSW /IS IT A PDP-8/E? TAD (-100 SZA CLA JMP BG15GA /NO, DON'T SET UP KL8E INTERRUPT /ENABLES. TAD BEGUSR DCA USRCTR TAD (BEGIOT-1 DCA CORPTR TAD I CORPTR TAD (6005-10 JMS BEG15F ISZ CORPTR ISZ USRCTR JMP .-5 BG15GA, 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 USRS? JMP I (BEG500 /NO - GO ASK HIM JMP I (BEGOLD /YES - ALLOCATE IT FOR HIM PAGE LBLK=SS OLNUM=USRPT2 NUNUM=CORPT2 BEGER0, CDF 20 JMS I (BEG003 WNGDM BEG500, CDF 20 TAD BEGUSR DCA USRCTR TAD (USRLST DCA USRPTR TAD BEGCOR IAC DCA CURFLD BEGFLD, L7777 TAD CURFLD SPA SNA JMP BEGER0 /EH? DCA CURFLD JMS I (BEG003 BEGMFL TAD (60 TAD CURFLD TLS CLA TSF JMP .-1 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 USERNO DCA I USRPTR TAD BEGUSR TAD I USRPTR SMA SZA CLA JMP BEGER1 /NONEXISTENT USER DUMMY ISZ USRPTR TAD CURFLD DCA I USRPTR ISZ USRPTR /AND HIS NO. BEGRE, JMS I (BEG003 BEGTTI DCA OLNUM /DOUBLE CHECK! BEGINP, JMS I (BEG001 TAD (-215 SNA JMP DN TAD (215-"9 SMA SZA JMP BEGER2 /UNGOOD NO TAD (11 SPA JMP BEGER2 /LIKEWISE DCA NUNUM TAD OLNUM /MULT BY 10 DECIM CLL RAL RTL TAD OLNUM TAD OLNUM TAD NUNUM /PLUS NEW DIGIT DCA OLNUM /MAKES NEW NO JMP BEGINP DN, TAD OLNUM SNA SPA SZL JMP BEGER2 /JUNKY NO CIA TAD LBLK SPA JMP BEGER0 /TOO MUCH ASKED FOR DCA LBLK /NEW AMOUNT REMAINING TAD OLNUM ISZ USRCTR SKP JMP BEGR2 DCA I USRPTR ISZ USRPTR TAD LBLK SZA CLA /MORE TO COME IN THIS FIELD? JMP BEGXXX /SURE IS L7777 TAD CURFLD SNA SPA CLA JMP BEGER0 JMP BEGFLD /MORE FIELDS TO COME BEGER2, JMS I (BEG003 BEGME JMP BEGRE BEGER1, JMS I (BEG003 BEGME JMP BEGXXX BEGR2, TAD LBLK /EXPAND HIM TO FINISH FIELD DCA I USRPTR /THERE'S NO REASON TO WASTE CORE ISZ USRPTR /JUST THINK OF ALL THE PEOPLE WHO GO TO BED HUNGRY FOR IT EVERY NIGHT! JMP I (BEG540 PAGE BEG540, TAD BEGDEV SNA CLA JMP BEG550-1 /THE USER 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 CLA CLL IAC BSW /IS IT A PDP-8/E? TAD (-100 SZA CLA JMP BEG550-4 /NO. JMP BEG550-2 /SET TOP OF FIELD 2 BEGKL1, KL8LOD BEGKL2, KL8FIX-1 KL8FRST, 0 BEGKL3, KL8JMP BEGKL4, KL8JM0 BEGKL5, KL8JM0+2 BEGKL6, KL8JMP+2 CDF 10 /REMOVE THE CAF INSTR. WHEN DCA I (INTRRV /NOT AN 8/E TAD KLTOP 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 SWAPS 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 /THIS PAGE OF CODE CALCULATES THE ACTUAL ADDRESSES OF /EACH USER'S BOUNDARIES AND THE APPLICABLE CDF /INSTRUCTION. BEG600, TAD (BEGLST DCA USRPT2 TAD (USRLST DCA USRPTR TAD BEGUSR DCA USRCTR L7777 DCA BEG603 TAD I (USRLST+1 BEG610, DCA CURFLD /SET UP THE CURRENT FIELD DCA BEG602 NXUSR, TAD I USRPTR /GET THE USER NO. ISZ USRPTR DCA I USRPT2 ISZ USRPT2 TAD I USRPTR /GET THE FIELD. CIA TAD CURFLD /IS THE FIELD GIVEN THE SAME AS THE CURRENT ONE? SZA CLA JMP BEG609 /NO, HE WANTS A NEW FIELD ISZ USRPTR TAD CURFLD CLL RAL RTL TAD (6201 /CREATE THE CDF INSTRUCTION. DCA I USRPT2 /STORE IN OUR QUICKIE LIST ISZ USRPT2 TAD I USRPTR /GET THE NO. OF BLOCKS ALLOCATED FOR THIS USER. ISZ USRPTR CIA DCA SS TAD (400 ISZ SS JMP .-2 /MULT. HIS BLOCKSIZE BY 400 OCTAL FOR CORE SIZE DCA SS L7776 /ARE WE IN FIELD 2? TAD CURFLD SZA CLA JMP .+6 /NO. ISZ BEG603 /YES, IS THIS THE 1ST USER IN FIELD 2? JMP .+4 /NO. L7776 /YES, KEEP THE USER AREA AWAY FROM THE /UNUSED TERMINAL CLEAR FLAG CODE. TAD KLTOP JMP .+3 L7776 TAD BEG602 DCA I USRPT2 /SAVE THE TOP ADDRESS OF THE USER AREA. ISZ USRPT2 TAD SS CIA TAD BEG602 DCA BEG602 /SAVE THE BOTTOM OF THE AREA. 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 BOUNDARY TAD USRPT2 /TO END OF LAST SWAP AREA DCA BEG602 JMS BEGF1S DCA I BEG602 JMP I (BEG700 /WHEW..THAT WENT QUICKLY ANYWAY 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 ORGADR /TO AREA ALREADY TAKEN UP BY EDU25 JMP I BEGF1S CDCHNG=. /THE FOLLOWING LOCATION BECOMES LPTORG IF THE /LPT IS USED AND THE CDR IS NOT. COL100=. COV100=LPTORG /THE FOLLOWING LOCATION IS CHANGED TO NCDORG /IF THE CDR & LPT ARE NOT USED. LOL100=. LOV100=NCDORG ORGADR, ORG1 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 JUNK FOR NOTHING! /ALL'S WELL - PRINT "END OF DIALOGUE" AND MOVE IN OS-8 BOOTSTRAP / AND PAGE 7600 FIELD 0 JMS I (BEG003 BEGM6 BEGMV4, CDF 10 TAD I BEGMV1 /MOVE PAGE 7600 FIELD 0 INTO ITS SPOT CDF DCA I BEGMV2 ISZ BEGMV1 ISZ BEGMV2 ISZ BEGMV3 JMP BEGMV4 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 HIM 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 16 K (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 CDCHNG=. CBL000=. CBV000=02^X+6 BGL23, 02^X+4 CBL001=. CBV001=12^X+5 12^X+3 CBL002=. CBV002=21^X+2 22^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 CDCHNG=. CBL100=. CBV100=02^X+3 BGL24, 02^X+2 CBL101=. CBV101=12^X+3 12^X+2 CBL102=. CBV102=22^X+3 22^X+2 CBL103=. CBV103=31^X+2 32^X+2 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+1 22^X+1 CDCHNG=. CBL200=. CBV200=31^X+2 32^X+1 CBL201=. CBV201=42^X+1 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 CDCHNG=. CBL300=. CBV300=01^X+1 LPCHNG=. LBL000=. LBV000=01^X+2 BGL26, 02^X+1 12^X+1 22^X+1 32^X+1 CBL301=. CBV301=42^X+1 42^X+0 CBL302=. CBV302=52^X+1 52^X+0 LPCHNG=. LBL100=. LBV100=03^X+5 BGL36, 02^X+4 LBL101=. LBV101=13^X+4 12^X+4 LBL102=. LBV102=23^X+4 23^X+3 LBL103=. LBV103=32^X+4 33^X+3 LBL104=. LBV104=42^X+4 43^X+3 LBL105=. LBV105=51^X+2 53^X+3 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 CDCHNG=. CBL500=. CBV500=22^X+1 22^X+0 CBL501=. CBV501=32^X+1 32^X+0 LPCHNG=. LBL200=. LBV200=41^X+1 42^X+0 CBL502=. CBV502=51^X+0 LBL201=. LBV201=52^X+0 52^X+0 CBL503=. CBV503=61^X+0 62^X+0 BGL37, 03^X+3 13^X+3 23^X+3 33^X+3 42^X+2 52^X+2 62^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 CDCHNG=. CBL600=. CBV600=02^X+1 BGL28, 02^X+0 CBL601=. CBV601=12^X+1 12^X+0 22^X+0 32^X+0 42^X+0 52^X+0 CBL602=. CBV602=61^X+0 62^X+0 CBL603=. CBV603=71^X+0 72^X+0 BGL38, 03^X+3 CDCHNG=. CBL700=. CBV700=12^X+3 13^X+2 CBL701=. CBV701=22^X+3 23^X+2 33^X+2 43^X+2 CBL702=. CBV702=53^X+2 52^X+2 CBL703=. CBV703=63^X+2 62^X+2 CBL704=. CBV704=71^X+1 72^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 CDCHNG=. /THE FOLLOWING LOCATION BECOMES LPTORG IF THE LPT /IS USED AND THE CDR IS NOT. COL200=. COV200=LPTORG /THE FOLLOWING LOCATION BECOMES NCDORG IF NO LPT OR /CDR IS USED. LOL200=. LPCHNG=. LOV200=NCDORG BEG801, ORG1 /KLUDGE TO MAKE EXTRA ROOM /BEG900 STORES THE SAVE AREA VALUES IN /THE SAVE AREAS. 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_ED25B-B-V03.00__% BEGM2, TEXT %_NUMBER OF USERS (1 TO 8)?% BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% BEGM5, TEXT %_TERMINAL #1 DEVICE CODE?% BEGM5A=BEGM5+5 BEGM7, TEXT %_STANDARD REMOTE TERMINAL CODES (Y OR N)?% BEGMFL, TEXT %_FIELD % BEGMXX, TEXT %_THERE ARE % BEGMX1, TEXT % BLOCKS LEFT IN THIS FIELD._ YOUR ALLOCATION FOR USER #% BEGTTI, TEXT % WILL BE HOW MANY BLOCKS?% BEGM6, TEXT %__END OF DIALOGUE_% WNGDM, TEXT %_BLOCK SIZES DON'T WORK--HAVE TO START AGAIN__% BEGMQ, TEXT %_STANDARD USER STORAGE ALLOCATION (Y OR N)?% BEGM6A, TEXT %_IS THE ABOVE CORRECT (Y OR N)?% BEGM8, TEXT % MORE (Y OR N)?% BEGM9, TEXT %_ANY UNUSED TERMINALS (Y OR N)?% BEGM10, TEXT %_DEVICE CODE?% LDRERR, TEXT %_"EDU" NOT ASSIGNED TO OS8 DEVICE_OR IT'S WRITE LOCKED% LDRER2, TEXT %__RETURNING TO OS8_% CHNERR, TEXT %_"SYS:EDU25.SV" NOT FOUND% BEGMRK, TEXT %__IS THE SYSTEM DEVICE AN RK8-E (Y OR N)?% BEGMCR, TEXT %_MARK SENSE CARD READER USED (Y OR N)?% BGMCLR, TEXT %_CAN ALL USERS USE THE CARD READER (Y OR N)?% BGMLGU, TEXT %_LEGAL USER?% BGMCMF, TEXT %_ALL USERS WITH COMMON FILE EXTENSIONS (Y OR N)?% BEGMLP, TEXT %_LINE PRINTER USED (Y OR N)?% BGMLPR, TEXT %_CAN ALL USERS USE THE LINE PRINTER (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 ITS 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 /THAT WAS TO FIX THOSE NASTY LITERALS DSKP=6741 DCLR=6742 DLAG=6743 DLCA=6744 DRST=6745 DLDC=6746 /FIX END OF PAGE LITTERALS SO THEY READ /ENTERF, CDF CIF 0 / JMP I XENTER /XENTER, 0000 RENTERF=RK8E+ENTERF-DTAPE AND (0000 AND (5777 AND (CDF CIF *.-3 /RESET THE LOCATION COUNTER TO THE START OF THE PAGE RK8E, 0000 IOF /NO INT PLEASE SNA CLA /AC=1 FOR READ TAD D4000 /LINK HAS ARG SO N L4000 PLEASE DCA RK8ERW /READ = 0 WRITE = 4000 DCA RK8EHI /CLEAR HIGH ORDER (BLOCK ADDRESS) RDF TAD RENTERF /CDF CIF DCA RKXIT+1 /SAVE CALLING FIELD TAD DTSF1 DCA DTINTR+2 /INSERT DSKP IN SKIP CHAIN TAD I RK8E ISZ RK8E DCA BUFADD /SAVE BUFFER ADDRESS TAD I RK8E AND Z70 /SAVE FIELD TO BE READ INTO DCA RKFLD TAD RKFLD TAD ZCDF DCA RKCDF1 TAD RKCDF1 DCA RKCDF2 TAD I RK8E ISZ RK8E AND Z200 / LOCATION 7 HAS 200, SEE IF HALF OR FULL BLOCK DCA HALFBLOCK /200 IF HALF A BLOCK 0 IF FULL BLOCK TAD I RK8E /CONSTRUCT FULL ADDRESS ISZ RK8E RAR /BLOCK NUMBER NOW IN AC HALF BLOCK FLAG IN LINK DCA BLOCKNUM SNL JMP RKBUF TAD Z10 DCA RKFLD TAD ZDIRBUF /LAST HALF, SO USE DIRBUF IN FIELD 1 SKP RKBUF, TAD BUFADD /USE USER'S BUFFER DLCA RAR DCA LASTHALF /LAST HALF OF BLOCK FLAG TADEXT /SEE IF .EX AND Z100 SZA CLA JMP RUNIT0 TAD PXCALLB /SEE IF CALL TAD RK8E SZA CLA RUNIT1, TAD D6260 CLL TAD BLOCKNUM DCA BLOCKNUM SZL ISZ RK8EHI RUNIT0, TAD LASTHALF SZA CLA JMP RKLHF TAD HALFBLOCK CLL RAR TAD RK8ERW RKLHF, TAD RK8EHI TAD RKFLD TAD D1400 /ENABLE INTERRUPT ON DONE FROM FIELD 1 /AND CHECK THE SEEK BECAUSE I'M NOT DOING SEQUENTIAL ADDRESSING. DLDC /LOAD COMMAND REGISTER TAD BLOCKNUM DLAG /DISK LOAD AND GO JMP I RDTDIS /PUT HIM TO SLEEP RK8INT, DRST CLL RAL SZA CLA JMP RK8ERR /SOME SORT OF FAILURE REPORT IT. DCLR /CLEAR STATUS REGISTER (AND FLAG) TAD LASTHALF SNA CLA JMP I RDTEND TAD DDIRB /DIRBUF-200 DCA RK8EPT TAD DM200 DCA LASTHALF TAD RK8ERW SMA CLA JMP RK8ERD /ITS A READ RKCDF1, CDF BUF TAD I BUFADD CDF SWAP DCA I RK8EPT ISZ BUFADD ISZ RK8EPT ISZ LASTHALF JMP .-7 TAD ZDIRBUF DLCA TAD RK8EHI TAD D1410 TAD RK8ERW DLDC TAD BLOCKNUM DLAG JMP DIS RK8ERD, CDF SWAP TAD I RK8EPT RKCDF2, CDF BUF DCA I BUFADD ISZ BUFADD ISZ RK8EPT ISZ LASTHALF JMP .-7 JMP I RDTEND /CHECK THE LIST OF ERRORS CAREFULLY SO THIS DOESN'T CONFLICT /WITH ERRORS IN FIELD 0. RKXIT, DCA DTINTR+2 HLT JMP I RK8E RK8ERR, DCLR /ERROR,CLEAR FLAG TAD ZOERROR DCA RKXIT+1 JMP I RDTEND BUFADD, 0 HALFBLOCK, 0 LASTHALF, 0 BLOCKNUM, 0 RK8EPT, 0 RK8EHI, 0 RK8ERW, 0 RDTEND, DTEND RDTDIS, DTDIS RKFLD, 0 D1410, 1410 PAGE CENTER=27 /ENTER CALL OVERLAY CLINK=30 /LINK CALL OVERLAY SYSINI, 0000 CLA CLL JMS I (BEG01Q BEGMRK JMP SYSDTA CDF 10 TAD (DSKP DCA I (DTSF1 /FIX THE SKIP INSTRUCTION TAD (RK8INT&177+DTAPE DCA I (MCOM TAD (RKXIT+1&177+DTAPE DCA I (PDXIT TAD (RKXIT&177+DTAPE DCA I (ZDXIT CDF 20 JMS BLT CDF 20 RK8E /MOVE IN THE DISK HANDLER CDF 10 DTAPE /OVER THE DECTAPE HANDLER 7600 CDF 20 JMS BLT /MOVE RK8E CONSTANTS TO FIELD 1 PAGE 0 CDF 20 RKCON CDF 10 DCON -5 CDF 20 SYSDTA, JMS BLT /BLOCK TRANSFER CDF 0 4000 /FROM 4000 IN FIELD 0 CDF 10 DIRBUF /TO DIRBUF IN FIELD 1 7600 /SAVE THE WHOLE PAGE CLA CLL CDF 20 CIF 10 JMS I (USR FETCH TEXT %EDU% /PAL10 DOESN'T HAVE DEVICE PSUDO-OP ENTRY0, 4000 /PUT DTA HANDLER IN PAGE 4000 FIELD 0 JMP I (ERRLDR /HANDLER NOT FOUND CLA CLL CDF 20 CIF 0 JMS I ENTRY0 4120 /WRITE 1 PAGE FROM FIELD 2 PLINK /FROM CORE AT PLINK CLINK /TO DECTAPE BLOCK NUMBER CLINK JMP I (ERRLDR CLA CLL CDF 20 CIF 0 JMS I ENTRY0 /DO SAME FOR XENTER 4110 /WRITE 1 PAGE FROM FIELD 1 XENTER+1 /FROM CORE AT XENTER+1 CENTER /TO TAPE BLOCK CENTER JMP I (ERRLDR CLA CLL JMS BLT CDF 10 DIRBUF CDF 0 4000 7600 CDF 20 JMP I SYSINI BLT, 0000 TAD I BLT ISZ BLT DCA BLT1 TAD I BLT ISZ BLT DCA BLT2 TAD I BLT ISZ BLT DCA BLT3 TAD I BLT ISZ BLT DCA BLT4 TAD I BLT ISZ BLT DCA BLT5 BLT1, 0000 TAD I BLT2 BLT3, 0 DCA I BLT4 ISZ BLT2 ISZ BLT4 ISZ BLT5 JMP .-7 JMP I BLT BLT2, 0 BLT4, 0 BLT5, 0 RKCON, /PAGE ZERO CONSTANTS FOR RK8E HANDLER 4000 6260 1400 DIRBUF+200 -200 PAGE /THIS ROUTINE SETS UP THE LEGAL USER TABLE /FOR THE CDR. BGCDR1, 0 JMS I XBG01Q /IS A CDR USED? BEGMCR JMP BGNCR1 /NO. JMS I XBGLGR /YES GO HANDLE THE LEGAL USERS. L0003 /ENABLE CDR INTERRUPTS. RCNO CLA JMP I BGCDR1 BGNCR1, CLA STL RTL /SET BIT 10 OF THE FORMAT WORD. DCA BGFRMT JMP I BGCDR1 XBGLGR, BGLGRT BGFRMT, 0 XBG01Q, BEG01Q /THIS ROUTINE OVERLAYS LOADED VALUES WITH VALUES SPECIFIED /IN THE CHANGE TABLE. THE AC CONTAINS THE MASTER TABLE /SLOT FOR THE APPROPRIATE CHANGES. TBLTRN, 0 DCA TBTMP /MULTIPLY ENTRY NO. BY 3. TAD TBTMP TAD TBTMP TAD TBTMP TAD XMSTBL /ADD TO MASTER TABLE START. DCA TBTMP TAD I TBTMP DCA TBCDF /SET UP THE CDF INSTRUCTION. ISZ TBTMP TAD I TBTMP /GET THE CHANGE TABLE STARTING /ADDRESS. DCA AI0 ISZ TBTMP /LEAVE THE POINTER POINTING TO MINUS /(END OF TABLE). TBLTR1, TAD AI0 /HAVE WE XFERRED THE WHOLE TABLE. TAD I TBTMP SNA CLA JMP I TBLTRN /YES. TAD I AI0 /NO, GET THE STORING ADDRESS. DCA XTBPTR TAD I AI0 TBCDF, 0 /CDF INSTRUCTION. DCA I XTBPTR /STORE THE VALUE. CDF 20 JMP TBLTR1 /TRY MORE. TBTMP, 0 XMSTBL, MSTTBL XTBPTR, 0 /THIS ROUTINE SETS UP COMMON FILE EXTENSIONS. BGCMF1, 0 TAD BEGUSR /IS THERE ONLY ON USER? CMA SNA CLA JMP I BGCMF1 /YES, SKIP THE QUESTION. JMS I XBG01Q /NO, ARE COMMON EXTENSIONS WANTED? BGMCMF JMP I BGCMF1 /NO. TAD BGK10 /YES, MAKE THE CHANGES. JMS TBLTRN JMP I BGCMF1 BGK10, 12 /THIS ROUTINE SETS UP THE LPT CODE. BGLPT1, 0 CLA /DISABLE LPT INTERRUPTS PSIE /IN ALL CIRCUMSTANCES. PCIE JMS I XBG01Q /IS AN LPT USED? BEGMLP JMP BGLPT2 /NO. CLA IAC JMS I XBGLGR /SET UP LEGAL USER TABLE. JMP BGLPT3 BGLPT2, CLA IAC /SET BIT 11 IN THE FORMAT WORD. TAD BGFRMT DCA BGFRMT BGLPT3, JMS I BGSTUP /SET UP SYSTEM DEPENDING ON PERIPHERALS /USED. JMP I BGLPT1 BGSTUP, BEGSET PAGE /THIS ROUTINE HANDLES LEGAL USER SET UP FOR /BOTH THE CDR AND THE LPT. ON ENTRY AC=0 FOR CDR /AND AC=1 FOR LPT. BGLGRT, 0 CLL RAL TAD BGLGAD /SAVE THE ADDR OF THE APPROPRIATE DCA BGLGPT /TABLE. TAD BEGUSR /IS THERE ONLY ONE USER? DCA BGCDK1 TAD BEGUSR CMA SNA CLA JMP I BGLGRT /YES, RETURN. TAD I BGLGPT ISZ BGLGPT DCA .+2 JMS I YBG01Q /CAN ALL USERS USE THE CDR OR LPT? 0 SKP /NO. JMP I BGLGRT /YES, RETURN. BGLGR1, JMS I XBG003 /ASK FOR LEGAL USER NO. BGMLGU JMS I XBG001 /GET THE ANSWER. TAD BGKM0 /IS IT IN THE RANGE 1 TO MAX USER? SPA SNA JMP BGBDAN TAD BGCDK1 SMA SZA JMP BGBDAN /NO, AGAIN. DCA BGCDK2 /YES. TAD BGCDK1 /CONVERT BACK TO A POSITIVE VALUE. CMA TAD BGCDK2 TAD I BGLGPT /ADD TO BASE ADDR OF TABLE. DCA BGCDK2 STA CDF 10 DCA I BGCDK2 /SET IN TABLE. CDF 20 JMS I YBG01Q /ARE THERE MORE? BEGM8 SKP /NO. JMP BGLGR1 /YES. TAD BGKM8 /WHEN DONE COMPLEMENT THE TABLE DCA BGCDK1 /ENTRIES. TAD I BGLGPT DCA BGCDK2 CDF 10 BGLGR2, TAD I BGCDK2 CMA DCA I BGCDK2 ISZ BGCDK2 ISZ BGCDK1 /DONE? JMP BGLGR2 /NO. CDF 20 /YES. JMP I BGLGRT /COME HERE ON AN ILLEGAL ANSWER. BGBDAN, JMS I XBG003 /ISSUE ILLEGAL RESPONSE. BEGME JMP BGLGR1 BGLGPT, 0 BGLGAD, BGCDTB BGLPTB BGCDTB, BGMCLR LGLTAB BGLPTB, BGMLPR LPLGTB BGCDK1, 0 YBG01Q, BEG01Q XBG003, BEG003 XBG001, BEG001 BGKM0, -260 BGCDK2, 0 BGKM8, -10 /THIS ROUTINE ENABLES AND DISABLES CDR AND /OR LPT /SUPPORTING CODE DEPENDING ON THE SETTING OF THE /FORMAT WORD. BIT 10=0 MEANS CDR IS USED. BIT 10=1 /MEANS CDR IS NOT USED. BIT 11=0 MEANS LPT IS /USED. BIT 11=1 MEANS LPT NOT USED. BEGSET, 0 TAD I XFRMAT /GO TO THE ROUTINE TO TAD BGRTAD /HANDLE THE PARTICULAR DCA BGRTPR /CONFIGURATION. TAD I BGRTPR DCA BGRTPR JMP I BGRTPR BGTBTR, TBLTRN XFRMAT, BGFRMT BGRTAD, BGRTTB BGRTPR, 0 BGRTTB, BGSET0 BGSET1 BGSET2 BGSET3 BGSTK5, 5 BGSTK6, 6 BGSTK7, 7 BGSTK8, 10 BGSTK9, 11 /COME HERE IF 0, I. E. BOTH THE CDR & LPT ARE USED. BGSET0, JMP I BEGSET /NOTHING TO DO, SO RETURN. /COME HERE IF 1, I. E. CDR IS USED BUT LPT IS NOT. BGSET1, TAD BGSTK5 /REMOVE BANK 0 LPT CODE. JMS I BGTBTR TAD BGSTK6 /REMOVE BANK 1 LPT CODE. JMS I BGTBTR JMP I BEGSET /COME HERE IF 2, I. E. LPT USED BUT CDR IS NOT. BGSET2, CLA /REMOVE BANK 0 CDR CODE. JMS I BGTBTR CLA IAC /REMOVE BANK 1 CDR CODE. JMS I BGTBTR L0003 /SET UP BANK 0 REF TO SWAP JMS I BGTBTR /AREA START ADDR. CLL CLA IAC RTL /SET UP BANK 2 REFS TO SWAP JMS I BGTBTR /AREA START ADDR. CLA CLL IAC RAL /CHANGE USER CORE ALLOCATION. JMS I BGTBTR JMP I BEGSET /COME HERE IF 3, I. E. NEITHER CDR NOR LPT USED. BGSET3, CLA /REMOVE BANK 0 CDR CODE. JMS I BGTBTR CLA IAC /REMOVE BANK 1 CDR CODE. JMS I BGTBTR TAD BGSTK5 /REMOVE BANK 0 LPT CODE. JMS I BGTBTR TAD BGSTK6 /REMOVE BANK 1 LPT CODE. JMS I BGTBTR TAD BGSTK7 /SET UP SWAP AREA START ADDR REFS JMS I BGTBTR /IN BANK 0 TAD BGSTK8 /& BANK 2. JMS I BGTBTR CLA CLL IAC RAL /SET UP ALLOCATION OF USER AREAS. JMS I BGTBTR TAD BGSTK9 JMS I BGTBTR JMP I BEGSET PAGE /THE FOLLOWING TABLE GIVES PARAMETERS FOR THE CHANGE /TABLE XFERS. 1ST ENTRY IS A CDF INSTRUCTION. 2ND /ENTRY IS STARTING ADDRESS OF TABLE-1. 3RD ENTRY IS /MINUS END OF TABLE. MSTTBL, CDF 0 /TABLE 0 PARAMETERS. BANK 0 CDR CODE. CPTBL0-1 -CTB0ND CDF 10 /TABLE 1. BANK 1 CDR CODE. CPTBL1-1 -CTB1ND CDF 20 /TABLE 2. USER ALLOCATION WITHOUT CDR. CPTBL2-1 -CTB2ND CDF 0 /TABLE 3. BANK 0 REF TO SWAP CPTBL3-1 /AREA START WHEN NO CDR. -CTB3ND CDF 20 /TABLE 4. BANK 2 REFS TO SWAP AREA CPTBL4-1 /START WHEN NO CDR. -CTB4ND CDF 0 /TABLE 5. BANK 0 LPT CODE. LPTBL0-1 -LTB0ND CDF 10 /TABLE 6. BANK 1 LPT CODE. LPTBL1-1 -LTB1ND CDF 0 /TABLE 7. BANKS 0 REFS TO SWAP LPTBL2-1 /AREAWHEN NO LPT OR CDR. -LTB2ND CDF 20 /TABLE 8. BANK 2 REFS TO SWAP LPTBL3-1 /AREA START WHEN NO LPT OR CDR. -LTB3ND CDF 20 /TABLE 9. USED AFTER TABLE 2 TO CHANGE LPTBL4-1 /USER ALLOCATION WHEN NO LPT OR CDR. -LTB4ND CDF 0 /TABLE 10. FOR COMMON FILE EXTS DPTBL0-1 /CHANGES. -DTB0ND /TABLE 0 FOR BANK 0 CHANGES /TO REMOVE CDR CODE. CPTBL0, CPL000 /REMOVE CHECK FOR CTRL/C CPV000 /FROM THE CDR. CPL001 CPV001 CPL100 /REMOVE CHECK FOR CDR ASSIGNED TO CPV100 /USER ISSUING CTRL/C. CPL101 CPV101 CPL200 /CHECK LSTMOD FOR CHARACTERS AS DATA CPV200 /FOR AN INPUT STATEMENT. CPL201 CPV201 CPL300 /REMOVE CHECK FOR INPUT FROM CDR. CPV300 CPL301 CPV301 CPL302 CTB0ND, CPV302 /SWAP AREA STARTING ADDRESS CHANGE NEXT. CPTBL3, COL000 CTB3ND, COV000 /TABLE 1 FOR BANK 1 CHANGES. /SYSTEM CODE CHANGES 1ST. CPTBL1, CPL400 /REMOVE CHECK FOR CDR FLAG. CPV400 CPL500 /TREAT CDR COMMAND AS UNDEFINED. CPV500 CPL600 /ENABLE CDR CLEAR FLAG IOTS IN CPV600 /CASE AN UNUSED CDR RAISES A FLAG. CPL601 CTB1ND, CPV601 /BANK 2 CHANGES. /START OF SWAP AREA CHANGES FIRST. CPTBL4, COL100 COV100 COL200 CTB4ND, COV200 /NOW CHANGES TO TABLE ALLOCATING USER SPACE. CPTBL2, CBL000 CBV000 /3 BANKS, 3 USERS. CBL001 CBV001 CBL002 CBV002 CBL100 /3 BANKS, 4 USERS. CBV100 CBL101 CBV101 CBL102 CBV102 CBL103 CBV103 CBL200 /3 BANKS, 5 USERS. CBV200 /NOTE: 1ST 3 ENTRIES ARE SAME WITH CBL201 /& WITHOUT THE CDR. CBV201 CBL300 /3 BANKS, 6 USERS. CBV300 /NOTE: 2ND THRU 4TH ENTRIES ARE SAME CBL301 /WITH & WITHOUT CDR. CBV301 CBL302 CBV302 CBL500 /3 BANKS, 7 USERS. CBV500 CBL501 CBV501 CBL502 CBV502 CBL503 CBV503 CBL600 /3 BANKS, 8 USERS. CBV600 /NOTE: 3RD THRU 6TH ENTRIES ARE SAME CBL601 /WITH & WITHOUT CDR. CBV601 CBL602 CBV602 CBL603 CBV603 CBL700 /4 BANKS, 8 USERS. CBV700 /NOTE: 1ST, 4TH, & 5TH ENTRIES ARE CBL701 /SAME WITH & WITHOUT CDR. CBV701 CBL702 CBV702 CBL703 CBV703 CBL704 CTB2ND, CBV704 /BANK 0 LPT CODE. LPTBL0, LPL000 /SETTING UP OF LPT IOT. LPV000 LPL001 LPV001 LPL002 LPV002 LPL100 /CHECK FOR LPT INTERUPT. LPV100 LPL101 LPV101 LPL102 LTB0ND, LPV102 //BANK 1 LPT CODE. LPTBL1, LPL200 /LPT COMMAND POINTER. LTB1ND, LPV200 /BANK 0 SWAP AREA ADDR. LPTBL2, LOL000 LTB2ND, LOV000 /BANK 2 SWAP AREA ADDR. LPTBL3, LOL100 LOV100 LOL200 LTB3ND, LOV200 /ALLOCATION CHANGES. LPTBL4, LBL000 /2 BANKS, 6 USERS, 1ST ENTRY. LBV000 LBL100 /3 BANKS, 6 USERS, ALL ENTRIES. LBV100 LBL101 LBV101 LBL102 LBV102 LBL103 LBV103 LBL104 LBV104 LBL105 LBV105 LBL200 /2 BANKS, 7 USERS, ENTRIES 5&6. LBV200 LBL201 LTB4ND, LBV201 /TABLE OF CHANGES FOR COMMON FILE EXTENSIONS. DPTBL0, DPL000 DPV000 DPL001 DTB0ND, DPV001 *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 /WHEW! ENTRY FINCDF, CDF XPNT, BEG801 FIN001, FIN003 BGCORS, 0 FIN003, /PRECEDING THIS CODE IN FIELD 2 IS THE FOLLOWING: / CLA /ENTRY FROM INTERRUPT ROUTINE / 6XX0 /UNUSED CODES CLEAR FLAG IOT. / . / . / . / 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 $