File EDU253.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/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 <STSWAP MUST BE AT 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 <MUST BE ODD LOCATION. SEE LISTING.> 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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search