File: TECOVQ.MA of Tape: OS8/OS8-Latest/new-15
(Source file text)
/3 Q-OVERLAY TO TECO / 08-APR-79 ADDED ELSE SUPPORT / 10-APR-79 FIXED BUG HAVING TO DO WITH Y<...> / SINCE < WASN'T TESTING NFLG PROPERLY .ENABLE 7BIT .MACRO .ERROR ERNUM .GLOBAL ERR'ERNUM ERR'ERNUM: ERR .ENDM .MACRO .SORT ARG1,ARG2 SORT; ARG1; ARG2-ARG1 .ENDM MTWO=CLL STA RAL .EXTERNAL IOVRLC,EOVRLC,XOVRLC,FOVRLC .EXTERNAL SORT,PUSHJ,TESTD,ERR,SORTA1 .ZTERNAL SCANP,NFLG,ITRST,QUOTE,QBASE,QP,MQ,CAAM,ZIREST .EXTERNAL QSKP,SKPSET,GETQ,QUOTST,ENTRCE,NOTRCE,SCANUP,SCAN .ZTERNAL SCHAR,Z77,NLINK,ITRCNT,N,LASTC .EXTERNAL TESTA,TSTSEP,NCHK,GETNUM,POPJ,RESORT,NCHK,ZRON .EXTERNAL PUSHL,ZROSPN,POPL,IREST .GLOBAL QOVRLY,CHR.O,CDBQ,CSEM,CHGT,CHLT,SETSKP,VBARE .ASECT TECOVQ *5600 RELOC 3200 IOVRLC QOVRLY, 0 EOVRLC XOVRLC FOVRLC .SBTTL Cmd O CHR.O, /+ TAD QFLG /+ SZA CLA /+ IAC /ONE MORE IF QUOTED TAD SCANP /O COMMAND DCA COOQ /SAVE CURRENT SCAN POINTER DCA NFLG 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. /+ STA /+ TAD SCANP /+ CIA /+ DCA ENDO TAD ITRST /"O" ONLY SCANS FROM THE BEGINNING OF THE DCA SCANP /CURRENT ITERATION LOOP. /(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN) SKPSET 41$: 41 /SEARCH FOR ! TAD 41$ DCA QUOTE /SET QUOTE CHAR TO ! /+ QCHK TAD COOQ TAD QBASE DCA QP /SET UP PTR TO ACCESS GOTO STRING 1$: TAD QP GETQ /GET CHAR FROM GOTO STRING CIA DCA MQ /SAVE IT QUOTST /GET CHAR FROM LABEL JMP 2$ /LABEL EXHAUSTED TAD MQ SZA CLA /MATCH? JMP CSMQ /NO - REJOIN SEARCH ROUTINE FOR ANOTHER ! ISZ QP JMP 1$ 2$: /+ TAD QP /+ TAD ENDO /+ ABOVE TWO LINES REPLACE NEXT TWO LINES TAD MQ TAD CAAM /IS GOTO STRING EXHAUSTED TOO? SZA CLA JMP CSMQ1 /NO - REJOIN ! SEARCH ROUTINE ENTRCE /RE-ENABLE TRACE JMP I ZIREST COOQ, 0 /+ENDO, 0 /NEG OF END OF GOTO STRING /+ THESE LINES REPRESENT (BUGGY) CODE TO ALLOW @O /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 CSML1, DCA BRACKS /INITIALIZE BRACKET LEVEL CSML, SCANUP /GET A COMMAND CHAR CSML2, .SORT SKPLST,SKPTAB JMP CSML /NOTHING SPECIAL - KEEP GOING CSMD, SCAN /CLEAR OUT MODIFIER JMP CSML CSMU, SCAN /SKIP ^U COMMAND SKP CLA /GET RID OF Q-REG NUMBER CSMFS, QSKP /FS COMMAND - SKIP FIRST STRING CSMQ, QSKP /SKIP OVER A QUOTED STRING CSMQ1, 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. /SORT LIST FOR " COMMAND CNDLSA, "A "D "N "E "C "G "L "T /=L "F /=E / PARALLEL LIST 'CNDLSB' IS ON NEXT PAGE CSME, SCANUP /FOUND E COMMAND .SORT ESKLST,ESKTAB /LOOK FOR ER, EW, EG, AND EB (USE CSMQ TO SKIP) JMP CSML /NO STRING CSMI, ISZ BRACKS /INCREMENT BRACKET LEVEL JMP CSML CSMO, STA TAD BRACKS /DECREMENT BRACKET LEVEL SPA JMS I (POPITR /IF WE EXIT <> POP OFF ITERATION VALUES JMP CSML1 CSMB, TAD LASTC /GET CHARACTER BEFORE IT WAS TRANSLATED TO UPPER CASE TAD (-"| /SEE IF IT WAS A VERTICAL BAR SNA CLA /IF NOT, IT WAS A \ AND JUST SCAN PAST IT TAD SKPLST /IF SO, IT IS PROBABLY THE ELSE CLAUSE TAD (-"' SZA CLA JMP CSML SKPRTN, TAD BRACKS /WE HAVE FOUND THE DESIRED CHARACTER SZA CLA /BUT IF THE BRACKET LEVEL IS NON-ZERO, JMP I (SORTA1 /WE CANNOT ACCEPT IT - KEEP SORTING /WE MUST USE SORTA1 RATHER THAN RESORT IN CASE OF > JMP I SETSKP /EVERYTHING IS OK - RETURN BRACKS, 0 /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 106 /F 111 /I 116 /N 117 /O 123 /S 137 /_ 121 /Q 125 /U 130 /X 107 /G 115 /M 45 /% 134 /\ or | CSMF, SCAN /F COMMAND - BETTER BE FOLLOWED BY S,N, OR _ CLA JMP CSMFS /SCAN OFF TWO STRINGS CSMA, STA /LIST TERMINATOR JMP CSMQ1 /FOUND @ - SET QUOTE FLAG AND CONTINUE CSMC, SCANUP /GET NEXT CHARACTER IN UPPER CASE AND Z77 /MAKE IT A CONTROL CHARACTER JMP CSML2 /SUBSTITUTE IT FOR THE UPARROW /TSTW, 0 /TEST FOR UPPER CASE ALPHABETIC / TAD (-101 / CLL / TAD (-26. / SNL CLA / ISZ TSTW / JMP I TSTW PAGE /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 CSMF /F ESKTAB, CSMQ /I OR ER CSMQ /N OR EW CSMQ /O OR EB CSMQ /S OR EG CSMQ /_ CSMD /Q CSMD /U CSMD /X CSMD /G CSMD /M CSMD /% CSMB /| CNDI, SCAN /HIT ANOTHER " CLA TAD I (BRACKS SNA CLA STA /SO SKIP MATCHING ' TAD SKIP DCA SKIP RESORT /GO BACK TO CSML .SBTTL Cmd ; CSEM, TAD ITRST /COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH SNA CLA .ERROR 09 /IF NOT IN ITERATION TAD NLINK SNA CLA NCHK /SKIP IF NUMBER JMP I (ZRON /NO NUMBER - IGNORE IT, WE DID IT ALREADY /FALL INTO SEMO AND SEARCH FOR > SEMO, SKPSET /PLOD THRU 76 /LOOKING FOR > ENTRCE /IT'S THE RIGHT ONE, TURN TRACE BACK ON JMP CGSG / SKIP LIST FOR E'S ESKLST, "R /R "W /W "B /B "G /G /ENTRIES MUST BE NEGATIVE: CNDTAB, TESTA /A ALPHABETIC TESTD /D DIGIT / TSTW /W UPPER CASE ALPHABETIC SNA CLA /N NE 0 CNDTB2, SZA CLA /E = EQ 0 TSTSEP /C R SYMBOL CONSTITUENT SZL SNA CLA /G > GT 0 SNL CLA /L < LT 0 SNL CLA /T S TRUE SZA CLA /F U FALSE /THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL .SBTTL Cmd " CDBQ, NCHK /COMMAND " .ERROR 23 /NO NUMBER TO TEST SCANUP .SORT CNDLSA,CNDTAB SPA JMP B$ .SORT CNDLSB,CNDTB2 SMA /CHECK THAT CHAR WAS TRANSLATED .ERROR 20 /NO - NO SUCH TEST B$: DCA SKIP /STORE TEST INSTRUCTION GETNUM /PERFORM THE TEST SKIP, HLT /TEST SKIPS IF TRUE JMP VBARE /AC MAY BE NON-0 CLA /FROM CALL TO TESTA POPJ /CONDITION SATISFIED .SBTTL Cmd | VBARE, STA /NOT SATISFIED DCA SKIP /BEGINNING SKIPPING COMMANDS SKPSET /CALL SKIPPING ROUTINE 47 /FIND A ' ISZ SKIP /FOUND A ' RESORT /NEED ANOTHER: BACK TO CSML ENTRCE /RE-ENABLE TRACE JMP I ZIREST /COMMAND ' NO ACTION TO TAKE .SBTTL Cmd > CHGT, TAD ITRCNT SNA CLA JMP CGTC /0 MEANS INFINITY ISZ ITRCNT /LOOK FOR COUNT EXHAUSTED JMP CGTC /NO, CONTINUE CGSG, JMS POPITR /POP UP OLD ITERATION PARAMETERS JMP I ZIREST CGTC, TAD ITRST SNA .ERROR 10 /IF NOT IN ITERATION JMP I (ZROSPN /BACK TO ROOT POPITR, 0 CLA IAC /** AC NOT NECESSARILY 0 ON ENTRY POPL ITRCNT ITRST JMP I POPITR CNDLSB, / "W /UPPER CASE ALPHABETIC "= /=E "R /=C "> /=G "< /=L "S /=T "U /=F .SBTTL Cmd < CHLT, MTWO /COMMAND < PUSHL ITRST ITRCNT NCHK /WAS A NUMBER SPECIFIED? JMP 1$ /NO, ASSUME INFINITY TAD NLINK /YES SNA CLA TAD N SNA JMP SEMO /0 OR NEGATIVE MEANS SKIP ITERATION CIA /MAKE NEGATIVE 1$: DCA ITRCNT /SET UP TERMINATION TAD SCANP /SAVE CURRENT SCAN PNTR DCA ITRST /ALWAYS .GE. 1 IN ITERATION DCA NFLG /CLEAR NUMBER FLAG POPJ PAGE RELOC