/OS/8 TECO - 8K/12K VERSION FOR PDP-8 OR PDP-12 / /DEC-S8-UTECA-A-LA / /COPYRIGHT 1972 /DIGITAL EQUIPMENT CORPORATION /MAYNARD, MASSACHUSETS 01754 / /ORIGINALLY WRITTEN BY RUSSELL HAMM, WAY BACK WHEN /MODIFIED FOR OS/8 AND NON-EAE BY THE O.M.S.I. CREW /SPEEDED UP, SHORTENED AND MADE PDP-10 / COMPATIBLE BY RICHARD LARY OF D.E.C. /WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S VERSN= 2 /*** VERSION NUMBER - CHANGE WITH EVERY EDIT *** /*** LAST EDIT 5/5/72 *** IN= 6200 /INPUT BUFFER AT 06200 OUT= 5200 /OUTPUT BUFFER AT 05200 ZMAX= 7640 /ABOUT 4000[10] CHARACTERS IN TEXT BUFFER QMAX= 3720 /MAX 2000[10] Q-REGISTER CHARS IN 8K Q12MAX= 5600 /MAX 2944[10] Q-REGISTER CHARS IN 12K TWO= CLA CLL CML RTL MTWO= CLA CLL CMA RAL MTHREE= CLA CLL CMA RTL /***************************************** / TECO ERROR MESSAGES: /***************************************** / TECO ERROR MESSAGES CONSIST OF A QUESTION MARK AND A NUMBER. / TYPING "?" IMMEDIATELY AFTER AN ERROR MESSAGE PRINTOUT PRINTS / THE CURRENT COMMAND LINE UP TO THE ERROR CHARACTER. /1 ILLEGAL COMMAND /2 INCOMPLETE COMMAND (PDL DOES NOT BALANCE AT END OF COMMAND STRING) /3 NON-ALPHANUMERIC Q-REGISTER NAME /4 PUSHDOWN OVERFLOW (MACROS & ITERATIONS NESTED TOO DEEPLY) /5 TEXT BUFFER OVERFLOW /6 SEARCH STRING TOO LARGE ( >31 CHARS) /7 NUMBER MISSING BEFORE COMMA, EQUALS SIGN, U, OR QUOTE (") /8 ILLEGAL FILE NAME IN "ER","EW" OR "EB" COMMAND /9 SEMICOLON OR FAILING SEARCH ON COMMAND LEVEL /10 ITERATION CLOSE (>) WITHOUT MATCHING OPEN (<) /11 ATTEMPT TO MOVE POINTER OUTSIDE OF TEXT BUFFER /12 Q-REGISTER STORAGE OVERFLOW /13 INCOMPLETE COMMAND (PDL DOES NOT BALANCE AT END OF MACRO) /14 OUTPUT FILE TOO BIG OR OUTPUT PARITY ERROR /15 PARITY ERROR ON INPUT FILE /16 FILE ERROR: CAN MEAN EITHER / A) INPUT FILE NOT FOUND ON "ER" COMMAND / B) CANNOT ENTER OUTPUT FILE ON "EW" OR "EB" COMMAND / C) DEVICE SPECIFIED FOR FILE DOES NOT EXIST / D) "EB" COMMAND GIVEN ON NON-FILE-STRUCTURED DEVICE /17 OUTPUT COMMAND WOULD HAVE OVERFLOWED OUTPUT FILE /18 ATTEMPT TO OUTPUT WITHOUT OPENING AN OUTPUT FILE *0 NAME, ZBLOCK 4 /NAME BUILD BUFFER /LOCS 4,5&6 ARE RESERVED SO WE CAN USE PS/8 ODT *14 DX, 0 /DISPLAY XR SXR, QPUT12-1 /XR USED BY SEARCH PROCESSOR INXR, ASR33-1 /XR USED TO UNPACK INPUT BUFFER XR, ASR35-1 /WORK XR NMT, 0 /USED AS NUMBER TEMP AND SEARCH FAIL FLAG CFLG, 0 /COMMA FLAG CLNF, 0 /COLON FLAG TFLG, 0 /TRACE FLAG NFLG, 0 /NUMBER FLAG OFLG, 0 /OPERATOR FLAG QFLG, 0 /QUOTED STRING FLAG M, 0 /NUMBER ARGS N, 0 NLINK, 0 /LINK AFTER ARITH OPERATIONS - TESTED BY "A AND "B CHAR, 0 /CHARACTER BUFFER ITRST, 0 /ITERATION FLAG ITRCNT, 0 /ITERATION COUNT MPDL, 0 /MACRO FLAG SCHAR, 0 /LAST CHAR SORTED FFFLAG, 0 /FORM FEED FLAG - 7777 IF FORM FEED SEEN ON THIS READ REND, 0 /INPUT END-OF-FILE FLAG WEND, 0 /OUTPUT END-OF-FILE FLAG SCANP, 3700 /COMMAND LINE EXECUTION POINTER OSCANP, 0 /BACKUP FOR SCANP PDLP, PDLBEG /PUSH-DOWN-LIST POINTER QCMND, 0 /COMM LINE OR MACRO POINTER P, 0 /CURRENT PNTR TO TEXT BUFFER ZZ, 0 /END OF TEXT BUFFER POINTER Q, 0 /EXTRA BUFFER POINTERS R, 0 QP, 0 /Q REGISTER POINTER QZ, QMAX-1 /END OF Q-REG POINTER CTLBEL, 7 CAFF, 14 /FF: END OF PAGE 13 /VT CALF, 12 /LF CACR, 15 /CR CAHT, 11 /HT CAAM, 33 /ALT MODE ERR07, NERR, ERR /END OF LIST QUOTE, 33 /QUOTE CHAR - SINGLE WORD SORT LIST ERR01, SERR, ERR MQ, 0 DVT1, 0 ODEV, 0 /OUTPUT DEVICE NUMBER OUTHND, 0 INHND, 0 EBFLG, 0 /EDIT BACKUP FLAG QNMBR, 0 /LAST Q-REG REFERENCED QBASE, 0 /BASE OF CURRENT COMMAND LINE QLENGT, 0 /LENGTH OF CURRENT COMMAND LINE QPTR, 0 /POINTER TO Q-REGISTER CONTROL BLOCK INRSIZ, 2 /4 IF 12K MACHINE ICRCNT, 0 /INPUT DOUBLEWORD COUNTER OCRCNT, 0 /OUTPUT " OPTR2, 0 /OUTPUT BUFFER POINTER INRCNT, 0 /NUMBER OF INPUT RECORDS LEFT DCOL, 0 /CURRENT COLUMN COUNTER ON SCOPE YPOS, 0 /CURRENT Y-POSITION ON SCOPE RADIX, DRAD /TECO PSEUDO-OPERATIONS PUSH= JMS I .; PUSHXX POP= JMS I .; POPXX /MUST BE ONE MORE THAN "PUSH" PUSHJ= JMS I .; PUSHJY POPJ= JMP I .; POPJXX PUSHL= JMS I .; PUSHLX POPL= PUSHL /POPL CALLED WITH POSITIVE AC ERR= JMS I .;ERROR,ERRXX SORT= JMS I .; SORTB RESORT= JMP I .; SORTA2 SCAN= JMS I .; SGET LISTEN= JMS I .; TYI TYPE= JMS I .; TYPCTV OUTPUT= JMS I .;OUTR, ERRXX /MUST BE ONE MORE THAN "TYPE" CRLF= JMS I .; TYCRLF GETQ= JMS I .; GETQX SKPSET= JMS I .; SETSKP NCHK= JMS I .; CHKNF CTCCHK= JMS I .; CHKCTC BZCHK= JMS I .; CHKBZ QCHK= JMS I .; CHKQF QSKP= JMS I .; QOVER QREF= JMS I .; QREFER QSUM= JMS I .; QSUMR QPUT= JMS I .; QPUTS QUOTST= JMS I .; QTST SETCMD= JMS I .; CMDSET GETN= JMS I .; NGET ADJQ= JMS I .; QADJ MQLDVI= JMS I .; DVIMQL UPPERC= JMS I .; CUPPER TSTSEP= JMS I .; SCHSRT DISPLY= JMS I .; DSPLAY NOTRCE= JMS I .; SAVTRA ENTRCE= JMS I .; RESTRA PAGE /ENTER HERE TO USE AN ASR33 AS THE TELETYPE TECO, ISZ I SPUT /IF CALLED BY "R" OR "RUN" JMP I COMPAR /IF CALLED VIA "CHAIN" SKP /SKIP INITIAL CR/LF T0, CRLF TAD (PDLBEG DCA PDLP /INITIALIZE PUSHDOWN LIST T1, TAD PDLP TAD (-PDLBEG SZA CLA ERR02, ERR /ERROR - PUSHDOWN LIST DID NOT BALANCE TAD (45 QREF /SET UP POINTERS TO COMMAND LINE ADJQ /REDUCE COMMAND LINE LENGTH TO 0 DCA SCANP /ZERO COMMAND LINE CHARACTER POINTER DCA NFLG DCA N DCA OFLG /DELETE NUMBER FLAGS DCA CFLG DCA MPDL /DELETE MACRO FLAG DCA ITRST /ALSO ITERATION FLAG DCA CLNF /AND COLON FLAG PUSHJ /KILL QUOTE FLAG IREST /AND RESET THE QUOTE CHARACTER TO ALTMODE KCC /KILL ^O IF IN KEYBOARD BUFFER TAD (52 T1A, TYPE DCA CHAR /KILL CHAR TO PREVENT SPURIOUS DOUBLE CHARACTERS T2, LISTEN /BUILD COMMAND LINE SORT COMLST COMTAB-COMLST T2A, DCA CHAR JMS SPUT /PUT INTO C.L. BUFFER JMP T2 /GO GET ANOTHER ROCMND, TAD I (QPNTR /SEE IF ANYTHING TO ERASE SNA CLA JMP T0 /NO, START ALL OVER STA TAD I (QPNTR /THEN THE CHARACTER COUNT ADJQ /REDUCE THE LENGTH OF THE COMMAND REGISTER BY 1 TAD QZ GETQ /GET THE CHARACTER WE RUBBED OUT JMP T1A /PRINT IT AND CONTINUE TCRLF, TAD CACR /CR IN COMM LINE DCA CHAR JMS SPUT /PUT INTO COMM LINE TAD CALF /THEN PUT IN A LF JMP T2A /AND GET SOME MORE TBEL, JMS COMPAR /^G IN COMMAND LINE JMP T0 /2ND ^G KILLS COMMAND LINE /COMMAND EXECUTION LOOP TALTM, JMS COMPAR /2ND ALTM STARTS EXECUTION CRLF /START COMM EXECUTION CHTECO, TAD (45 /NUMBER OF INPUT COMMAND Q-REGISTER SETCMD /SET UP THE INPUT LINE AS THE CURRENT COMMAND LINE T6, SCAN T6A, DCA CHAR /SAVE COMMAND CHAR CTCCHK /CHECK FOR ^C TAD CHAR UPPERC TAD (CDSP /ADD BASE OF DISPATCH TABLE DCA T7 /LOK UP ENTRY IN TAD I T7 /COMMAND DISPATCH TABLE DCA T7 /CALL RECURSIVELY PUSHJ T7, 0 /CALL TO ROUTINE CLA /FINALLY FINISHED THAT ONE TAD NFLG SMA CLA /IF WE ARE NOT ENTERING A NUMBER, DCA N /SET N TO ZERO JMP T6 /KEEP INTERPRETING TQMK, TAD I ERROR SNA CLA /ERROR ROUTINE ENTRY POINT NON-ZERO? RESORT /NO CRLF /YES - THAT MEANS THIS IS THE FIRST CHAR AFTER CLA CMA /AN ERROR PRINTOUT DCA QLENGT /SET QLENGT BIG SO WE CAN ACCESS ENTIRE LINE NOTRCE /TURN TRACE OFF SCAN TYPE /PRINT OUT THE LINE WHICH CAUSED THE ERROR ISZ I ERROR /UP TO THE ERROR CHAR ITSELF JMP .-3 ENTRCE /TURN TRACE BACK ON JMP T0 /RE-INITIALIZE CQSM, TAD TFLG CMA /TFLG ALTERNATES BETWEEN 0 AND 7777 DCA TFLG POPJ CHUA, POP /^ COMMAND CLA /DELETE RETURN ADDRESS FROM PUSHDOWN LIST SCAN /GET THE NEXT CHARACTER UPPERC /FORCE UPPER CASE AND [77 /MAKE IT A CONTROL CHARACTER JMP T6A /USE IT INSTEAD OF THE ^ COMPAR, TCINIT /LOOK FOR DOUBLED COMM LINE CHARS TAD SCHAR /MOST RECENT CIA TAD CHAR /PREVIOUS SZA CLA RESORT /NOT THE SAME JMS SPUT /PUT THE CHAR INTO THE COMMAND LINE AND ECHO IT JMP I COMPAR /SAME-SPECIAL HANDLING SPUT, JTECO /PUT CHAR INTO COMM LINE TAD QZ DCA QP TAD CHAR QPUT /STORE CHARACTER AWAY TAD I (QPNTR IAC ADJQ /ADJUST COMMAND LINE REGISTER LENGTH DCA I ERROR /CLEAR "ERROR JUST OCCURRED" FLAG TAD CHAR TYPE /TYPE THE INSERTED CHARACTER CLL TAD QZ TAD QLIMIT SNL CLA /TYPE A BELL IF THE LINE IS WITHIN 12 CHARS OF OVERFLOW JMP I SPUT TAD [7 TYPE JMP I SPUT QLIMIT, 12-QMAX PAGE /Q REGISTER PACK AND UNPACK /THE Q-REGISTERS ARE STORED IN THE UPPER 4 BITS OF THE WORDS /WHICH HAVE THE TEXT BUFFER CHARACTERS IN THEIR LOWER 8 BITS. /THEREFORE EACH Q-REGISTER CHARACTER TAKES 2 WORDS. QPUTS, 0 /STORE THROUGH POINTER "QP" AND BUMP POINTER CLL RTL RTL DCA GETQX /SAVE CHARACTER TAD QP CLL RAL DCA CHKCTC /COMPUTE CORE POINTER = 2*QP CDF 10 TAD GETQX AND [7400 DCA POPXX TAD I CHKCTC AND [377 TAD POPXX DCA I CHKCTC /STORE HIGH ORDER ISZ CHKCTC TAD GETQX CLL RTL RTL AND [7400 DCA GETQX TAD I CHKCTC AND [377 TAD GETQX DCA I CHKCTC /STORE LOW ORDER CDF 0 ISZ QP /BUMP POINTER JMP I QPUTS GETQX, 0 CLL RAL DCA CHKCTC /COMPUTE CORE POINTER = 2*AC CDF 10 TAD I CHKCTC AND [7400 /FETCH HIGH ORDER ISZ CHKCTC DCA QPUTS TAD I CHKCTC AND [7400 /FETCH LOW ORDER CLL RTR RTR TAD QPUTS /COMBINE TO FORM CHARACTER RTR RTR CDF 0 JMP I GETQX CHKCTC, 0 /SUBROUTINE TO CHECK FOR ^C IN KEYBOARD CLA OSR /READ SWITCH REGISTER DCA QPUTS TAD I QPUTS 7421 /DISPLAY INDICATED LOCATION IN MQ C7600, 7600 /JUST IN CASE THERE IS NO MQ KSF JMP I CHKCTC /NO CHAR IN KEYBOARD BUFFER - EXIT KRS AND [177 /KILL PARITY BIT TAD (-20 SNA /^P? JMP I (CTRLP /YES - BACK TO TECO INPUT PROCESSOR TAD CACR SZA CLA /^C? JMP I CHKCTC /NO - RESUME CTLC, TSF JCTLC, JMP CTLC /WAIT FOR TELETYPE TO DIE DOWN JMP I C7600 /RETURN TO PS/8 /"EX" AND "EC" COMMANDS EXIT, TAD JCTLC /"EX" COMMAND EXITC, DCA EXITG /"EC" COMMAND TAD WEND /CHECK FOR OPEN OUTPUT FILE SNA CLA JMP EXITG /NOPE, EXIT ALREADY EXLOOP, JMS I [NXTBUF /GET NEXT BUFFER TAD REND CIA TAD ZZ /CHECK FOR END-OF-FILE AND SZA CLA /TEXT BUFFER EMPTY JMP EXLOOP /NOT YET PUSHJ ENDFIL /CLOSE OUTPUT FILE EXITG, 0 /EITHER 0 (NOP) OR "JMP CTLC" /FALL INTO THE "POPJ" ROUTINE POPJXX, DCA GETQX /POPJ ROUTINE POP POPJXY, DCA POPXX TAD GETQX JMP I POPXX /PUSH DOWN LIST ROUTINES POPXX, 0 /POP ROUTINE CLA CMA TAD PDLP DCA PDLP TAD I PDLP JMP I POPXX PUSHXX, 0 /PUSH ROUTINE DCA I PDLP TAD PDLP TAD (-PDLEND /CHECK FOR OVERFILL SMA CLA ERR04, ERR /POKED OUT THE BOTTOM ISZ PDLP /SQUISH POINTER JMP I PUSHXX PUSHJY, 0 /PUSHJ ROUTINE DCA GETQX CLL IAC /LINK SHOULD BE 0 ON EXIT TAD PUSHJY PUSH TAD I PUSHJY JMP POPJXY PUSHLX, 0 /PUSH AND CLEAR A LIST CLL SMA /PUSH LIST IF AC<0, POP IT IF >=0 CMA STL DCA PUSHJY /SET COUNTER RAL /** DEPENDS ON FACT THAT POP=PUSH+1 ** TAD PUSHYY DCA PUSHYX /STORE EITHER A "PUSH" OR A "POP" POP /SAVE RETURN POINTER DCA CHKCTC PUSHLP, TAD I PUSHLX DCA GETQX TAD I GETQX PUSHYX, PUSH /PUSH OR POP DCA I GETQX /IF PUSHYX=PUSH, THIS ZEROES THE PUSHED LOCATION ISZ PUSHLX ISZ PUSHJY JMP PUSHLP TAD CHKCTC /RESTORE RETURN POINTER PUSHYY, PUSH JMP I PUSHLX PAGE /COMMANDS C,R,D,J,K,L CHRJ, DCA NFLG TAD N /COMMAND J JMP CLOQ CHRR, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1 CIA SKP CHRC, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1 TAD P /OFFSET RELATIVE TO . CLOQ, BZCHK /SEE IF IN RANGE B,Z DCA P /IN RANGE DNN3, CDF 0 POPJ CHRD, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1 SMA JMP PLUSND /+ND DCA CDT /-ND TAD CDT PUSHJ /DO (-)NC(+)ND CHRC+1 TAD CDT /FALL THROUGH "ADJ" ROUTINE ADJ, SPA /ADJUST BUFFER + OR - N CHARS JMP DNNC /-N CHARACTERS SNA /TEST FOR NOTHING POPJ /GO AWAY CLL CML /MOVE UP N CHARACTERS TAD ZZ /ADD TO MAX CHARACTER DCA R /NEW HIGHEST TAD R /SEE IF TOO HIGH TAD (-ZMAX SNL SZA CLA /TWO PLACES FOR OVERFLOW THERE ERR05, ERR TAD ZZ DCA Q TAD R DCA ZZ CDF 10 UPNL, TAD Q CIA TAD P SNA CLA /FINISHED? JMP DNN3 /YES CMA TAD Q DCA Q CMA TAD R DCA R TAD I Q /GET A CHAR AND [377 DCA CHLCMP TAD I R /BE CAREFUL NOT TO AND [7400 /DESTROY THE HIGH- TAD CHLCMP /ORDER 4 BITS DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD JMP UPNL DNNC, CIA CLL /REACHED FROM ADJ TAD P /MOVE DOWN N CHARACTERS SZL CLA CMA /DETECT GROSS OVERFLOWS BZCHK DCA Q /N IN AC TAD P DCA R CDF 10 DNN1, TAD ZZ CIA TAD Q SNA CLA /FINISHED? JMP DNN2 TAD I Q /GET A CHAR AND [377 DCA CHLCMP TAD I R /BE CAREFUL NOT TO AND [7400 /DESTROY THE HIGH- TAD CHLCMP /ORDER 4 BITS DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD ISZ Q ISZ R JMP DNN1 DNN2, TAD R DCA ZZ JMP DNN3 /L AND K COMMANDS CHRL, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1 CIA CLL /MAKE NEGATIVE SMA /DID IT? CMA STL /NO, MAKE MORE NEGATIVE DCA CDT /SAVE IN SUBR ENTRY CDF 10 SZL JMP CHRLM /NEGATIVE - GO TO BACKWARDS LOOP CHRLP, TAD P CIA TAD ZZ SNA CLA /IF WE ARE AT THE END OF THE BUFFER, JMP DNN3 /RETURN JMS CHLCMP /COMPARE CHARACTER AGAINST LINE FEED ISZ P JMP CHRLP /KEEP GOING UNTIL WE GET THERE OR OVERFLOW BUFFER CHRLM, CLA CMA CLL TAD P DCA P /MOVE POINTER BACKWARD 1 SNL JMP CHRLI /OOPS - PAST THE BEGINNING OF THE BUFFER - RETURN JMS CHLCMP /COMPARE CHARACTER AGAINST LINE FEED JMP CHRLM /NOT SATISFIED YET - KEEP LOOPING CHLCMP, 0 /COMPARISON SUBROUTINE TAD I P /DATA FIELD IS 10 AND [377 TAD [-12 SNA CLA /IS THE CHAR A LINE FEED? ISZ CDT /YES - IS THE COUNT EXHAUSTED? JMP I CHLCMP /NO - RETURN CHRLI, CLA IAC /WE'VE GONE FAR ENOUGH - SKIP JMP CHRC+1 /PAST THE LINE FEED WE'VE FOUND CDT, 0 /TEMPORARY CHRK, JMS I (NLINES /CONVERT LINES TO CHARS DCA CDT TAD M /SET POINTER DCA P /LOWER ARG TAD CDT PLUSND, SNA POPJ /IGNORE 0D CIA JMP DNNC /MOVE DOWN CORRECT NUMBER OF CHARACTERS PAGE /SEARCH SUBROUTINE - CALLED BY N,S,^R AND _ COMMANDS SEARCH, 0 GETN CIA DCA CSN /GET NUMBER OF OCCURRANCES TO SEARCH FOR QCHK /GET REPLACEMENT FOR ALTMODE, IF ANY TAD (STABLE-1 DCA SXR /INITIALIZE XR TAD [-40 DCA CSP SGTLP, QUOTST /GET A CHARACTER FROM THE SEARCH STRING JMP SCHQUO /OOPS- NO MORE SORT /SEE IF ITS SPECIAL SCHLST SCHTAB-SCHLST SSTCHR, DCA I SXR /STORE THE CHAR IN THE SEARCH BUFFER ISZ CSP JMP SGTLP /LOOP ERR06, ERR /OOPS - SEARCH BUFFER FULL! SCHQUO, TAD CSP TAD (40 /A NULL SEARCH STRING MEANS SNA CLA /USE THE PREVIOUS CONTENTS OF THE SEARCH BUFFER JMP CSST TAD (JMP CSK DCA I SXR /STORE TERMINATING JUMP AND BEGIN THE ACTUAL SEARCH CSST, TAD P DCA CSP JMP CSF+1 SCHINV, TAD CSNCL /^N, INVERT SKIP SENSE DCA CSWT CSL, TAD I SXR /GET A CHAR FROM THE SEARCH BUFFER SPA JMP SCCOMD /NEGATIVE CHARS ARE SPECIAL CIA CDF 10 TAD I P AND [377 CDF 0 CSWT, SZA CLA JMP CSF /FAIL TO MATCH ON THIS CHARACTER ISZ P CSG, TAD CSZCL DCA CSWT /RESTORE SEARCH TEST TAD ZZ CMA TAD P CSZCL, SZA CLA /CHECK FOR END OF BUFFER JMP CSL /NO DCA P CSZ, DCA NMT JMP I SEARCH CSK, ISZ CSN /GET NTH OCCURRENCE JMP CSF /MORE TO GO CMA JMP CSZ /GOT IT CSF, ISZ CSP /INDEX P TAD (STABLE-1 DCA SXR /INITIALIZE AUTO - INDEX TAD CSP DCA P JMP CSG SCCOMD, DCA .+1 /SPECIAL CHARACTERS ARE JUMPS 0 /GO WHERE THOU WILLST /SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X SCHTAB, SCHCTN /^N: ANYTHING BUT SCHCTQ /^Q: LITERALLY SCHCTS /^S: ANY SEPARATOR SCHCTX /^X: ANYTHING SCHCTQ, SCAN /GET THE NEXT CHARACTER JMP SSTCHR /AND STORE IT IN PLACE OF THE ^Q SCHCTN, TAD (SCHINV-SCHSEP SCHCTS, TAD (SCHSEP-CSWT+1 SCHCTX, TAD JMCSWT JMP SSTCHR /GO STORE A SPECIAL CHARACTER SCHSEP, CDF 10 /^S, LOOK FOR SEPARATOR TAD I P AND [377 TSTSEP /SHARED SORTING ROUTINE SKP CMA /SET AC=-1 IF NON-SEPARATOR JMCSWT, JMP CSWT-1 /GO CHECK RESULTS /S,N,^R AND _ COMMANDS CHRS, JMS SEARCH /S COMMAND CHKCLN, PUSHJ /FORM NUMBER FROM "NMT" NNEW /(APPLYING OPERATOR, IF NECESSARY) ISZ CLNF /WAS THERE A COLON ON THIS SEARCH? SKP /NO JMP I [IREST /YES - GO AWAY REGARDLESS OF RESULTS DCA CLNF /RESET COLON FLAG TO 0 ISZ N /DID WE SUCCEDD? JMP I (CSEM /NO - SIMULATE A SEMICOLON DCA NFLG /YES - HOWEVER, NO COLON MEANS NO RESULT JMP I [IREST CHBA, CLA IAC /_ COMMAND CHRN, DCA CNXT /N COMMAND - SET OUTPUT FLAG JMS SEARCH /DO A SEARCH CTCCHK /ALLOW LONG SEARCHES TO BE INTERRUPTED TAD REND CIA TAD ZZ CSNCL, SNA CLA /HAVE WE REACHED END-OF-FILE? JMP CHKCLN /YES - STOP AND ASSIGN VALUE TAD NMT SZA CLA /HAVE WE SUCCEEDED? JMP CHKCLN /YES - STOP AND ASSIGN VALUE TAD CNXT JMS I [NXTBUF /GET NEXT BUFFER JMP CSST /KEEP SEARCHING - RETURN TO CHRN+2 CNXT, 0 /OUTPUT FLAG CSP, 0 /TEMP P CTLR, JMS SEARCH /R COMMAND - DO SEARCH PART QSKP /COUNT UP STRING 2 TAD NMT SMA CLA JMP CHKCLN /FAILED, SET VALUE & EXIT TAD P /FIGURE OUT OFFSET TO FAKE OUT "I" ROUTINE CIA /SO THAT WE HAVE THE RIGHT INSERTION COUNT TAD CSP /BUT THE SIZE OF THE HOLE WE NEED DCA DVT1 /IS DECREASED BY THE LENGTH OF THE SEARCH STRING. TAD CSP /RESET DCA P /TEXT POINTER PUSHJ /INSERT CIL1+2 /STRING 2 JMP CHKCLN /SET VALUE AND EXIT CSN, 0 PAGE /NUMBER PROCESSORS: /COMMANDS B,F,H,Z,. NMBR, TAD CHAR /NUMBER FOUND IN COMMAND STRING TAD [-60 DCA NMT NCHK /CHECK NUMBER FLAG JMP NNEW /NOT UP, NEW OPERAND TAD NP /MULTIPLY PREV DIGITS BY 10 CLL RTL NMRBAS, TAD NP /REPLACED BY "NOP" FOR OCTAL CLL RAL NMR, TAD NMT DCA NP /CURRENT NUMBER CLL TAD NP NOPR, SKP /DISPATCH JUMP FOR OPERATOR CIA TAD NACC /CURRENT EXPRESSION VALUE NRET, DCA N RAR DCA NLINK /SAVE LINK FOR POSSIBLE COMPARISON TEST CLA CMA /SET NUMBER FLAG DCA NFLG DCA OFLG /CLEAR OPERATOR FLAG POPJ CHRH, PUSHJ /COMMAND H CCMA+3 /SET M=0 AND COMMA FLAG ON AND FALL INTO "Z" CHRZ, TAD ZZ /COMMAND Z CTLH, /^H COMMAND - TIME OF DAY - NOT IMPLEMENTED CHRB, /COMMAND B NCOM, DCA NMT /COMMON TO ALL NUMBER ROUTINES NNEW, TAD OFLG /CHECK OPERATOR FLAG SZA CLA /MIDDLE OF EXPRESSION? JMP NMR /YES DCA NACC /NO, CLEAR ACCUMULATOR TAD NSKP /ASSUME + DCA NOPR JMP NMR NP, 0 /VALUE OF CURRENT NUMBER CDOT, TAD P /COMMAND . JMP NCOM /COMMANDS &,#,/,*,-,+,(,) CAMP, MTWO /LOGICAL AND CNBS, TAD (NIOR-NDIV /LOGICAL OR CVIR, TAD [NDIV-NMPY /DIVISION CAST, TAD (NMPY&177+5200-7400 /MULTIPLICATION CMIN, TAD [7400-SKP /SUBTRACTION CPLS, TAD NSKP /ADDITION DCA NOPR /COMMON TO ALL NUMERIC OPERATORS TAD N DCA NACC DCA NP STA /SET OPERATOR FLAG DCA OFLG DCA NFLG /CLEAR NUMBER FLAG POPJ NAND, AND NACC /BITWISE .AND. OF BINARY NUMBERS JMP NRET /KEEP THESE TWO OPNS TOGETHER NIOR, CMA /BITWISE .IOR. OF BINARY VALUES AND NACC /USE VENN DIAGRAM TO PROVE IT TAD NP JMP NRET NMPY, CIA DCA ND TAD NACC ISZ ND JMP .-2 JMP NRET NACC, 0 /VALUE OF EXPRESSION WITHOUT NP NDIV, DCA ND TAD NACC MQLDVI ND, 0 JMP NRET COPR, TAD OFLG /COMMAND ( SZA CLA /SEE IF OPENING OF EXPRESSION JMP .+3 /NO PUSHJ /YES, SO CLEAN UP FIRST NCOM /RECURSION IS NICE! MTWO PUSHL NACC NOPR DCA NMT JMP CPLS /CLEAN OUT INSIDE PARENS CCPR, CLA IAC POPL NOPR NACC TAD N JMP NOPR /COMBINE OLD NUMBER AND PARENTHESIZED RESULT /COMMANDS ^T,^F,^^,^Z,^E, Q AND % CTLT, LISTEN /^T COMMAND - VALUE OF NEXT CHAR FROM TTY TYPE /ECHO THE CHARACTER TAD SCHAR /GET THE CHARACTER JMP NCOM /JUMP INTO NUMBER PROCESSOR CTLF, CLA OSR SKP /^F COMMAND - VALUE OF CONSOLE SWITCHES CTUA, SCAN /^^ COMMAND - VALUE OF NEXT CHAR IN COMMAND LINE JMP NCOM /GO INTO NUMBER PROCESSOR NGET, 0 /SUBROUTINE TO GET LAST NUMBER, WITH DEFAULT TAD N /VALUES OF +1 (NO NUMBER) OR -1 (JUST A - SIGN) NCHK NSKP, SKP /AHA - NO DIGITS SEEN JMP I NGET /DIGITS SEEN - RETURN THEM CLA IAC /NO DIGITS SEEN PUSHJ /MAKE BELIEVE WE SAW THE DIGIT "1" NCOM /AND CREATE A NUMBER FROM IT (TAKING ANY JMP NGET+1 /OPERATORS HNTO ACCOUNT) AND USE IT CTLZ, TAD QZ /COMMAND ^Z JMP NCOM /RETURN NUMBER OF CHARACTERS IN ALL Q-REGS. CHRQ, QREF /COMMAND Q JMP CQOA CPCS, QREF /COMMAND % GETN CQOA, ISZ QPTR /POINT TO VALUE WORD TAD I QPTR /INCREMENT VALUE BY ARGUMENT DCA I QPTR TAD I QPTR JMP NCOM /MAKE A NUMBER CTLE, TAD FFFLAG /^E COMMAND - RETURNS FORM FEED FLAG JMP NCOM /RETURN -1 IF F.F., 0 OTHERWISE CTLV, TAD (VERSN /^V COMMAND - RETURNS THE CURRENT VERSION NUMBER JMP NCOM CTLD, TAD [4 /SET RADIX DECIMAL CTLO, TAD (ORAD /SET RADIX OCTAL DCA RADIX TAD I RADIX DCA NMRBAS /EITHER "NOP"(8) OR "TAD NP"(10) POPJ PAGE /COMMANDS = AND \ - NUMERICAL OUTPUT CEQL, NCHK /COMMAND = JMP NERR /NO NUMBER JMS ZEROD TPUT CRLF POPJ CBSL, NCHK /COMMAND \ JMP CBSN JMS ZEROD UPOC POPJ CBSN, PUSHJ NMBR+2 /INITIALIZE RESULT TO 0 CDF 10 TAD I P AND [377 /GET CURRENT CHARACTER CDF 0 TAD (-55 /CHECK FOR MINUS SIGN SZA JMP .+3 /NOT MINUS PUSHJ CMIN /RECORD MINUS SIGN CIA CLL RTR SNA CLA /CHECK FOR PLUS SIGN CBSNP, ISZ P /BUMP POINTER PAST SIGN CDF 10 TAD I P /GET A CHAR AND [377 CDF 0 TAD (-72 CLL TAD CALF SNL /IS IT A DIGIT? POPJ /NO PUSHJ NMBR+2 /YES - ACCUMULATE IT JMP CBSNP /AND LOOP TYCRLF, 0 /TYPE A CR AND LF TAD CACR /CR XTYPE, TYPE TAD CALF /LF TYPE JMP I TYCRLF /RETURN /NUMERICAL OUTPUT ROUTINE ZEROD, 0 DCA TYCRLF /INITIALIZE "LEADING ZEROS" FLAG TAD I ZEROD ISZ ZEROD DCA SORTB /SAVE OUTPUT ROUTINE ADDRESS MTHREE DCA CUPPER /ITERATION COUNT TAD RADIX DCA XR ZDIGIT, TAD I XR DCA DIV1 /GET DIVISOR TAD N MQLDVI /DIVIDE BY A POWER OF THE BASE DIV1, 0 TAD TYCRLF SNA JMP LZ /IGNORE LEADING ZEROS TAD (60 JMS I SORTB STL RAR DCA TYCRLF /SET LEADING ZEROS FLAG LZ, TAD DVT1 /GET REMAINDER DCA N ISZ CUPPER /GO AROUND AGAIN? JMP ZDIGIT /WHY NOT? TAD N TAD (60 JMS I SORTB /OUTPUT LAST DIGIT NO MATTER WHAT JMP I ZEROD CTLA, TAD XTYPE CEXP, DCA WHERTO TAD CHAR DCA QUOTE /TERMINATING CHAR SAME AS COMMAND CHAR DCA NFLG /KILL NUMBER IF PRESENT CTLALP, QUOTST JMP I [IREST WHERTO, 0 /TYPE OR IGNORE THE CHARACTER CLA JMP CTLALP SORTB, 0 /SORT AND BRANCH ROUTINE DCA SCHAR /SAVE SORT CHAR STA TAD I SORTB /GET POINTER TO LIST ISZ SORTB DCA XR SORTA1, TAD I XR /GET ITEM IN TEST LIST SPA /END MARKED BY NEG VALUE JMP SORTA2 /FELL OUT BOTTOM CIA STL TAD SCHAR SZA CLA /COMPARE SORT CHAR JMP SORTA1 /NOT IT. TAD XR /GOT IT. NOW MAKE INDEX TAD I SORTB /TO JUMP TABLE DCA CUPPER /THIS IS TABLE POINTER TAD I CUPPER /GET JUMP ADDRESS FROM TABLE DCA CUPPER /AND GO THERE CLA CLL JMP I CUPPER SORTA2, CLA CLL /FELL OUT BOTTOM ISZ SORTB /SO CHARACTER NOT IN LIST TAD SCHAR /CARRY IT BACK TO JMP I SORTB /DO SOMETHING ELSE CSMC, SCAN /GET NEXT CHARACTER UPPERC /FORCE UPPER CASE AND [77 /MAKE IT A CONTROL CHARACTER DCA SCHAR JMP SORTA1 /SUBSTITUTE IT FOR THE UPARROW CUPPER, 0 /FORCE CHARACTER TO UPPER CASE TAD [-100 SMA /IF ITS >100 AND (37 /REDUCE IT TO BE <140 TAD [100 JMP I CUPPER /RETURN PAGE /COMMANDS P AND T CHRP, TAD CFLG SPA CLA /IS THIS COMMAND M,NP? JMP CHRW /YES - TREAT LIKE M,NW GETN /COMMAND P - GET # OF PAGES CIA DCA CPCT CPOA, PUSHJ CPOC /DO N TAD ZZ SNA CLA /IF BUFFER WAS NOT EMPTY, JMP .+3 TAD CAFF OUTPUT /OUTPUT A FORM FEED BETWEEN BUFFERS TAD SCANP TAD QBASE GETQ /LOOK AHEAD ONE COMMAND CHARACTER TAD (-127 /IS IT A W? SNA CLA /IF SO, AND TAD QLENGT /IF WE HAVE NOT RUN OFF THE END OF THE COMMAND CIA CLL TAD SCANP /LINE, INHIBIT THE INPUT PART OF THIS SNL CLA /OPERATION. JMP .+3 /(WHOEVER THOUGHT OF THE "PW" COMMAND SHOULD BE SHOT) PUSHJ CHRY ISZ CPCT JMP CPOA POPJ CPCT, 0 CPOC, PUSHJ CHRH CHRW, CLA IAC /** DEPENDS ON FACT THAT OUTPUT=TYPE+1 ** CHRT, TAD (TYPE /W AND T COMMANDS - SAME THING, DIFFERENT DEVICES DCA CWOUT JMS NLINES /CONVERT LINES TO CHARS CWOA, CMA DCA NLINES /SET CHARACTER COUNT TAD NLINES CIA MQLDVI /COMPUTE HOW MANY WORDS THIS OUTPUT WILL USE 6 /(BY TAKING 2/3 OF THE NUMBER OF CHARACTERS, CLL CML RTL / BU THAT'S SLOW SO WE TAKE 4/6 AND ROUND) JMS I (FITS /DETERMINE WHETHER THE OUTPUT WILL FIT ERR17, ERR /NO - TELL THE USER CLA /CLEAR CRAP FROM AC JMP CWOC CWOB, CDF 10 TAD I M AND [177 CDF 0 CWOUT, 0 /TYPE, OUTPUT, OR QPUT ISZ M CWOC, ISZ NLINES /DONE? JMP CWOB /NO POPJ /X COMMAND AND LINES-TO-CHARACTER CONVERTOR CHRX, QREF /COMMAND X JMS NLINES /CONVERT LINES TO CHARS ADJQ /ADJUST Q-REGISTERS AND SET UP NEW LENGTH. TAD (QPUT DCA CWOUT /SET OUTPUT ROUTINE TO STORE INTO Q REG TAD MQ /LOAD THE CHARACTER COUNT JMP CWOA /GO TO TEXT OUTPUTTER NLINES, 0 /CONVERT + OR - N LINES AROUND . TO CHARS M,N ISZ CFLG /WAS THERE A COMMA? SKP /NO JMP MFROMN /YES - DON'T CONVERT LINES TO CHARS TAD P DCA M PUSHJ /CHRL DOES A "GETN" CHRL /TO GET THE DEFAULT VALUES OF N TAD P DCA N TAD M DCA P MFROMN, DCA NFLG /CLEAR NFLG IN CASE COMMA FLAG WAS ON TAD N BZCHK /IS N OK? CMA CLL /YES - COMPUTE N-M TAD M /BY COMPUTING M-N-1 CMA /AND COMPLEMENTING IT SNL /IS M>N? JMP I NLINES /NO - RETURN N-M TAD M /N-M+M=N NOW IN AC. DCA CPCT /INTERCHANGE M AND N TAD M DCA N TAD CPCT DCA M JMP MFROMN /COMMANDS ; AND > CSEM, TAD ITRST /COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH SNA ERR09, ERR /IF NOT IN ITERATION DCA CPCT TAD N SMA CLA NCHK JMP ZRON /NO NUMBER - IGNORE IT, WE DID IT ALREADY SKPSET /NO, PLOD THROUGH 76 /LOOKING FOR > TAD ITRST /GOT IT CIA /HOWEVER, WE HAVE TO CHECK WHETHER THIS TAD CPCT /IS THE RIGHT ONE, AS WE CAN NEST SZA CLA /ITERATION BRACKETS ( I.E. ..>). JMP I (CSMO /NO - POP UP A LEVEL AND KEEP SEARCHING ENTRCE /ITS THE RIGHT ONE - TURN TRACE BACK ON JMP CGSG CHGT, ISZ ITRCNT /LOOK FOR COUNT EXHAUSTED JMP CGTC /NO, CONTINUE CGSG, CLA IAC POPL ITRCNT ITRST JMP I [IREST CGTC, TAD ITRST SNA ERR10, ERR /IF NOT IN ITERATION DCA SCANP /RESET TO BEGINNING OF ITERATION ZRON, DCA NFLG /KILL NUMBER FLAG JMP I [IREST PAGE /COMMANDS A AND Y CHRA, NCHK /COMMAND A JMP CHAA TAD N TAD P DCA R CDF 10 TAD R CMA CLL TAD ZZ /RETURN 0 IF POINTER OUTSIDE RANGE [0,Z-1] SZL CLA /OTHERWISE VALUE OF CHARACTER AT POINTER POSITION TAD I R AND [377 CDF 0 JMP I (NCOM CHRY, DCA NFLG /COMMAND Y - IGNORE NUMERICAL ARG, IF ANY DCA ZZ DCA P /WIPE OUT THE BUFFER CHAA, TAD (ZMAX-1 AND REND CIA CLL TAD ZZ /IF WE HAVE ALREADY SEEN THE INPUT EOF, SZL CLA /OR IF WE'RE ALREADY FULL(OR NEARLY SO) JMP APLF /GET OUT DECGET, ISZ ICRCNT JMP I2 /NO NEED TO READ CLL TAD INRSIZ TAD INRCNT SNL DCA INRCNT /UPDATE RECORD COUNT CLL CML CMA RTR /IF WE OVERFLOWED THE END OF THE FILE, RTR RTR /SHORTEN THE READ BY THE CORRECT AMOUNT TAD INCTLW DCA INCTRL /SO THAT WE WILL NOT READ TOO FAR JMS I INHND I3, INCTRL, 0400 BUFIN, IN /6200 IF 8K, 5600 IF 12K IBLK, 0 SMA CLA SKP JMP INER /IGNORE END-OF-FILE ERRORS, WE'LL SEE THE ^Z. TAD IBLK TAD INRSIZ /BUMP RECORD NUMBER BY THE MAXIMUM NUMBER DCA IBLK /(IF WE READ SHORT ITS THE LAST ONE ANYWAY) CLA CMA TAD BUFIN DCA INXR /SET UP INPUT XR TAD INPCNT DCA ICRCNT MTHREE DCA I3 I2, CDF 0 /CDF 20 IF 12K ISZ I3 JMP I1 /NORMAL CHARACTER MTHREE /WEIRD CHARACTER-RESET SWITCH DCA I3 MTWO TAD INXR DCA INXR /MOVE INPUT XR BACK TO BEGINNING OF DBLWORD TAD I INXR AND [7400 DCA FFFLAG /TEMP TAD I INXR AND [7400 CLL RTR RTR TAD FFFLAG CLL RTR RTR SKP I1, TAD I INXR CDF 0 AND [177 /MASK OFF GARBAGE /INPUT CHARACTER IN AC SZA TAD (-177 SNA /IGNORE BLANK TAPE AND RUBOUTS JMP DECGET TAD (177-32 SNA JMP APFS /ITS A ^Z TAD (16 SNA JMP APFF /ITS A FORM FEED TAD CAFF /RESTORE CHAR CDF 10 DCA MQ /SAVE CHAR TAD I ZZ /PROTECT HIGH- AND [7400 /ORDER BITS TAD MQ /OF TARGET DCA I ZZ /STORE CHAR IN BUFFER TAD MQ CDF 0 ISZ ZZ TAD [-12 SNA CLA /IF THE CHAR IS A LINE FEED, TAD (-310 /CHECK THAT THE BUFFER IS NOT NEARLY FULL JMP CHAA APFS, DCA REND /SIGNAL END OF FILE SKP APFF, STA APLF, DCA FFFLAG /SET FORM FEED FLAG POPJ INER, DCA REND /INHIBIT FUTURE INPUTS ERR15, ERR INCTLW, 401 /1021 IF 12K MACHINE INPCNT, 6400 /5000 IF 12K MACHINE CCMA, NCHK /COMMAND , JMP NERR /NUMBER FLAG NOT SET TAD N /MOVE N TO M DCA M /*** ENTERED HERE BY "H" COMMAND *** DCA N /AND CLEAR N STA DCA CFLG /SET COMMA FLAG POPJ QTST, 0 /SUBROUTINE TO GET A CHAR AND TEST FOR ALTMODE SCAN SORT QUOTE QTST-QUOTE /RETURN IF QUOTE FOUND ISZ QTST JMP I QTST /SKIP-RETURN WITH AC INTACT IF NOT FOUND PAGE /TELETYPE ROUTINES TPUT, 0 /TELETYPE OUTPUT DCA CHKNF TPUTX, KSF JMP NOCOCK /IF NO CHAR IN TTY BUFFER, SKIP ^O TEST KRS AND [177 TAD (-17 /INHIBIT PRINTING AS LONG AS THERE SNA CLA /IS A ^O IN THE KEYBOARD BUFFER. JMP I TPUT NOCOCK, TSF /WAIT FOR TEETYPE FLAG TSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE TAD CHKNF TLS CLA CTCCHK /CHECK FOR ^C BEFORE WE LEAVE JMP I TPUT TYPCTV, 0 /TELETYPE STUFFER SORT CTLBEL CTLTAB-CTLBEL ISZ COLCT /BUMP COLUMN COUNTER TAD [-40 SMA CLA /IS THE CHAR A CONTROL CHARACTER? JMP OUTLF /NO TAD (136 JMS TPUT /OUTPUT "^" OBMPTC, ISZ COLCT TAD [100 OUTLF, TAD SCHAR JMS TPUT JMP I TYPCTV COLCT, 0 OUTCR, DCA COLCT /RESET CHAR COUNT JMP OUTLF OUTALT, TAD (-67 /100-67+33=44="$" JMP OBMPTC /BUMP COLUMN COUNT AND PRINT DOLLAR SIGN OUTVT, TAD [4 OUTFF, TAD [7770 /FORM FEED IS 8 LINE FEEDS, VERT TAB IS 4 DCA COLCT ASR33, TAD CALF /SIMULATE FORMFEEDS AND VERT TABS WITH LINEFEEDS JMP OUTCOM OUTHT, TAD COLCT /COLUMN COUNTER, MOD 8 AND [7 TAD [7770 /SIMULATE TABS WITH SPACES DCA COLCT 40 /TAKE UP SPACE SO ASR-35 ROUTINE WILL JUST FIT TAD .-1 /USE SPACES FOR TABS OUTCOM, JMS TPUT /PUT ONE OUT THE ISZ COLCT /WINDOW JMP TPUTX /STILL MORE INSIDE JMP I TYPCTV /ROUTINE TO MANIPULATE Q-REGISTER STORAGE QADJ, 0 DCA MQ /SAVE NEW LENGTH OF Q-REGISTER QSUM /COMPUTE POINTER TO CURRENT Q-REGISTER TAD QP TAD I QPTR DCA R TAD I QPTR /GET ITS CURRENT LENGTH CIA CLL TAD MQ /COMPUTE DIFFERENCE SNL /ADJUST Q-REGS JMP QDNN /TO HOLD NEW STRING SNA /CHECK FOR ZERO JMP QADJDN /NOTHING TO DO TAD QZ /MOVE Q-REGISTERS UP TO INSERT CHARS DCA QP /(LINK IS 1 FROM PREVIOUS SNL) TAD QP TAD MQMAX /SEE IF OUT OF BOUNDS SNL CLA /TWO PLACES TO TOGGLE LINK THERE ERR12, ERR /GETTING TOO FULL TAD QZ DCA Q TAD QP DCA QZ ISZ QP QUPL, TAD Q CIA TAD R SNA CLA JMP QADJDN CMA TAD Q DCA Q MTWO TAD QP DCA QP TAD Q GETQ QPUT JMP QUPL QDNN, TAD R /MOVE Q-REGS DOWN TO ABSORB CHARACTERS DCA QP QDNN1, TAD QZ CIA TAD R /-NUMBER OF CHARS TO MOVE SNA CLA /DONE? JMP QDNNF /YES TAD R GETQ QPUT ISZ R JMP QDNN1 /LOOP AGAIN QDNNF, TAD QP /SET NEW VALUE DCA QZ /OF HIGHEST CHAR QADJDN, TAD MQ DCA I QPTR /SAVE NEW LENGTH OF Q-REGISTER IN Q-REG TABLE TAD QCMND /SET UP COMMAND LINE AGAIN SETCMD /AS IT MAY HAVE BEEN SHUFFLED. QSUM /RECOMPUTE POINTER TO BEGINNING OF NEW Q-REG JMP I QADJ MQMAX, -QMAX CHKNF, 0 /CHECK AND RESET NUMBER FLAG ISZ NFLG SKP CLA /AC:=0 IF NO NUMBER ISZ CHKNF /SKP RETURN IF NUMBER JMP I CHKNF CHKBZ, 0 /SEE THAT B .LE. C(AC) .LE. ZZ CIA CLL TAD ZZ SNL /13-BIT ARITHMETIC ERR11, ERR /C(AC)>ZZ CIA TAD ZZ /RESTORE ORIGINAL AC JMP I CHKBZ PAGE /COMMANDS M AND < /AND Q-REGISTER STORAGE COMLST, 7 /^G, COMMAND LINE EDIT LIST 15 /CR, INSERT CR & LF 177 /RUBOUT 33 /^[, ALT MODE 77 /? CHRM, QREF /COMMAND M TAD (-4 /4 ITEMS PUSHED TO PUSHL /SAVE CURRENT MACRO STATE QCMND MPDL ITRST /SO THE "O" COMMAND WILL WORK IN MACROS SCANP /ZEROED BY "PUSHL" TAD PDLP /MUST CHECK PDL AT END OF MACRO CIA DCA MPDL TAD QNMBR /Q-REGISTER TO EXECUTE SETCMD /SET COMMAND LINE TO THIS Q-REG POPJ /LEAVE NUMBER FLAG ALONE AND EXIT QOVER, 0 /SUBROUTINE TO SKIP TO END OF STRING QCHK /GET THE QUOTE CHARACTER (IF ANY) TAD SCANP DCA OSCANP /SAVE BACKUP SCAN POINTER QOVERL, QUOTST JMP I QOVER /FOUND AN ALTM OR EQUIVALENT - RETURN CLA /NOT END JMP QOVERL /SKIP ANOTHER CHAR ALTLST, 175 /ALT MODE 176 /ANOTHER ALTMODE CHLT, MTWO /COMMAND < PUSHL ITRST ITRCNT TAD N CIA /MAKE NEGATIVE DCA ITRCNT /SET UP TERMINATION TAD SCANP /SAVE CURRENT SCAN PNTR DCA ITRST /ALWAYS .GE. 1 IN ITERATION DCA NFLG /CLEAR NUMBER FLAG POPK, POPJ COMTAB, TBEL /DISPATCH TABLE FOR COMMAND EDIT TCRLF ROCMND TALTM TQMK CTLTAB, OUTLF /BELL OUTFF OUTVT OUTLF OUTCR POUTHT, OUTHT OUTALT ALTTAB, ALTMOD ALTMOD /Q-REGISTER STORAGE - EACH Q-REGISTER TAKES 2 WORDS. /WORD 1 CONTAINS THE LENGTH OF THE CHARACTER PART OF THE REGISTER (IF ANY) /WORD 2 CONTAINS THE VALUE OF THE NUMERIC PART OF THE REGISTER (IF ANY) QARRAY, ZBLOCK 110 /36 Q-REGISTERS * 2 WORDS/REGISTER = 72 WORDS QPNTR, QMAX-1 /FAKE Q-REGISTER FOR INPUT LINE - LENGTH ONLY. PAGE /Q-REGISTER SUBROUTINES QSUMR, 0 /COMPUTE POINTER TO Q-REG SNA TAD QNMBR /NORMALLY USES QNMBR, BUT CAN BE OVERRIDDEN BY AC CIA DCA QP TAD (QARRAY /BASE ADDR OF Q-REG POINTERS DCA QPTR JMP QSUMB QSUML, TAD I QPTR /ADD # OF CHARS IN LOWER REG ISZ QPTR /SKIP VALUE WORD ISZ QPTR /POINT TO NEXT Q-REG QSUMB, ISZ QP /REACHED OUR Q-REGISTER YET? JMP QSUML /NO - ADD IN ANOTHER DCA QP /SET Q-REGISTER POINTER TO BASE OF DESIRED REGISTER JMP I QSUMR SGET, 0 /SCAN COMMAND LINE OR MACRO TAD QLENGT CIA CLL TAD SCANP SZL CLA /CHECK THAT WE ARE STILL INSIDE THE COMMAND LINE JMP SGOVFL /NO - COMMAND DONE TAD SCANP /GET CHARACTER POSITION IN LINE TAD QBASE /ADD IT TO THE ADDRESS OF THE LINE GETQ /AND GET THAT CHARACTER. DCA QSUMR TAD TFLG AND QSUMR /IF THE TRACE FLAG IS ON, SZA TYPE /PRINT THE CHAR TAD QSUMR ISZ SCANP /INCREMENT CHARACTER POINTER AFTER FETCH JMP I SGET /RETURN SGOVFL, TAD MPDL /"MPDL" IS THE PUSHDOWN POINTER ON ENTRY TO THIS SNA /MACRO. IF IT IS 0, WE ARE NOT IN A MACRO JMP I (T1 /SO RETURN TO THE USER TAD PDLP /CHECK THAT THE ENDING POINTER IS THE SAME IAC SZA CLA /AS THE ENTRY ONE - OTHERWISE WE HAVE ERR13, ERR /SCREWED UP SOMEHOW (LIKE WE ARE IN THE MIDDLE POP DCA SCANP POP DCA ITRST POP /OF A COMMAND). RESTORE THE PREVIOUS VALUES DCA MPDL /OF MPDL, THE SCAN POINTER AND THE COMMAND LINE POP /POINTER FROM THE PUSHDOWN LIST SETCMD JMP SGET+1 /AND FETCH A CHARACTER FROM THE UPPER LEVEL. CMDSET, 0 /SUBROUTINE TO SET UP COMMAND LINE POINTERS DCA QCMND /STORE IN COMMAND LINE NUMBER TAD QCMND QSUM TAD QP /GET FIRST LOCATION IN COMMAND LINE DCA QBASE /AND STORE IN "QBASE" TAD I QPTR DCA QLENGT /STORE THE LINE LENGTH IN "QLENGT" JMP I CMDSET /RETURN QREFER, 0 /SET UP POINTERS FOR Q-REG REFERENCE SZA JMP QREFEX /AHA - WE ALREADY HAVE THE Q-REGISTER SCAN /GET Q-REGISTER IDENTIFIER DCA QNMBR TAD QNMBR TSTSEP /TEST FOR ALPHANUMERIC (LOWER CASE LEGAL) ERR03, ERR /OOPS - BAD Q-REGISTER REFERENCE TAD QNMBR UPPERC /FORCE UPPER CASE TAD [7700 SPA /NUMERIC? TAD [7 /YES - FORCE NUMBERS UP TO ABUT LETTERS TAD CALF /FORCE IDENTIFIER INTO THE RANGE 1-44 (OCTAL) QREFEX, DCA QNMBR /STORE AWAY NUMBER FOR FURTHER REFERENCE QSUM /COMPUTE QP AND QPTR JMP I QREFER /RETURN /SORT LIST FOR " COMMAND CNDTAB, GETSKP /LEGAL CONSTITUENT OF SYMBOL FOR ASSEMBLER GETSKP+1 /POSITIVE, NON-ZERO GETSKP+2 /NON-ZERO GETSKP+3 /NEGATIVE GETSKP+4 /AFTER GETSKP+5 /BEFORE GETSKP+6 /ZERO CNDLST, 103 /C 107 /G 116 /N 114 /L 101 /A 102 /B 105 /E /COMMANDS " AND ' CDBQ, NCHK /COMMAND " JMP NERR /NO NUMBER TO TEST SCAN SORT CNDLST CNDTAB-CNDLST JMP SERR /NO SUCH TEST GETSKP, TAD (TSTSEP-7750 /TSTSEP - (SPA SNA) TAD [SPA SNA-SNA TAD (SNA-SMA TAD (SMA-SNL TAD [SNL-SZL TAD [SZL-SZA TAD SZACLA DCA SKIP /COMPUTED INSTRUCTION TAD NLINK CLL RAL /SET UP THE LINK TAD N /PERFORM TEST SKIP, HLT /TEST SKIPS IF TRUE SZACLA, SZA CLA /NOT TRUE! - THIS ALWAYS SKIPS POPJ /CONDITION SATISFIED STA /NOT SATISFIED DCA CNDN /BEGINNING SKIPPING COMMANDS SKPSET /CALL SKIPPING ROUTINE 47 /FIND A ' ISZ CNDN /FOUND A ' RESORT /NEED ANOTHER: BACK TO CSML ENTRCE /RE-ENABLE TRACE JMP I [IREST /COMMAND ' NO ACTION TO TAKE CNDI, SCAN /HIT ANOTHER " (** USED AS END OF LIST **) STA /SO SKIP MATCHING ' TAD CNDN DCA CNDN RESORT /GO BACK TO CSML CNDN, 0 /COUNTER FOR " NESTING PAGE /: AND O COMMANDS CCLN, STA /: COMMAND DCA CLNF /SET COLON FLAG POPJ /SO NEXT SEARCH WILL HAVE A NUMERIC VALUE CHRO, TAD SCANP /O COMMAND DCA COOQ /SAVE CURRENT SCAN POINTER DCA NFLG DCA QFLG /QUOTED "O" COMMAND NOT ALLOWED QSKP /CHECK THAT THERE IS REALLY A STRING HERE /BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS /FROM THIS STRING IN THE SEARCH LOOP. TAD ITRST /"O" ONLY SCANS FROM THE BEGINNING OF THE DCA SCANP /CURRENT ITERATION LOOP. /(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN) SKPSET CS41, 41 /SEARCH FOR ! TAD CS41 DCA QUOTE /SET QUOTE CHAR TO ! TAD COOQ TAD QBASE DCA QP /SET UP PTR TO ACCES GOTO STRING COOC, TAD QP GETQ /GET CHAR FROM GOTO STRING CIA DCA MQ /SAVE IT QUOTST /GET CHAR FROM LABEL JMP COOB /LABEL EXHAUSTED TAD MQ SZA CLA /MATCH? JMP CSMQ /NO - REJOIN SEARCH ROUTINE FOR ANOTHER ! ISZ QP JMP COOC COOB, TAD MQ TAD CAAM /IS GOTO STRING EXHAUSTED TOO? SZA CLA JMP CSMQ+1 /NO - REJOIN ! SEARCH ROUTINE ENTRCE /RE-ENABLE TRACE JMP I [IREST COOQ, 0 /ROUTINE TO SKIP COMMANDS UP TO A CHARACTER SETSKP, 0 /SET UP TO SKIP COMMANDS TAD I SETSKP DCA SKPLST /CHAR TO TRAP ON NOTRCE /DISABLE TRACE MODE CSML, SCAN UPPERC /FORCE UPPER CASE SORT SKPLST SKPTAB-SKPLST CSMK, CLA /CLEAR AC JMP CSML /KEEP SKIPPING CHARACTERS CSMD, SCAN /CLEAR OUT MODIFIER JMP CSMK CSMU, SCAN /SKIP ^U COMMAND SKP CLA /GET RID OF Q-REG NUMBER QSKP /^R COMMAND - SKIP FIRST STRING CSMQ, QSKP /SKIP OVER A QUOTED STRING PUSHJ IREST /FIX UP QUOTE CHAR JMP CSML /KEEP GOING CSMY, TAD SCHAR /SKIP ROUTINE FOR ^A AND ! DCA QUOTE /WE MUST SCAN UNTIL WE FIND JMP CSMQ /A COPY OF THE COMMAND CHARACTER. CSME, SCAN /FOUND E COMMAND UPPERC /FORCE UPPER CASE SORT ESKLST /LOOK FOR ER & EW ESKTAB-ESKLST /USE CSMQ TO SKIP JMP CSMK /NO STRING CSMI, POP /SAVE RETURN POINTER DCA CSTMP PUSHJ /FOUND < CHLT /PUSH DOWN INTO ITERATION JMP CSMX CSMO, POP /SAVE RETURN POINTER DCA CSTMP PUSHJ /FOUND > CGSG /POP OUT OF ITERATION CSMX, TAD CSTMP /RESTORE RETURN PUSH /POINTER JMP CSML /CONTINUE CSTMP, 0 SKPRTN, JMP I SETSKP /RETURN, FALLING THROUGH THE ARGUMENT /SORT LIST FOR SKIPPING OVER COMMANDS SKPLST, 0 /TRAP CHAR 41 /! 76 /> 74 /< 42 /" 136 /^ 100 /@ 1 /^A 11 /TAB 25 /^U 36 /^^ 105 /E 111 /I 116 /N 117 /O 22 /^R 123 /S 137 /_ 121 /Q 125 /U 130 /X 107 /G 115 /M 45 /% CSMA, STA /LIST TERMINATOR JMP CSMQ+1 /FOUND @ - SET QUOTE FLAG AND CONTINUE /DISPATCH TABLE FOR SKIPPING OVER COMMANDS: SKPTAB, SKPRTN /DESIRED CHARACTER - RETURN CSMY /! CSMO /> CSMI /< CNDI /" CSMC /^ CSMA /@ CSMY /^A CSMQ /TAB CSMU /^U CSMD /^^ CSME /E ESKTAB, CSMQ /I OR ER CSMQ /N OR EW CSMQ /O OR EB CSMQ-1 /^R CSMQ /S CSMQ /_ CSMD /Q CSMD /U CSMD /X CSMD /G CSMD /M CSMD /% /COMMANDS ^U AND E - ALSO ERROR ROUTINE CTLU, QREF /COMMAND ^U QSKP /COUNT UP STRING TAD OSCANP CMA TAD SCANP /LENGTH OF STRING ADJQ /ADJUST Q-REGISTERS AND SET NEW LENGTH TAD OSCANP /RESET SCAN POINTER DCA SCANP DCA NFLG NOTRCE CCUB, QUOTST JMP CTLUND QPUT JMP CCUB CTLUND, ENTRCE JMP I [IREST ERRXX, 0 /ENTRY POINT ALSO SERVES AS A FLAG FOR "TQMK" CLA CDF 0 /JUST IN CASE PUSHJ CTLD /SET RADIX TO DECIMAL (CTLD CLEARS AC) TAD [77 TYPE DCA N TAD (ERLIST-1 DCA XR ERLOOP, ISZ N /BUMP ERROR NUMBER TAD I XR SZA /END OF LIST? TAD ERRXX /NO - CHECK FOR MATCH SZA CLA /FOUND WHAT WE WANTED? JMP ERLOOP /NO - KEEP LOOKING JMS I (ZEROD TPUT /PRINT ERROR NUMBER ON TELETYPE CTRLP, TAD SCANP CIA DCA ERRXX /SET ERRXX TO CHAR POSITION OF ERROR CHAR. / TAD I (QPNTR / DCA UPOC /FOR LATER VERSIONS KCC /ZAP KEYBOARD FLAG JMP I (T0 /CONTINUE AS NORMAL UNLESS USER TYPES "?" CHRE, DCA NFLG /COMMAND E SCAN UPPERC /FORCE UPPER CASE SORT ENBLST ENBTAB-ENBLST JMP SERR /NO SUCH COMMAND /COMMANDS I AND CHRI, NCHK /I COMMAND JMP CIL1 TAD N /INSERT CHAR WHOSE VALUE IS N JMS UPOC POPJ CTLI, DCA QFLG /CANNOT BE QUOTED CLA CMA /FOR TAB INSERT TAD SCANP DCA SCANP /BACK UP SCAN POINTER BY ONE CIL1, QSKP /COUNT LENGTH OF INSERTION DCA DVT1 /ZERO FUDGE USED BY "^R" COMMAND TAD OSCANP TAD QBASE DCA QP /SET UP POINTER TO INSERTION STRING TAD SCANP CIA TAD OSCANP DCA MQ /STORE CHAR COUNT TO INSERT (-1) TAD MQ CMA TAD DVT1 /ADD "^R" FUDGE PUSHJ ADJ /OPEN A HOLE JMP CIL4 CIL3, TAD QP GETQ /GET A CHAR DCA R CDF 10 TAD I P AND [7400 TAD R DCA I P CDF 0 ISZ P /POINTER WINDS UP AT END ISZ QP CIL4, ISZ MQ JMP CIL3 /OF INSERTION JMP I [IREST /COMMAND G /SEARCH STRING MODIFIERS: SCHLST, 16 /^N - ANYTHING BUT 21 /^Q - LITERALLY 23 /^S - ANY SEPARATOR 30 /^X - ANYTHING CHRG, QREF /G COMMAND - GET Q-REGISTER NUMBER DCA NFLG TAD I QPTR /GET COUNT OF CHARS IN REGISTER CMA DCA MQ /SAVE AS TRANSFER COUNT TAD I QPTR PUSHJ ADJ+2 /INCREASE TEXT BUFFER SIZE ( Q-REG LENGTH MAY JMP CIL4 /BE NEGATIVE) AND GO TRANSFER THE CHARS TYI, 0 /TELETYPE INPUT KSF /WAIT FOR THE KEYBOARD FLAG KSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE CTCCHK /CHECK FOR ^C KRB AND [177 SNA JMP TYI+1 /IGNORE NULL CHARS AND LEADER SORT ALTLST ALTTAB-ALTLST /LOOK FOR NON-STANDARD ALTMODES JMP I TYI ALTMOD, TAD CAAM /TURN NON-STANDARD ALTMODES INTO 33[8] JMP I TYI UPOC, 0 /MOVE TEXT BUFFER UP ONE CHAR AND [177 DCA MQ CLA IAC PUSHJ ADJ CDF 10 TAD I P AND [7400 TAD MQ DCA I P CDF 0 ISZ P JMP I UPOC PAGE /FILE OPEN COMMMANDS: EBAK, CLA CMA /"EDIT BACKUP" COMMAND PUSHJ /USE 'ROPEN' TO SET POINTERS ROPEN /WITHOUT KICKING OUT THE USR (AC=-1 ON ENTRY) TAD I (DEVNO /DEVICE # TAD (7757 /DCB-1 DCA R CDF 10 TAD I R /DEVICE CODE CDF SMA CLA /NEGATIVE IF FILE-STRUCTURED JMP I (EBERR /YOU CAN'T DO THAT! TAD NAME+3 /EXTENSION DCA R /SAVE IT TAD DOTBK /.BK EXTENSION DCA NAME+3 CIF 10 TAD I (DEVNO /DEVICE # JMS I [200 /DELETE THE OLD BACKUP 4 NAME 0 DOTBK, 213 /WHO CARES IF IT'S NOT THERE? TAD R /OLD EXTENSION DCA NAME+3 CLA CLL CML IAC /SET EDIT BACKUP FLAG AND DO AN "ENTER" WOPEN, DCA EBFLG CLA IAC /OPEN OUTPUT FILE JMS I (OPEN /ENTER CODE IN AC OUHNDL, 4001 /HANDLER ADDRESS DCA OUTHND /HANDLER ENTRY CLA CLL CMA DCA WEND /CLEAR END-OF-FILE FLAG TAD I (DEVNO DCA ODEV /SAVE DEV # DCA I (OCNT /CLEAR BLOCK COUNT TAD I (FLN /WILL BE SET AFTER THIS) DCA OMAXLN /MAXIMUM FILE LENGTH TAD NAME DCA OUNAM TAD NAME+1 DCA OUNAM+1 TAD NAME+2 DCA OUNAM+2 TAD NAME+3 DCA OUNAM+3 TAD (DECPUT DCA OUTR /ENABLE CHARACTER OUTPUT ROUTINE TAD (ECDISM DCA DECPUT /FAKE RETURN FROM CHAR I/O ROUTINE TAD I (STBLK JMP OSETP /SET UP BLOCK NUMBER AND POINTERS DECPUT, 0 /DEVICE INDEPENDENT I/O TAD [200 /ADD ON PARITY BIT ISZ O3 /3RD CHAR OF 3? JMP O2 /NO JMS I (RT /YES, SPECIAL HANDLING TAD DCOL /TEMP STORAGE JMS I (RT SETO3, MTHREE /RESET SWITCH DCA O3 ISZ OCRCNT /END OF BUFFER? JMP I DECPUT /NO JMS FITS /CHECK FOR OUTPUT OVERFLOW JMP OERR /YUP DCA I (OCNT /NO - UPDATE OUTPUT COUNT JMS I OUTHND /OUTPUT THE BUFFER OUCTRL, 4400 BUFOUT, OUT OBLK, 0 JMP OERR TAD OBLK TAD INRSIZ /BUMP THE OUTPUT RECORD NUMBER BY THE MAXIMUM OSETP, DCA OBLK /SINCE ALL WRITES EXCEPT THE LAST ARE MAXIMAL TAD BUFOUT /BUFFER POINTERS DCA OPTR1 TAD BUFOUT DCA OPTR2 TAD OUTSIZ DCA OCRCNT /DOUBLEWORD COUNT (7377 IF 8K, 6777 IF 12K) JMP SETO3 /SET BYTE COUNTER AND RETURN OERR, CLA TAD ERROR DCA OUTR /INHIBIT FUTURE OUTPUT ERR14, ERR O2, DCA I OPTR1 /NORMAL HANDLING ISZ OPTR1 /BUMP POINTER JMP I DECPUT OPTR1, 0 OMAXLN, 0 /SIZE OF HOLE FOR OUTPUT OUTSIZ, 7377 /6777 O3, 0 FITS, 0 /SUBROUTINE TO CHECK FOR OUTPUT OVERFLOW TAD OPTR1 /** AC MAY CONTAIN FUDGE ON INPUT ** CIA TAD BUFOUT /COMPUTE NUMBER OF WORDS IN BUFFER AND [7400 /ROUND "UP" TO NEXT BUFFERLOAD CIA /MAKE POSITIVE CLL CML RAR DCA OUCTRL /AND SAVE IT AS A BUFFER CONTROL WORD TAD OUCTRL CLL RAL CLL RTL /ISOLATE THE BLOCK COUNT OF THE CONTROL WORD RTL /IN THE LOW ORDER PART OF THE AC RAL TAD I (OCNT /ADD IT TO THE CURRENT OUTPUT COUNT CLL CML TAD OMAXLN SNL SZA /SEE THAT WE DIDN'T OVERFLOW THE ASSIGNED OUTPUT AREA JMP I FITS /OOPS - WE DID - ERROR RETURN CIA TAD OMAXLN /SUBTRACT OFF THE LIMIT CIA /TO ARRIVE AT THE UPDATED BLOCK COUNT ISZ FITS JMP I FITS /AND SKIP RETURN OUNAM, ZBLOCK 4 PAGE /FILE OPEN ROUTINE ROPEN, DCA QPTR /ENTERED WITH AC=-1 IF MONITOR IS TO BE KEPT JMS OPEN /LOOKUP CODE IN AC INHNDL, 7201 /HANDLER ADDRESS DCA INHND /SAVE HANDLER ENTRY CLA CLL CMA DCA ICRCNT /POINTER CLA CLL CMA DCA REND /CLEAR END-OF-FILE FLAG TAD STBLK DCA I (IBLK /FIRST BLOCK TAD FLN DCA INRCNT /SET UP INPUT FILE LENGTH ISZ QPTR /SHOULD WE DISMISS THE MONITOR? JMP I PECDSM /YES - KICK THE USR OUT AND POPJ JMP I [IREST /EXIT /SUBROUTINE TO DO LOOKUPS AND ENTERS OPEN, 0 /CALLED WITH MONITOR CODE - 2 IN AC DCA RSTSW /ENTER OR LOOKUP SZL CLA /IF THIS IS THE OUTPUT SIDE OF AN "EB" COMMAND, JMP DEVLOD /SKIP THE STATEMENT SCAN TAD (5723 /PACKED SIXBIT FOR 'DSK:' DCA DEVC TAD (72 /RESTORE : DCA DEVLST+1 NGO, DCA NAME /CLEAR NAME DCA NAME+1 DCA NAME+2 DCA NAME+3 DCA NBASE CLA CLL CMA DCA PERDSW DCA NAMCNT NAMEC, QUOTST /GET CHAR AND TEST FOR ALTM JMP DEVQOT /ALTM - END OF NAME SORT /NO - CHECK SPECIAL CHARS DEVLST /([,:,., AND SPACE DEVTAB-DEVLST TSTSEP /NO, SEE IF ALPHANUMERIC ERR08, ERR /ILLEGAL CHAR TAD NAMCNT TAD MINUS6 SMA CLA /MORE THAN 6 CHARS? JMP NAMEC /YES, IGNORE TAD NAMCNT /NO, PACK IT CLL RAR TAD NBASE DCA TEMP1 TAD SCHAR UPPERC /"UPPERC" ALWAYS COMPLEMENTS LINK AND [77 SNL JMP .+4 CLL RTL RTL RTL TAD I TEMP1 DCA I TEMP1 ISZ NAMCNT JMP NAMEC PERD, TAD NAME /PERIOD IN STRING SZA CLA ISZ PERDSW /FLIP FLOP JMP ERR08 /DOUBLE PERIODS OR NO FILE NAME DCA DEVLST+1 /DEVICE NO LONGER LEGAL ISZ NBASE /BUMP POINTER TAD [4 /AND RESET COUNT JMP NAMEC-1 COLON, TAD NAME+1 SNA /WE MUST PACK THE NAME INTO ONE WORD OURSELVES JMP .+5 /BECAUSE IF "OPEN" IS CALLED FROM THE OUTPUT TAD NAME /SIDE OF AN "EB" COMMAND, WE SKIP SMA CLA /THE NAME COLLECTOR.(WITH GOOD REASON - CLL CML RAR /THE USR TEMPORARILY DESTROYS THE COMMAND LINE). TAD NAME+1 /SINCE THE PS/8 "ASSIGN" CALL TO THE TAD NAME /USR REPLACES THE SECOND NAME WORD WITH THE DEVICE DCA DEVC /NUMBER, ALL NAME INFO MUST BE CONTAINED IN WORD 1. JMP NGO-1 /DEVICE NAME STORED - RESET FOR FILE NAME DEVLST, 56 /. 72 /: MINUS6, -6 /END OF LIST DEVQOT, CIF 10 JMS I [7700 10 /BRING THE USR INTO CORE DEVLOD, TAD I OPEN /MOVE HANDLER ADDRESS DCA DEVHND ISZ OPEN /AND BUMP POINTER TWO TAD RSTSW DCA CODE /ENTER OR LOOKUP CIF 10 /AND RESET TABLES JMS I [200 13 RSTSW, 0 /DON'T ZAP OPEN FILES ON INPUT DCA DEVNO /ZERO SECOND NAME WORD CIF 10 JMS I [200 1 /ASSIGN HANDLER DEVC, 0 DEVNO, 0 DEVHND, 0 JMP OPNERR /ERROR - KICK USR OUT FIRST DCA STBLK TAD DEVNO /DEVICE # CIF 10 JMS I [200 CODE, 0 /ENTER OR LOOKUP STBLK, 0 /FILLED WITH STARTING BLOCK TEMP1, FLN, 0 /FILLED WITH -LENGTH JMP OPNERR /ERROR TAD DEVHND /HANDLER ADDRESS IN AC JMP I OPEN PERDSW, 7777 /FLIP FLOP FOR EXTENSION NAMCNT, 0 /CHARACTER COUNT NBASE, 0 /POINTER OPNERR, CLL STA RAL TAD CODE /WE SHOULD ONLY KILL THE OUTPUT FILE SNA CLA JMP .+3 /IF THIS IS AN OUTPUT ERROR EBERR, TAD ERROR DCA OUTR PUSHJ PECDSM, ECDISM /SISMISS THE USR ERR16, ERR PAGE /DISPLAY ROUTINE FOR PDP-12 SCOPE WASTE, 0 /MUST BE AT MULTIPLE OF 2000 - USED FOR LINC MODE JUMPS XPOS, 0 /PDP-12 BETA REGISTER 1 BETA2, 0 /PDP-12 BETA REGISTER 2 DSPLAY, 0 /TEXT DISPLAY ROUTINE FOR TECO MTHREE /THIS ROUTINE DEPENDS ON THE FACT THAT THE TAD DSPLAY /HIGH ORDER BITS OF THE X-COORD ARE IGNORED DCA DX /BY THE VR12 HARDWARE TAD I DX /GET THE SKIP DCA DLPTST /PUT IT IN THE LOOP TAD P DCA DX TAD NUMLNS /NUMBER OF LINES FORWARD & BACKWARD TO DISPLAY CIA PUSHJ CHRL+1 /FIND BEGINNING OF DISPLAY AREA STA TAD P DCA DM TAD DX DCA P /SAVE SOME TIME TAD NUMLNS IAC PUSHJ CHRL+1 /FIND END OF DISPLAY AREA TAD P CIA TAD DM DCA R /THIS IS FOR THE ^W COMMAND ONLY TAD DX DCA P /RESTORE ORIGINAL POINTER VALUE DSETUP, TAD DM DCA DX TAD R DCA DR TAD YSTRT DCA YPOS DISCR, TAD (7010 SETXPS, DCA XPOS /SET X POSITION/COLUMN COUNTER JMP DLPTST /DISPLAY LOOP DNOTAB, SZL JMP DISLF /LINE FEED, VERTICAL TAB, OR FORM FEED TAD (11-33 SNA JMP DSPALT /ALTMODE DCTRL, TAD (67 DCA WASTE /SAVE CHAR TAD (76 JMS I (DISCHR /DISPLAY ^ TAD WASTE DSPALT, TAD [4 /DISPLAY ALTMODE AS $ DLOOP, JMS I (DISCHR DLPTST, HLT /EITHER KSF OR TSF OR "ISZ R" SKP JMP I DSPLAY /EXIT IMMEDIATELY IF TEST SKIPS TAD DX CMA TAD P SZA CLA /ARE WE AT THE CURRENT POINTER POSITION? JMP TSTEDS /NO TAD (-5 TAD XPOS DCA XPOS /BACK UP X POSITION A HALF-CHARACTER TAD (-20 TAD YPOS 6141 /ENTER LINC MODE 1760 /DSC I 2000 1760 /DISPLAY A ^ 2076 0002 /PDP MTHREE TAD XPOS DCA XPOS /AND MOVE X POSITION BACK TO WHERE IT WAS TSTEDS, ISZ DR /ARE WE THROUGH? SKP /NO JMP DSETUP /YES - START OVER CDF 10 TAD I DX CDF 0 /GET THE CHARACTER FROM FIELD 1 AND [177 /AND OFF THE HIGH ORDER BITS TAD [-40 SMA /IF NOT A CONTROL CHARACTER JMP DLOOP /DISPLAY IT AND KEEP GOING TAD (40-15 SNA /CR? JMP DISCR /YES - RESET X COORD CLL TAD [4 SZA /TAB? JMP DNOTAB /NO - SEE WHAT TAD XPOS /DISPLAY TAB CMA AND [7 DCA WASTE /GET NUMBER OF COLUMNS TO GO (-1) TAD WASTE CLL RTL RAL TAD WASTE /MULTIPLY BY 9 TAD CAHT /BUMP ONE MORE COLUMN TAD XPOS SZA /OVERFLOW? JMP SETXPS /NO - SET XPOS AND CONTINUE TAD (-11 DCA XPOS /SET XPOS TO LAST COLUMN JMP DLOOP /OUTPUT A BLANK TO PUSH IT OVER DISLF, TAD YPOS TAD [-40 DCA YPOS /BUMP VERTICAL POSITION DOWN 40 RASTERS JMP DLPTST NUMLNS, 3 YSTRT, 360 DM, 0 DN, 0 DR, 0 PAGE DTABLE, 7777;7777; 7500;0000; 7000;0070; 7714;1477 5721;4671; 6661;4333; 5166;0526; 0000;0070 3600;0041; 4100;0036; 2050;0050; 0404;0437 0500;0006; 0404;0404; 0001;0000; 0601;4030 4536;3651; 2101;0177; 4523;2151; 4122;2651 2414;0477; 5172;0651; 1506;4225; 4443;6050 5126;2651; 5122;3651; 2200;0000; 4601;0000 1000;4224; 1212;1212; 2442;0010; 4020;2055 4077;5751; 4477;7744; 5177;2651; 4136;2241 4177;3641; 4577;4145; 4477;4044; 4136;2645 1077;7710; 7741;0041; 4142;4076; 1077;4324 0177;0301; 3077;7730; 3077;7706; 4177;7741 4477;3044; 4276;0376; 4477;3146; 5121;4651 4040;4077; 0177;7701; 0176;7402; 0677;7701 1463;6314; 0770;7007; 4543;6151; 4177;0000 3040;0106; 0000;7741; 2000;2076; 1604;0404 STABLE, ZBLOCK 40 /SEARCH BUFFER DISCHR, 0 /ROUTINE TO DISPLAY A CHARACTER IF WE ARE A PDP-12 SNA JMP DBLANK /HANDLE BLANKS SEPARATELY AND SPEEDILY CLL RAL TAD (DTABLE-1 DCA I (BETA2 /STORE ADDRESS OF TABLE ENTRY FOR CHAR -1 TAD YPOS 6141 /ENTER LINC MODE 1762 /DSC I 2 1762 /DSC I 2 0002 /RE-ENTER PDP-8 MODE CLA BMPCOL, ISZ I (XPOS /BUMP THE X COORDINATE/COLUMN COUNTER JMP I DISCHR /RETURN TAD YPOS /CHARACTERS TAD [-40 DCA YPOS TAD (7054 /MAGIC INDENT FOR MULTIPLE LINES DCA I (XPOS JMP I DISCHR DBLANK, TAD I (XPOS TAD CAHT /BUMP X POSITION BY 9 SNA JMP BMPCOL+2 /WHOOPS - LINE OVERFLOW DCA I (XPOS JMP I DISCHR CTLW, TAD N /^W COMMAND - IF THERE WAS A NUMBER BEFORE NCHK /THE ^W, SET THE NUMBER OF LINES TO DISPLAY SKP /EQUAL TO THAT NUMBER. DCA I (NUMLNS ISZ R /FAKE OUT! DISPLY /IN ANY CASE, GO THROUGH ONE DISPLAY CYCLE POPJ /THEN RETURN SAVTRA, 0 /SAVE TRACE MODE TAD TFLG DCA TFGTMP DCA TFLG JMP I SAVTRA /EXIT WITH TRACE OFF RESTRA, 0 /RESTORE TRACE MODE TAD TFGTMP DCA TFLG JMP I RESTRA TFGTMP, 0 CHKQF, 0 /CHECK FOR EXPLICIT QUOTES ISZ QFLG /QUOTE FLAG SET? JMP .+3 /NO SCAN /GET QUOTING CHAR DCA QUOTE /PUT INTO SEARCH TABLE DCA QFLG /ZAP QUOTE FLAG JMP I CHKQF /RETURN NXTBUF, 0 SZA CLA JMP NOWRIT /READ-ONLY IF AC NOT 0 ON ENTRY PUSHJ CPOC /HP ISZ FFFLAG /IF WE DIDN'T SEE A FORM FEED ON INPUT JMP NOWRIT /DON'T OUTPUT ONE TAD CAFF OUTPUT NOWRIT, PUSHJ CHRY /READ NEW BUFFER JMP I NXTBUF CHRU, QREF /COMMAND U ISZ QPTR /POINT TO SECOND WORD NCHK JMP NERR /U MUST BE PRECEDED BY A NUMBER TAD N DCA I QPTR POPJ /E COMMAND MODIFIERS ENBLST, 130 /X: EXIT 103 /C: CLOSE FILE 106 /F: WRITE FILE MARK ESKLST, 122 /R: OPEN INPUT FILE 127 /W: OPEN OUTPUT FILE 102 /B: EDIT BACKUP /RADIX TABLES: ORAD, NOP 1000 100 10 DRAD, NP&177+1200 /"TAD NP" 1750 144 12 ENBTAB, EXIT /X-DISPATCH TABLE FOR E COMMANDS EXITC /C ENDFIL /F ROPEN /R WOPEN /W EBAK /B DEVTAB, PERD /DISPATCH TABLE FOR NAME PROCESSOR COLON PAGE /ENDFILE PROCESSOR ENDFIL, CMA DCA OCRCNT /FORCE WRITE WHEN CURRENT DOUBLEWORD IS FULL. TAD (32 /^Z END-OF-FILE OUTPUT OUTPUT /PUT OUT TWO ZERO CHARACTERS TO MAKE SURE OUTPUT /THAT WE FILL UP A DOUBLEWORD. DCA WEND /SET "NO OUTPUT FILE" FLAG TAD ODEV /MAKE SURE THE USR KNOWS THE HANDLER TAD (7646 /KLUDGE - POINTER INTO PS/8 DEVICE RESIDENCY TABLE DCA TY CDF CIF 10 TAD OUTHND DCA I TY /MARK THE HANDLER AS IN CORE CDF 0 JMS I [7700 10 /LOCK USR INTO CORE TAD EBFLG /IS THIS AN EDIT BACKUP? SNA CLA JMP NORMAL /NO, JUST CLOSE FILE TAD OCNT-1 /YES, LOOKUP OLD FILE TO CHANGE NAME DCA TY-1 CIF 10 TAD ODEV /INPUT AND OUTPUT ARE ON SAME DEVICE JMS I [200 2 OUNAM TY, 0 /USELESS LENGTH--USE IT FOR TEMPORARY JMP NORMAL /ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY CDF 10 /ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE CLA CLL CMA /SO WE COULD FIDDLE WITH IT TAD I (17 /FORM POINTER TO DIRECTORY ENTRY TAD I (1404 DCA TY TAD (213 /CHANGE EXTENSION TO .BK DCA I TY TAD I [7 /DIRECTORY BLOCK IT CAME FROM AND [7 DCA ACI CDF JMS I OUTHND 4210 /WRITE IT BACK OUT 1400 ACI, 0 JMP .-4 /ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY NORMAL, TAD ODEV /CLOSE FILE CIF 10 JMS I [200 4 OUNAM OCNT, 0 /NUMBER OF BLOCKS HLT ECRET, TAD ERROR /RESET OUTPUT SUBROUTINE POINTER DCA OUTR /TO ERROR ECDISM, CIF 10 /DISMISS PS/8 USR ROUTINE JMS I [200 11 /KICK USR OUT JMP I [IREST CATS, STA /@ COMMAND - FAKE OUT "IREST" IREST, DCA QFLG /RESET QUOTED STRING FLAG TAD CAAM DCA QUOTE /RESET QUOTE CHAR TO ALTMODE POPJ /RETURN SCHSRT, 0 /SORT LETTERS AND NUMBERS UPPERC /CONVERT TO UPPER CASE TO REDUCE CASES CLL /THE LINK WILL ALTERNATE EACH TIME TAD [-60 /WE ADD ONE OF OUR NEGATIVE CONSTANTS. SMA /THE LINK AT THE END WILL TELL WHETHER TAD [-12 /THE CHARACTER WAS ALPHANUMERIC SMA /(I.E. BETWEEN 60-71,101-132 OR 140-172) TAD (-7 /OR A SEPARATOR CHARACTER. SMA TAD (-32 SZL CLA /WAS IT ALPHANUMERIC? ISZ SCHSRT /YES JMP I SCHSRT /SKIP RETURN IF ALPHANUMERIC RT, 0 /ROUTINE TO PACK THIRD CHAR INTO OUTPUT BUFFER CLL RTL RTL DCA DCOL /CALLED TWICE - FIRST TIME WITH CHAR IN AC, TAD DCOL /SECOND TIME WITH "DCOL" IN AC AND [7400 TAD I OPTR2 DCA I OPTR2 ISZ OPTR2 JMP I RT DVIMQL, 0 /FAKE MQL DVI DCA DVT1 /STORE DIVIDEND DCA MQ /INITIALIZE QUOTIENT DV1, TAD I DVIMQL /GET DIVISOR CIA CLL /ANYTHING DIVIDED BY 0 EQUALS 0 TAD DVT1 /SUBTRACT FROM DIVIDEND SNL /OVERFLOWED YET? JMP DVIOVR /YES DCA DVT1 /NO - STORE IT BACK ISZ MQ /BUMP QUOTIENT JMP DV1 /AND LOOP DVIOVR, CLA TAD MQ ISZ DVIMQL /SKIP PAST DIVISOR JMP I DVIMQL /RETURN WITH QUOTIENT IN AC ERLIST, -ERR01-1 /LIST OF POINTERS TO ALL POSSIBLE -ERR02-1 /CALLS TO THE ERROR ROUTINE. -ERR03-1 -ERR04-1 -ERR05-1 -ERR06-1 -ERR07-1 -ERR08-1 -ERR09-1 -ERR10-1 -ERR11-1 -ERR12-1 -ERR13-1 -ERR14-1 -ERR15-1 -ERR16-1 -ERR17-1 0 /ERROR 18 - UNLABELED ERROR - NAMELY "JMS I OUTR" PAGE /COMMAND DISPATCH TABLE - OVERLAPS ONTO PAGE 13 CDSP, POPK;CTLA;SERR;CTLC;CTLD;CTLE;CTLF;CTLC /0-7 CTLH;CTLI;POPK;POPK;POPK;POPK;SERR;CTLO /10-17 SERR;SERR;CTLR;SERR;CTLT;CTLU;CTLV;SERR /20-27 SERR;SERR;CTLZ;ZRON;SERR;SERR;CTUA;SERR /30-37 POPK;CEXP;CDBQ;CNBS;SERR;CPCS;CAMP;ZRON /40-47 COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR /50-57 NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR /60-67 NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM /70-77 CATS;CHRA;CHRB;CHRC;CHRD;CHRE;SERR;CHRG /100-107 CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO /110-117 CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;SERR;POPK /120-127 CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA /130-137 /END OF DISPATCH TABLE PDLBEG, ZBLOCK 37 /BEGINNING OF PUSHDOWN LIST PDLEND, 0 /END OF PUSHDOWN LIST PAGE / INITIALIZATION SECTION / ENTER HERE AT 5200 TO MODIFY TECO TO USE A MODEL 35 TELETYPE TECO35, ISZ JTECO /IF CALLED VIA "R" OR "RUN" TAD I XR /MOVE ASR-35 PATCH (WHICH OUTPUTS TABS AND DCA I INXR / FORM FEEDS) OVER PRINT ROUTINE ISZ ASRCNT JMP .-3 TAD (OUTHTX DCA I (POUTHT TAD [TECO DCA I (7745 /CHANGE STARTING ADDRESS IN CASE WE'RE RESTARTED /AND FALL INTO INITIALIZATION ROUTINE TCINIT, TLS /INITIALIZATION ROUTINE - INITIALIZE THE TTY TAD .-1 DCA I [TECO DCA I PTECO1 /CHANGE THE ENTRY AT 200 SO WE'RE NOT CALLED AGAIN CLA CLL CML 6141 /ENTER LINC MODE (MAYBE) 4 /ESF - SET SMALL CHARACTERS FOR SCOPE 0261 /ROL I 1 - ROTATE LINK INTO AC11 0002 /BACK TO PDP-8 MODE SNA CLA /AC NON-ZERO IF WE ARE A PDP-12 JMP NOTA12 /NO, JUST AN ORDINARY 8 TAD (DISPLY DCA I (KSFWT /CHANGE THINGS AROUND TO USE THE SCOPE TAD (DISPLY DCA I (TSFWT TAD (CTLW DCA I (CDSP+27 /ENABLE THE ^W COMMAND TAD I7200 DCA I (INHNDL /GO TO ONE PAGE HANDLERS TO MAKE ROOM TAD [7400 /FOR THE DISPLAY ROUTINES DCA I (OUHNDL NOTA12, CLA CLL CML RTR /ANOTHER 2000 ICDF20, CDF 20 DCA I (QFLG I7200, CLA TAD I (QFLG NOP /PDP-8 EXTENDED MEMORY BUG CDF 0 TAD QFLG TAD (6000 SZA CLA /DO WE HAVE 12K? JMP JTECO /NO TAD (Q12MAX-1 DCA QZ /SET UP THE Q-REGISTER LIMITS DIFFERENTLY TAD QZ DCA I (QPNTR TAD (12-Q12MAX DCA I (QLIMIT TAD (-Q12MAX DCA I (MQMAX TAD [QPUTS-1 JMS MOV /SUBSTITUTE THE 12K QPUT TAD (GETQX-1 JMS MOV /AND THE 12K GETQ TAD [4 DCA INRSIZ /CHANGE THE INPUT AND OUTPUT ROUTINES TAD (1021 /TO USE THE EXTRA CORE FOR BUFFERS DCA I (INCTLW TAD (5000 DCA I (INPCNT TAD ICDF20 DCA I (I2 TAD (6777 DCA I (OUTSIZ TAD (5600 DCA I (BUFIN JTECO, JMP I .+1 /INCREMENTED IF WE WERE'NT CHAINED TO CHTECO PTECO1, TECO+1 MOV, 0 DCA XR TAD (-7 DCA INXR TAD I SXR DCA I XR /MOVE CORE ISZ INXR JMP .-3 JMP I MOV ASRCNT, -10 QPUT12, ZBLOCK 16 /ROUTINES INSERTED LATER ASR35, ZBLOCK 10 /" PAGE /THIS SIMPLY FORCES OUT THE LITERALS /ROUTINES TO BE (POSSIBLY) SWAPPED INTO TECO *QPUT12 NOPUNCH *QPUTS ENPUNCH QPUTS, 0 AND [377 CDF 20 DCA I QP CDF 0 ISZ QP JMP I QPUTS NOPUNCH *GETQX ENPUNCH GETQX, 0 DCA CHKCTC CDF 20 TAD I CHKCTC CDF 0 AND [377 JMP I GETQX NOPUNCH *ASR33 ENPUNCH JMP OUTCMX /FORM FEED OR VERT. TAB - USE 8 OR 4 FILLERS OUTHTX, TAD COLCT /GET COLUMN COUNTER RTR RAR CLA CMA RAL /OUTPUT TWO FILLERS IF MORE THAN 4 CHARS TO TAB DCA COLCT /OTHERWISE ONE (COLCT IS A MODULO 8 COUNTER) OUTCMX, TAD SCHAR /GET CONTROL CHAR TO TYPE JMS TPUT /AND TYPE IT - WE WILL NOW FILL WITH NULLS $