TITLE S$$PAT PATTERN ROUTINES SUBTTL S$$ARB 'ARB' PATTERN PRIMITIVE ROUTINE ENTRY S$$ARB EXTERN S$$KWD RADIX 10 SEARCH S$$NDF COMMENT/ CALL: PUSHJ PS,S$$ARB ; SAVES RETURN LINK ON PS/ S$$ARB: PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSHJ PS,@-2(PS) ; SAVE ARBRST AND RETURN ; ARB RESTARTED ARBRST: SKIPN S$$KWD+10 ; IS &FULLSCAN ON? JUMPL RC,ARBFAL ; NO, QUICKSCAN, FAIL IF CHARFAIL ON SOSGE RC,(PS) ; RESTORE AND DECREMENT RC JRST ARBFAL ; FAIL IF < 0 IBP -1(PS) ; INCREMENT CR MOVE CR,-1(PS) ; AND RESTORE AOBJN PS,@-2(PS) ; SIMULATE PUSH OF ARBRST AND CONTINUE ; ARB FAILED ARBFAL: SUB PS,[XWD 3,3] ; POP PS 3 LEVELS POPJ PS, ; GO TO NEXT PREVIOUS RESTART PRGEND SUBTTL S$$BAL 'BAL' PATTERN PRIMITIVE ROUTINE ENTRY S$$BAL RADIX 10 SEARCH S$$NDF COMMENT/ CALL: PUSHJ PS,S$$BAL ; SAVES RETURN LINK ON PS/ S$$BAL: ADD PS,[XWD 2,2] ; SIMULATE 2-LEVEL PUSH JUMPGE PS,FIXPS ; BUT PUSH INSTEAD IF TOO DEEP SETZ R1, ; INITIALIZE PAREN LEVEL BALOOP: SOJL RC,BALFAL ; DECREMENT RC, FAIL IF 0 MOVEM CR,-1(PS) ; SUCCEED, SAVE CR MOVEM RC,(PS) ; AND SAVE RC PUSHJ PS,@-2(PS) ; SAVE BALRST AND RETURN ; BAL RESTARTED BALRST: MOVE CR,-1(PS) ; RESTORE CR MOVE RC,(PS) ; RESTORE RC JRST BALOOP-1 ; START LOOP AGAIN ; RIGHT PAREN ENCOUNTERED RPAR: SOJGE R1,BALCOM ; DECREMENT PAREN LEVEL, AND CONTINUE ; BAL FAILED BALFAL: SUB PS,[XWD 3,3] ; OR FAIL (UNMATCHED ")"), POP PS 3 LEVELS POPJ PS, ; GO TO NEXT PREVIOUS RESTART ; PUSH PS 2 LEVELS FIXPS: SUB PS,[XWD 2,2] ; RESET PS PUSH PS,CR ; AND PUSH NORMALLY PUSH PS,RC JRST BALOOP-1 ; GO START LOOP PRGEND SUBTTL S$$SUC 'SUCCEED' PATTERN PRIMITIVE ROUTINE ENTRY S$$SUC RADIX 10 SEARCH S$$NDF COMMENT/ CALL: PUSHJ PS,S$$SUC ; SAVES RETURN LINK ON PS/ S$$SUC: PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSHJ PS,@-2(PS) ; SAVE SUCRST AND RETURN ; SUCCEED RESTARTED SUCRST: MOVE CR,-1(PS) ; RESTORE CURSOR MOVE RC,(PS) ; RESTORE REM CHARS AOBJN PS,@-2(PS) ; SAVE SUCRST AND RETURN PRGEND SUBTTL S$$REM 'REM' PATTERN PRIMITIVE ROUTINE ENTRY S$$REM EXTERN S$$LEN RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$REM ; SIMULATES LEN(RC)/ S$$REM: MOVEI R1,(RC) ; LEN() OF REMAINING CHARS JRST S$$LEN PRGEND SUBTTL S$$MIP,S$$MID,S$$MIE POSITIVE INTEGER ASSURANCE ROUTINES ENTRY S$$MIP,S$$MID,S$$MIE EXTERN S$$PGL,S$$MKI RADIX 10 SEARCH S$$NDF COMMENT/ MAKE POSITIVE INTEGER DESCRIPTOR FROM INTEGER CALL: JSP R9,S$$MIP ; WITH INTEGER IN R1, RETURNS DESCR IN R1 MAKE POSITIVE INTEGER DESCRIPTOR FROM DESCRIPTOR CALL: JSP R9,S$$MID ; WITH DESCRIPTOR IN R1, RETURNS INTEGER DESCR IN R1 NEGATIVE INTEGER ERROR CALL: JRST S$$MIE/ S$$MID: SETZ R2, ; GET TYPE ROTC R1,2 CAIE R2,2 ; IS IT INTEGER? JRST MAKINT ; NO, MAKE INTEGER ROTC R1,-2 ; RESTORE DESCR TLNN R1,1B20 ; IS INTEGER <0 ? JRST (R9) ; NO, RETURN S$$MIE: MOVEM R9,S$$PGL ; YES, ERROR CFERR 14,S$$PGL ; NEGATIVE INTEGER IN WRONG CONTEXT MAKINT: ROTC R1,-2 ; RESTORE DESCR JSP R7,S$$MKI ; MAKE INTEGER JRST TYPERR ; TYPE ERROR S$$MIP: JUMPL R1,S$$MIE ; ERROR IF <0 TLO R1,1B18 ; FORM DESCR JRST (R9) ; AND RETURN TYPERR: MOVEM R9,S$$PGL ; SAVE LINK CFERR 1,S$$PGL ; ERROR EXIT PRGEND SUBTTL S$$LEN,S$$TAB,S$$RTB 'LEN','TAB','RTAB' PATTERN PRIMITIVES ENTRY S$$LEN,S$$TAB,S$$RTB EXTERN S$$SJC RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$LEN[S$$TAB,S$$RTB] ; WITH INTEGER ARG IN R1/ S$$TAB: HRRZ R2,@S$$SJC ; GET TOTAL CHARS SUBI R2,(R1) ; SUBTRACT TAB CHARS MOVE R1,R2 ; PUT NEW REM CHARS IN R1 S$$RTB: CAILE R1,(RC) ; IS NEW RC > OLD RC? POPJ PS, ; YES, ATTEMPT TO BACKUP CURSOR, FAIL EXCH R1,RC ; SET NEW RC SUBI R1,(RC) ; COMPUTE # CHARS TO BE ADVANCED JUMPGE RC,MOVECR ; GO ADVANCE CURSOR IF RC IS NOT < 0 NEGRCF: POPJ PS, ; OR FAIL, OFF END OF SUBJECT S$$LEN: SUBI RC,(R1) ; COMPUTE NEW REM CHARS JUMPL RC,NEGRCF ; FAIL IF < 0 MOVECR: JUMPE R1,(R9) ; SUCCEED IMMEDIATELY IF MOVEMENT = 0 MUL R1,POINT2 ; COMPUTE # OF WHOLE WORDS ROT R2,4 ; AND REMAINING CHAR INDEX XCT CHNGCR-1(R2) ; PERFORM INCREMENTATION OF CR JRST (R9) ; AND RETURN CHNGCR: JRST ONECHR ; REM=1, 1 CHR POINT2: ^O63146300000 ; REM=2, IMPOSSIBLE, USE SPACE JRST TWOCHR ; REM=3, 2 CHR JRST THRCHR ; REM=4, 3 CHR JFCL ; REM=5, IMPOSSIBLE JRST FOUCHR ; REM=6, 4 CHR ADDI CR,1(R1) ; REM=7, 5 CHR FOUCHR: IBP CR ; 4 THRCHR: IBP CR ; 3 TWOCHR: IBP CR ; 2 ONECHR: IBP CR ; 1 ADDI CR,(R1) ; ADD WHOLE WORDS JRST (R9) ; AND RETURN PRGEND SUBTTL S$$MBT MAKE BREAK TABLE ROUTINE ENTRY S$$MBT EXTERN S$$PGL,S$$LKS,S$$BKT,S$$GNS RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$MBT ; WITH DESCRIPTOR IN R1, OLDPTR IS POIN- OLDPTR ; TER TO PREVIOUS BREAK TABLE SYMBOL TABLE ENTRY (KEY WORD). RETURN BREAK TABLE DESCRIPTOR (FAKE STRING DESCR) IN R1/ S$$MBT: MOVE R2,(R9) ; GET OLDPTR CAME R1,(R2) ; COMPARE STRING WITH OLD STRING JRST LKPMBT ; NOT =, LOOKUP MOVE R1,1(R2) ; GET OLD BREAK TABLE DESCR JRST 1(R9) ; RETURN LKPMBT: MOVEM R9,S$$PGL ; SAVE PROGRAM LINK HRLZI R0,9B22 ; T=9 FOR BREAK TABLE LOOKUP JSP R8,S$$LKS ; DO LOOKUP SOJA R2,LKPFND ; SYMBOL FOUND SETZ R0, ; NEW ENTRY, GET CHAR COUNT HRRZ R8,(R1) MOVE R7,R1 ; SAVE STRING DESCR HRRM R2,GETR2 ; AND SYMBOL TABLE ENTRY POINTER MOVEI R0,4 ; GET BLOCK FOR BREAK TABLE JSP R6,S$$GNS HRLI R1,^O700 ; FAKE STRING DESCR MOVEM R1,@GETR2 ; SAVE IN VALUE LOC OF ENTRY MOVEI R0,1 ; BIT MARK MOVEI R1,R3 ; TEMPORARY TABLE POINTER SETZB R3,R4 ; CLEAR TEMP TABLE SETZB R5,R6 JUMPE R8,.+4 ; SKIP IF 0 CHARS MBTLOP: ILDB R2,R7 ; GET NEXT CHAR DPB R0,S$$BKT(R2) ; SET BIT IN TABLE SOJG R8,MBTLOP ; LOOP FOR EACH CHAR GETR2: MOVEI R2,.-. ; RESTORE ENTRY PTR MOVE R1,(R2) ; RESTORE BREAK TABLE POINTER HRRM R3,(R1) ; SAVE BITS IN REAL TABLE MOVEM R4,1(R1) MOVEM R5,2(R1) MOVEM R6,3(R1) SOJA R2,.+2 ; PTR TO KEY WORD OF ENTRY LKPFND: MOVE R1,1(R2) ; GET BREAK TABLE DESCR MOVEM R2,(R9) ; SAVE NEW OLDPTR IN CALLING SEQUENCE JRST 1(R9) ; AND RETURN PRGEND SUBTTL S$$ANY,S$$NTA 'ANY','NOTANY' PATTERN PRIMITIVES ENTRY S$$ANY,S$$NTA EXTERN S$$BKT RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$ANY[S$$NTA] ; WITH BREAK TABLE POINTER IN R1/ S$$ANY: JSP R8,S$$NTA+1 ; ANY, INDEX=0 S$$NTA: JSP R8,S$$NTA+1 ; NOTANY, INDEX=1 SUBI R8,S$$NTA SOJGE RC,.+2 ; DECREMENT RC POPJ PS, ; OR FAIL IF NO MORE CHARS ILDB R2,CR ; GET CHAR LDB R0,S$$BKT(R2) ; GET BREAK BIT CAIE R0,(R8) ; IS INDEX=BREAK BIT ? JRST (R9) ; NO, SUCCEED POPJ PS, ; YES, FAIL PRGEND SUBTTL S$$SPN,S$$NSP 'SPAN','NSPAN' PATTERN PRIMITIVES ENTRY S$$SPN,S$$NSP EXTERN S$$BKT RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$SPN[S$$NSP] ; WITH BREAK TABLE POINTER IN R1/ S$$SPN: SOJGE RC,.+2 ; DECREMENT RC POPJ PS, ; FAIL IF NO MORE CHARS (MUST MATCH AT LEAST 1) ILDB R2,CR ; GET CHAR LDB R0,S$$BKT(R2) ; GET BREAK BIT JUMPN R0,S$$NSP ; CONTINUE IF ON POPJ PS, ; OR FAIL S$$NSP: SOJGE RC,.+2 ; DECREMENT RC AOJA RC,(R9) ; SUCCEED IF NO MORE CHARS MOVE R8,CR ; SAVE CURSOR IN CASE OF BACKUP ILDB R2,CR ; GET CHAR LDB R0,S$$BKT(R2) ; GET BREAK BIT JUMPN R0,S$$NSP ; LOOP IF ON MOVE CR,R8 ; OR BACKUP 1 CHAR AOJA RC,(R9) ; AND SUCCEED PRGEND SUBTTL S$$BRX 'BREAKX' PATTERN PRIMITIVE ENTRY S$$BRX EXTERN S$$BRK RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$BRX ; WITH BREAK TABLE PTR IN R1/ S$$BRX: HRRM R9,BEGBRX ; SAVE LINK JSP R9,S$$BRK ; DO BREAK BEGBRX: MOVEI R9,.-. ; RESTORE LINK PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSH PS,R1 ; SAVE BREAK TABLE POINTER PUSH PS,R9 ; SAVE LINK PUSHJ PS,(R9) ; SAVE BRXRST AND RETURN ; BREAKX RESTARTED BRXRST: SOS RC,-2(PS) ; GET REM CHARS AND DECREMENT MOVE CR,-3(PS) ; GET CURSOR IBP CR ; AND INCREMENT MOVE R1,-1(PS) ; GET BREAK TABLE POINTER SUB PS,[XWD 4,4] ; RESET PS JSP R9,S$$BRK ; DO BREAK ADD PS,[XWD 5,5] ; SET PS TO RESTART MOVEM CR,-4(PS) ; SAVE NEW CURSOR MOVEM RC,-3(PS) ; SAVE NEW REM CHARS JRST @-1(PS) ; AND RETURN PRGEND SUBTTL S$$BRK 'BREAK' PATTERN PRIMITIVE ENTRY S$$BRK EXTERN S$$BKT RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$BRK ; WITH BREAK TABLE POINTER IN R1/ S$$BRK: SOJGE RC,.+2 ; DECREMENT RC POPJ PS, ; OR FAIL IF NO MORE CHARS (MUST FIND BREAK CHAR) MOVE R8,CR ; SAVE CURSOR IN CASE OF BACKUP ILDB R2,CR ; GET CHAR LDB R0,S$$BKT(R2) ; GET BREAK BIT JUMPE R0,S$$BRK ; LOOP IF NOT ON MOVE CR,R8 ; BACKUP CURSOR AOJA RC,(R9) ; AND SUCCEED PRGEND SUBTTL S$$BRQ 'BREAKQ' PATTERN PRIMITIVE ENTRY S$$BRQ EXTERN S$$BKT RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$BRQ ; WITH BREAK TABLE POINTER IN R1. IF SINGLE (') OR DOUBLE (") QUOTES ARE MEMBERS OF THE CHARACTER CLASS, THEY ARE IGNORED/ S$$BRQ: SOJGE RC,.+2 ; DECREMENT RC POPJ PS, ; OR FAIL IF NO MORE CHARS MOVE R8,CR ; SAVE CURSOR IN CASE OF BACKUP ILDB R2,CR ; GET CHAR CAIE R2,"'" ; IS IT SINGLE OR DOUBLE QUOTE? CAIN R2,^O42 JRST GOBLQT ; YES, GO GOBBLE UP QUOTED SECTION LDB R0,S$$BKT(R2) ; NO, GET BREAK BIT JUMPE R0,S$$BRQ ; LOOP IF NOT ON MOVE CR,R8 ; BACKUP CURSOR AOJA RC,(R9) ; AND RETURN SUCCESSFULLY ; GOBBLE UP QUOTED SUBSTRING GOBLQT: SOJGE RC,.+2 ; DECREMENT RC POPJ PS, ; FAIL IF NO MORE CHARS ILDB R0,CR ; GET CHAR CAIE R0,(R2) ; IS IT CLOSING QUOTE? JRST GOBLQT ; NO, LOOP JRST S$$BRQ ; YES, GO BACK TO REGULAR LOOP PRGEND SUBTTL S$$RBS,S$$RBR 'ARBNO' PATTERN PRIMITIVE ENTRY S$$RBS,S$$RBR EXTERN S$$KWD RADIX 10 SEARCH S$$NDF COMMENT/ ARBNO START CALL: JSP R9,S$$RBS ; WITH LOC FOLLOWING ARBNO IN R1, START OF PATTERN ARG AT (R9) ARBNO RESTART CALL: JSP R9,S$$RBR ; IMMEDIATELY FOLLOWING PATTERN ARG/ S$$RBS: PUSH PS,R9 ; SAVE START OF PATTERN ARG PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSHJ PS,(R1) ; SAVE RBRST1 AND SKIP OVER PATTERN ARG FIRST TIME ; FIRST ARBNO RESTART RBRST1: SUB PS,[XWD 3,3] ; RESET PS JUMPGE RC,.+2 ; CHARFAIL SET? POPJ PS, ; YES, FAIL MOVE CR,2(PS) ; RESTORE CURSOR MOVE RC,3(PS) ; RESTORE REM CHARS PUSH AS,1(PS) ; SAVE START OF PATTERN ARG SKIPN S$$KWD+10 ; IS &FULLSCAN ON? PUSH AS,RC ; NO, QUICKSCAN, SAVE REM CHARS PUSHJ PS,@1(PS) ; SAVE RBRST2 AND START PATTERN ARG ; FIRST FAILURE OF PATTERN ARG RBRST2: SKIPN S$$KWD+10 ; IS &FULLSCAN ON? SUB AS,[XWD 1,1] ; NO, QUICKSCAN, POP AS EXTRA TIME SUB AS,[XWD 1,1] ; POP AS POPJ PS, ; FAIL ; PATTERN ARG SUCCEEDED S$$RBR: SKIPE S$$KWD+10 ; IS &FULLSCAN OFF (QUICKSCAN MODE)? JRST RBRFLS ; NO, SKIP CAMN RC,(AS) ; YES, HAS CURSOR MOVED? POPJ PS, ; NO, RESTART PATTERN ARG PUSH PS,(AS) ; SAVE OLD RC, THIS INSTANCE OF ARG MAY BE RESTARTED SUB AS,[XWD 1,1] ; AND POP AS RBRFLS: SUB AS,[XWD 1,1] ; POP START OF PATTERN ARG OFF AS PUSH PS,1(AS) ; AND SAVE ON PS PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSHJ PS,(R9) ; SAVE RBRST3 AND SUCEEDED ARBNO ; SUBSEQUENT ARBNO RESTARTS RBRST3: SUB PS,[XWD 3,3] ; RESET PS JUMPGE RC,RBRNEW ; JUMP IF CHARFAIL NOT SET PUSH AS,1(PS) ; SAVE START OF PATTERN ARG SKIPE S$$KWD+10 ; IS &FULLSCAN ON? JRST .+3 ; YES, SKIP SUB PS,[XWD 1,1] ; NO, QUICKSCAN, POP OLD RC OFF PS PUSH AS,1(PS) ; AND SAVE ON AS POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART OF PATTERN ARG RBRNEW: MOVE CR,2(PS) ; RESTORE CURSOR MOVE RC,3(PS) ; RESTORE REM CHARS PUSH AS,1(PS) ; SAVE START OF PATTERN ARG SKIPN S$$KWD+10 ; IS &FULLSCAN ON? PUSH AS,RC ; NO, QUICKSCAN, SAVE REM CHARS PUSHJ PS,@1(PS) ; SAVE RBRST4 AND START PATTERN ARG ; SUBSEQUENT FAILURE OF PATTERN ARG RBRST4: SKIPN S$$KWD+10 ; IS &FULLSCAN ON? POP PS,(AS) ; NO, POP OLD RC OFF PS, REPLACE NEWER VAL ON AS POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART OF PATTERN ARG PRGEND SUBTTL S$$UEB,S$$UES UNEVALUATED EXPR WITHOUT FUNCTION CALLS ENTRY S$$UEB,S$$UES EXTERN S$$STB,S$$STS,S$$STP,S$$FLP RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$UEB[S$$UES] ; START AND SUCCEED OF UNEVALUA- TED EXPRESSIONS NOT CONTAINING FUNCTION CALLS. S$$UES EXPECTS THE RESULT VALUE IN R1 AND PRESERVES IT/ S$$UEB: PUSH SS,PS ; SAVE PS ON SS PUSH SS,AS ; SAVE AS ON SS PUSH SS,CR ; SAVE CURSOR ON SS PUSH SS,RC ; SAVE REM CHARS ON SS PUSH SS,S$$FLP ; SAVE FAILPOINT ON SS MOVE ES,S$$STB ; RESTORE ES ADD ES,S$$STS ; FROM ES SAVED HRROI R1,UEBFAL ; MAKE NEW FAILPOINT MOVEM R1,S$$FLP JRST (R9) ; START UNEVALUATED EXPRESSION ; FAILURE OF UNEVALUATED EXPRESSION UEBFAL: MOVE SS,S$$STB-1 ; RESET SS ADD SS,S$$STP-1 ; FROM SS PREVIOUS MOVE PS,1(SS) ; RESTORE PS, AS, AND FAILPOINT MOVE AS,2(SS) MOVE R1,5(SS) MOVEM R1,S$$FLP POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART ; SUCCEEDED UNEVALUATED EXPRESSION S$$UES: POP SS,S$$FLP ; RESTORE FAILPOINT SUB SS,[XWD 4,4] ; POP RC, CR, AS, AND PS OFF SS MOVE PS,1(SS) MOVE AS,2(SS) MOVE CR,3(SS) MOVE RC,4(SS) JRST (R9) ; CONTINUE MATCH PRGEND SUBTTL S$$UFB,S$$UFS UNEVALUATED EXPR WITH FUNCTION CALLS ENTRY S$$UFB,S$$UFS EXTERN S$$STB,S$$STS,S$$STP,S$$SJC,S$$FLP RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$UFB[S$$UFS] ; START AND SUCCEED OF UNEVALUA- TED EXPRESSION CONTAINING FUNCTION CALLS. S$$UFS EXPECTS THE RESULT VALUE IN R1 AND PRESERVES IT/ S$$UFB: SUB PS,S$$STB+1 ; FORM PS-BASE EXCH PS,S$$STP+1 ; EXCHANGE WITH PS PREVIOUS PUSH SS,PS ; SAVE OLD PS PREVIOUS SUB AS,S$$STB+2 ; DITTO WITH AS EXCH AS,S$$STP+2 PUSH SS,AS MOVE R1,S$$STS+3 ; GET CS SAVED EXCH R1,S$$STP+3 ; EXCHANGE WITH CS PREVIOUS PUSH SS,R1 ; SAVE OLD CS PREVIOUS PUSH SS,S$$STP ; SAVE ES PREVIOUS MOVE ES,S$$STS ; UPDATE ES FROM ES SAVED ADD ES,S$$STB PUSH ES,S$$SJC ; SAVE SUBJECT ON ES MOVE R1,ES ; FORM NEW ES PREVIOUS SUB R1,S$$STB MOVEM R1,S$$STP ; AND SAVE PUSH SS,DT ; SAVE DT, CURSOR,REM CHARS, FAILPOINT PUSH SS,CR PUSH SS,RC PUSH SS,S$$FLP MOVN R1,S$$STB-1 ; MAKE NEW SS PREVIOUS ADD R1,SS MOVEM R1,S$$STP-1 ; SAVE HRROI R1,UFBFAL ; MAKE NEW FAILPOINT MOVEM R1,S$$FLP ; SAVE JRST (R9) ; START UNRVALUATED EXPR ; FAILURE OF UNEVALUATED EXPR UFBFAL: MOVE SS,S$$STB-1 ; RESET SS ADD SS,S$$STP-1 ; FROM SS PREVIOUS SETZ R9, ; SET FAIL FLAG ; SUCCEEDED UNEVALUATED EXPR S$$UFS: POP SS,S$$FLP ; RESTORE FAILPOINT SUB SS,[XWD 7,7] ; POP PARAMETERS OFF SS MOVE RC,7(SS) ; RESTORE RC, CR, DT MOVE CR,6(SS) MOVE DT,5(SS) MOVE R2,4(SS) ; RESTORE ES PREVIOUS EXCH R2,S$$STP ; EXCHANGE FOR NEWER ES PREVIOUS ADD R2,S$$STB ; UPDATE TO ES POP R2,S$$SJC ; RESTORE SUBJECT SUB R2,S$$STB ; AND RESTORE ES SAVED MOVEM R2,S$$STS MOVE R2,3(SS) ; RESTORE CS PREVIOUS AND CS SAVED EXCH R2,S$$STP+3 MOVEM R2,S$$STS+3 MOVE AS,2(SS) ; RESTORE AS AND AS PREVIOUS EXCH AS,S$$STP+2 ADD AS,S$$STB+2 MOVE PS,1(SS) ; DITTO WITH PS EXCH PS,S$$STP+1 ADD PS,S$$STB+1 MOVN R2,S$$STB-1 ; MAKE OLD SS PREVIOS ADD R2,SS MOVEM R2,S$$STP-1 ; AND SAVE JUMPN R9,(R9) ; RETURN TO MATCH IF SUCCESSFUL POPJ PS, ; OR FAIL TO NEXT PREVIOUS RESTART PRGEND SUBTTL S$$ASC CURSOR ASSIGNMENT ROUTINE ENTRY S$$ASC EXTERN S$$PGL,S$$DSG,S$$SJC RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$ASC ; WITH VARIABLE NAME DESCR IN R1/ S$$ASC: MOVEM R9,S$$PGL ; SAVE LINK MOVE R8,R1 ; SAVE NAME DESCR HRRZ R1,@S$$SJC ; FORM CURSOR POSITION SUBI R1,(RC) TLO R1,1B18 ; MAKE INTEGER DESCRIPTOR TLNE R8,3B23 ; IS VAR DEDICATED? JRST S$$DSG ; YES MOVEM R1,(R8) ; NO, ASSIGN (POSSIBLE OUTPUT) JRST (R9) ; RETURN PRGEND SUBTTL S$$VAS PATTERN VALUE ASSIGNMENT START ROUTINE ENTRY S$$VAS RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$VAS ; SAVES CURSOR, REM CHARS ON AS/ S$$VAS: PUSH AS,CR ; PUSH CURSOR ONTO AS PUSH AS,RC ; PUSH REM CHARS ONTO AS PUSHJ PS,(R9) ; PUSH VASRST ONTO PS AND RETURN ; SUBPATTERN FAILURE, RESTART ASSIGNMENT INITIALIZATION VASRST: SUB AS,[XWD 2,2] ; POP AS 2 LEVELS POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART PRGEND SUBTTL S$$IVA IMMEDIATE VALUE ASSIGNMENT ROUTINE ENTRY S$$IVA EXTERN S$$PSA RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$IVA ; WITH INITIAL CR AND RC ON AS, VARIA- BLE NAME DESCR IN R1/ S$$IVA: MOVE R8,R1 ; SAVE NAME DESCR SUB AS,[XWD 2,2] ; POP AS 2 LEVELS MOVE R7,1(AS) ; GET OLD CR MOVE R0,2(AS) ; GET OLD RC PUSH PS,R7 ; PUSH OLD CR ONTO PS PUSH PS,R0 ; PUSH OLD RC ONTO PS SUBI R0,(RC) ; COMPUTE STRING LENGTH PUSHJ PS,S$$PSA ; PUSH IVARST ONTO PS AND PERFORM ASSIGNMENT ; IMMEDIATE VALUE ASSIGNMENT RESTART IVARST: SUB PS,[XWD 2,2] ; POP PS 2 LEVELS PUSH AS,1(PS) ; PUSH OLD CR ONTO AS PUSH AS,2(PS) ; PUSH OLD RC ONTO AS POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART PRGEND SUBTTL S$$ACV,S$$CVA CONDITIONAL VALUE ASSIGNMENT ROUTINES ENTRY S$$ACV,S$$CVA EXTERN S$$PGL,S$$STS,S$$STB,S$$PSA RADIX 10 SEARCH S$$NDF COMMENT/ ASSIGN CONDITIONAL VALUES AT END OF MATCH CALL: JRST S$$ACV ; CALLED FROM S$$MTS WITH RETURN LINK IN R9, CS INITIAL IN R12, OPERATES AT REGISTER LEVEL 12 AND ASSIGNS SUBSTRINGS OF THE SUBJECT TO THE GIVEN VARIABLES CONDITIONAL VALUE ASSIGNMENT CALL: JSP R9,S$$CVA ; EXPECTS PREVIOUS CR AND RC ON AS, VARIA- BLE NAME DESCRIPTOR IN R1/ ; ASSIGN CONDITIONAL VALUES S$$ACV: MOVEM R9,S$$PGL ; SAVE PROGRAM LINK MOVN R11,S$$STS+3 ; GET - CS SAVED HRR R11,S$$STB+3 ; GET CS BASE IN RH ADD R12,R11 ; FORM -COND VAL*3,FIRSTCV ENTRY PTR AOBJN R12,.+1 ACVLOP: MOVE R8,2(R12) ; GET NAME DESCR MOVE R7,(R12) ; GET CURSOR PTR TO BEGINNING OF SUBSTR MOVE R0,1(R12) ; GET LENGTH OF SUBSTRING JSP R9,S$$PSA ; DO PATTERN SUBSTRING ASSIGNMENT ADD R12,[XWD 3,3] ; GO ON TO NEXT CS ENTRY JUMPL R12,ACVLOP ; AND LOOP IF ANY ENTRIES REMAIN JRST @S$$PGL ; OR RETURN ; CONDITIONAL VALUE ASSIGNMENT S$$CVA: SUB AS,[XWD 2,2] ; POP AS 2 LEVELS MOVE CS,S$$STS+3 ; UPDATE CS ADD CS,S$$STB+3 ; FROM CS SAVED MOVE R2,1(AS) ; GET OLD CR MOVE R3,2(AS) ; GET OLD RC PUSH PS,R3 ; SAVE OLD RC ON PS PUSH CS,R2 ; SAVE OLD CR ON CS SUBI R3,(RC) ; COMPUTE SUBSTRING LENGTH PUSH CS,R3 ; SAVE ON CS PUSH CS,R1 ; PUSH VARIABLE NAME DESCR ONTO CS SUB CS,S$$STB+3 ; SAVE CS MOVEM CS,S$$STS+3 PUSHJ PS,(R9) ; SAVE CVARST ON PS AND RETURN TO MATCH ; CONDITIONAL VALUE ASSIGNMENT RESTARTED CVARST: SUB PS,[XWD 1,1] ; POP PS 1 LEVEL MOVN CS,[XWD 3,3] ; POP CS 3 LEVELS ADDB CS,S$$STS+3 ; AND SAVE ADD CS,S$$STB+3 ; UPDATE CS PUSH AS,1(CS) ; SAVE OLD CR PUSH AS,1(PS) ; SAVE OLD RC POPJ PS, ; GO TO NEXT PREVIOUS RESTART PRGEND SUBTTL S$$PSA PATTERN SUBSTRING ASSIGNMENT ROUTINE ENTRY S$$PSA EXTERN S$$GRS,S$$DSG,S$$MVS RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$PSA ; WITH NAME DESCR IN R8, INITIAL BYTE PTR IN R7, AND CHAR COUNT IN R0/ S$$PSA: JUMPE R0,NULASG ; SKIP IF 0 CHARS HRRM R0,RESTCT ; SAVE CHAR COUNT MUL R0,[^F0.2B0] ; COMPUTE WORD COUNT ADDI R0,2 JSP R6,S$$GRS ; GET BLOCK FOR NEW STRING HRLI R1,^O700 ; FORM STRING DESCR MOVEM R1,SAVDSC ; SAVE IT RESTCT: MOVEI R3,.-. ; GET CHAR COUNT HRRM R3,(R1) ; SAVE IN STRING BLOCK MOVE R2,R7 ; GET STARTING BYTE POINTER JSP R7,S$$MVS ; MOVE STRING MOVE R1,SAVDSC ; RESTORE DESCR NULCON: TLNE R8,3B23 ; IS VARIABLE DEDICATED? JRST S$$DSG ; YES MOVEM R1,(R8) ; NO, ASSIGN, POSSIBLE OUTPUT JRST (R9) ; RETURN ; NULL VALUE NULASG: SETZ R1, ; NULL DESCR JRST NULCON ; GO ASSIGN ; STORAGE SAVDSC: BLOCK 1 PRGEND SUBTTL S$$APS,S$$APR,S$$APF PATTERN ALTERNATION ROUTINES ENTRY S$$APS,S$$APR,S$$APF RADIX 10 SEARCH S$$NDF COMMENT/ START ALTERNATION CALL: JSP R9,S$$APS ; WHERE STNEXT IS THE START OF THE XWD .-.,STNEXT ; NEXT ALTERNATION RESTART ALTERNATION CALL: JSP R9,S$$APR XWD .-.,STNEXT FINISH ALTERNATION CALL: JSP R9,S$$APF ; NEXT RESTART WILL FAIL/ ; START ALTERNATION S$$APS: PUSH PS,CR ; PUSH CURSOR ONTO PS HRLM RC,(R9) ; SAVE REM CHAR COUNT WITH RESTORT POINT PUSH PS,(R9) ; AND PUSH ONTO PS JRST 1(R9) ; AND CONTINUE ; RESTART ALTERNATION S$$APR: MOVE CR,(PS) ; RESTORE CURSOR HLRZ RC,1(PS) ; RESTORE REM CHARS HRRZ R1,(R9) ; GET NEXT RESTART POINT HRRM R1,1(PS) ; AND SAVE ON PS AOBJN PS,1(R9) ; SIMULATE PUSH OF PS, AND CONTINUE ; FINISH ALTERNATION S$$APF: POP PS,CR ; RESTORE CURSOR AND REM CHARS FOR LAST TIME, HLRZ RC,2(PS) ; NEXT RESTART WILL PASS TO NEXT PRE- JRST (R9) ; VIOUS RESTART POINT, CONTINUE PRGEND SUBTTL S$$RPS,S$$RPL PATTERN REPLACEMENT ROUTINES ENTRY S$$RPS,S$$RPL EXTERN S$$MTS,S$$KWD,S$$SJC,S$$STB,S$$STP,S$$GRS,S$$MVS,S$$MKS EXTERN S$$PGL,S$$TAC RADIX 10 SEARCH S$$NDF COMMENT/ SUCCEEDED REPLACEMENT CALL: JSP R9,S$$RPS ; PUSHES CURSOR, REMAINING CHARS, AND INITIAL POSITION ONTO SS, SUBJECT ONTO ES, THEN GOES TO S$$MTS FORM REPLACEMENT STRING CALL: JSP R12,S$$RPL ; WITH SUBSTITUTE STRING IN R1, PARAMETERS ON SS AND ES, AND RETURNS REPLACEMENT STRING DESCR IN R1/ ; SUCEEDED REPLACEMENT S$$RPS: MOVE ES,S$$STB ; RESTORE ES ADD ES,S$$STP ; FROM ES PREVIOUS MOVE R1,1(ES) ; GET FIRST ELEMENT PUSHED TLNN R1,1B20 ; IS IT NAME OR PATTERN? AOBJN ES,.+1 ; NAME, EXTRA PUSH FOR ASSIGNMENT PUSH ES,S$$SJC ; SAVE SUBJECT ON ES PUSH SS,CR ; SAVE CURSOR ON SS PUSH SS,RC ; SAVE REM CHARS ON SS SKIPN S$$KWD+9 ; IS & ANCHOR NONZERO? JRST UNANCH ; NO, UNANCHORED MODE PUSH SS,[0] ; YES, NO CHARS FROM FRONT JRST S$$MTS+2 ; CONTINUE UNANCH: HRRZ R1,@S$$SJC ; GET TOTAL # OF CHARS MOVE R2,S$$STB+1 ; FORM PS INITIAL ADD R2,S$$STP+1 SUB R1,2(R2) ; GET TOT # - LAST INITIAL RC PUSH SS,R1 ; SAVE AS # OF CHARS FROM FRONT JRST S$$MTS+2 ; CONTINUE ; FORM REPLACEMENT STRING S$$RPL: MOVEM R12,S$$PGL ; SAVE LINK SETO R0, ; MAKE SURE REPLACEMENT IS STRING JSP R7,S$$MKS CFERR 1,S$$PGL ; ERROR IF NOT MOVEM R1,S$$TAC ; SAVE DESCRIPTOR SUB SS,[XWD 3,3] ; POP SS 3 PLACES MOVEI R8,(R3) ; SAVE REPLACEMENT STRING CHAR COUNT ADD R3,3(SS) ; ADD # CHARS FROM FRONT OF SUBJECT ADD R3,2(SS) ; ADD # CHARS FROM REAR OF SUBJECT JUMPE R3,NULRPL ; SKIP OUT IF TOTAL = 0 MOVEI R9,(R3) ; SAVE TOT # OF CHARS MUL R3,[^F0.2B0] ; COMPUTE # WORDS NEEDED MOVEI R0,2(R3) JSP R6,S$$GRS ; GET BLOCK FOR NEW STRING HRLI R1,^O700 ; FORM STRING DESCR MOVE R10,R1 ; SAVE DESCR HRRM R9,(R10) ; SAVE CHAR COUNT IN STRING BLOCK MOVE R3,3(SS) ; GET CHARS FROM FRONT OF SUBJECT POP ES,R2 ; GET SUBJECT BYTE POINTER JUMPE R3,MIDRPL ; SKIP IF NONE JSP R7,S$$MVS ; MOVE FRONT IN MIDRPL: MOVEI R3,(R8) ; GET CHARS FROM REPLACEMENT STRING JUMPE R3,ENDRPL ; SKIP IF NONE SETZ R2, ; GET REPLACEMENT BYTE PTR EXCH R2,S$$TAC JSP R7,S$$MVS ; MOVE REPLACEMENT IN ENDRPL: MOVE R3,2(SS) ; GET CHARS FROM REAR OF SUBJECT JUMPE R3,RPLVAL ; SKIP IF NONE MOVE R2,1(SS) ; GET FINAL CURSOR POSITION JSP R7,S$$MVS ; MOVE REAR IN RPLVAL: MOVE R1,R10 ; GET NEW STRING DESCR JRST (R12) ; RETURN NULRPL: POP ES,R1 ; THROW AWAY SUBJECT DESCR SETZ R1, ; RETURN NULL VALUE JRST (R12) PRGEND SUBTTL S$$MTX,S$$MTS,S$$MTA PATTERN MATCH ROUTINES ENTRY S$$MTX,S$$MTS,S$$MTA EXTERN S$$PGL,S$$GRS,S$$FLR,S$$SJC,S$$DBT,S$$MKS,S$$STB,S$$STS EXTERN S$$STP,S$$KWD,S$$ACV,S$$NUL RADIX 10 SEARCH S$$NDF COMMENT/ EXECUTE MATCH CALL: JSP R12,S$$MTX ; WHERE NPAR, IF POSITIVE, IS NUMBER OF XWD NPAR,POOLPT ; PARMS+1, AND POOLPT IS A POINTER TO THE DATA BLOCK POOL. PARAMETERS, IF ANY, ARE ON ES. IF NPAR < 0, NO BLOCK IS ACQUIRED AND THE DUMMY HEADER AT 1(R12) IS USED BY THE PATTERN DESCR INSTEAD. AFTER TRANSFERRING PARAMETERS (IF ANY) TO THE DATA BLOCK AND STORING THE PATTERN DESCRIPTOR IN DT, THE SUBJECT, CURSOR, AND REM CHARS ARE INITIALIZED FROM THE SUBJECT STORED ON ES (WHICH IS FORCED TO BE STRING), AND THE PATTERN DESCRIPTOR PUSHED ONTO ES. ES IS SAVED, PS, AS, AND CS INTIALIZED, AND THE NPAR,POOLPT WORD PUSHED ONTO AS. IF &ANCHOR IS NONZERO, S$$FLR IS PUSHED ONTO PS AND CONTROL IS TRANSFER- RED TO THE MATCH CODE. IF &ANCHOR IS ZERO, THE CURSOR, RC, AND MATCH FAIL POINTER ARE PUSHED ONTO PS AND CONTROL TRANSFERRED TO THE MATCH CODE SUCCEEDED MATCH CALL: JSP R9,S$$MTS ; RESTORES ES AND PUTS DATA BLOCK, IF ANY, BACK IN POOL, AND PERFORMS CONDITIONAL ASSIGNMENTS, IF ANY. RE- TURNS TO 0(R9) AND OPERATES AT REGISTER LEVEL 12 ABORTED MATCH CALL: JRST S$$MTA ; FROM 'ABORT' OR 'FENCE' PRIMITIVES/ ; SUCCEEDED MATCH S$$MTS: MOVE ES,S$$STP ; RESTORE ES ADD ES,S$$STB ; FROM ES PREVIOUS JSP R4,RETBLK ; RETURN DATA BLOCK TO POOL MOVE R12,S$$STP+3 ; GET CS INITIAL CAME R12,S$$STS+3 ; SAME AS CS SAVED? JRST S$$ACV ; NO, ASSIGN CONDITIONAL VALUES JRST (R9) ; YES, RETURN RETBLK: MOVE R1,(AS) ; GET NPAR,POOLPT WORD PTR OFF AS JUMPL R1,(R4) ; RETURN IF DUMMY DATA BLOCK MOVE R2,(R1) ; GET NPAR,POOLPT WORD MOVE R3,(DT) ; GET FIRST WORD OF DATA BLOCK TLC R3,3B19 ; CHANGE BACK TO NONRETURNABLE HRRI R3,(R2) ; AND POINT TO LATEST POOL BLOCK MOVEM R3,(DT) ; PUT BACK IN DATA BLOCK HRRI R2,(DT) ; NEW NPAR,POOLPT WORD MOVEM R2,(R1) ; BACK IN CALLING SEQUENCE JRST (R4) ; RETURN ; ABORTED MATCH S$$MTA: MOVE ES,S$$STB ; RESTORE ES TO INITIAL POSITION ADD ES,S$$STP MOVE DT,1(ES) ; GET FIRST ELT PUSHED TLNN DT,1B20 ; IS IT NAME OR PATTERN? MOVE DT,2(ES) ; NAME, GET SECOND ELT PUSHED MOVE AS,S$$STB+2 ; RESTORE AS TO INITIAL POSITION ADD AS,S$$STP+2 ; USING AS PREVIOUS AOBJN AS,ABTPAT ; + 1 PUSH, AND GO ABORT ; EXECUTE MATCH S$$MTX: MOVE R11,(R12) ; GET NPAR,POOLPT WORD HRLZI DT,6B21 ; FORM LH OF PATTERN DESCR JUMPGE R11,GTDBLK ; IF NPAR> 0, SKIP OVER HRRI DT,1(R12) ; OR USE DUMMY DATA BLOCK JRST GTSUBJ ; AND PROCEED WITH SUBJECT GTDBLK: HRRZI R1,(R11) ; GET POOLPT JUMPE R1,[MOVEM R12,S$$PGL ; IF ZERO, GET NEW DATA BLK HLRZ R0,R11 JSP R6,S$$GRS MOVE R10,(R1) ; GET FIRST WORD JRST GTDBLR] ; OF DATA BLOCK AND RETURN MOVE R10,(R1) ; GET FIRST WORD OF DATA BLOCK HRRI R11,(R10) ; GET PTR TO NEXT BLOCK IN POOL MOVEM R11,(R12) ; RESTORE NPAR,POOLPT WORD TLC R10,3B19 ; MAKE BLOCK RETURNABLE GTDBLR: HRRI R10,1(R12) ; GET PTR TO PATTERN MATCH CODE MOVEM R10,(R1) ; SAVE BACK IN DATA BLOCK HRRI DT,(R1) ; RH OF PATTERN DESCR POINTS TO DATA BLOCK HLRZ R8,R11 ; GET ACTUAL # OF PARAMS MOVEI R8,-1(R8) JSP R9,S$$DBT ; MOVE PARAMETERS FROM ES TO DATA BLOCK GTSUBJ: MOVE R1,(ES) ; GET SUBJECT DESCRIPTOR OFF ES MOVEM DT,(ES) ; SAVE PATTERN DESCRIPTOR ON ES TLNE R1,^O770000 ; IS IT A STRING? JRST [SETO R0, ; NO, MAKE STRING JSP R7,S$$MKS CFERR 1,R12 ; CAN'T DO, ERROR JRST GTSUBR] ; OK, GO ON BACK GTSUBR: JUMPN R1,.+2 ; SKIP IF NON-NULL MOVE R1,S$$NUL ; OR INSURE NULL POINTER MOVEM R1,S$$SJC ; SAVE IN SUBJECT SUB ES,S$$STB ; SAVE ES MOVEM ES,S$$STS ; IN ES SAVED MOVE PS,S$$STB+1 ; ACTIVATE PS ADD PS,S$$STP+1 ; FROM PS PREVIOUS MOVE AS,S$$STB+2 ; DITTO FOR AS ADD AS,S$$STP+2 MOVE R0,S$$STP+3 ; INITIALIZE CS SAVED MOVEM R0,S$$STS+3 ; FROM CS PREVIOUS HRRI R11,(R12) ; GET POINTER TO POOLPT WORD PUSH AS,R11 ; PUSH NPAR,[POOLPT] ONTO AS MOVE CR,S$$SJC ; INITIALIZE CURSOR HRRZ RC,(CR) ; AND REM CHAR COUNT MOVE R1,(DT) ; GET PATTERN CODE POINTER SKIPN S$$KWD+9 ; IS &ANCHOR NONZERO? JRST UNANCH ; NO, UNANCHORED MODE PUSHJ PS,(R1) ; SAVE ABTPAT ON PS AND GO TO PATTERN CODE ABTPAT: JSP R4,RETBLK ; FAILED MATCH, RETURN DATA BLOCK TO POOL JRST S$$FLR ; AND FAIL UNANCH: PUSH PS,CR ; SAVE CURSOR PUSH PS,RC ; SAVE REM CHARS PUSHJ PS,(R1) ; SAVE MVANCH ON PS AND GO TO PATTERN CODE MVANCH: SKIPN S$$KWD+10 ; IS FULLSCAN NONZERO? JUMPL RC,ABTPAT ; NO, QUICKSCAN, ABORT PAT IF CHARFAIL ON SOSGE RC,(PS) ; INCREMENT INITIAL MATCH POSITION JRST ABTPAT ; AND QUIT IF OUT OF SUBJECT IBP -1(PS) ; INCREMENT CURSOR MOVE CR,-1(PS) ; AND UPDATE MOVE R1,(DT) ; GET POINTER TO PATTERN CODE AOBJN PS,(R1) ; SAVE MVANCH ON PS AND GO TO PATTERN CODE PRGEND SUBTTL S$$MKP,S$$CKP MAKE ELEMENT FOR PATTERN ROUTINES ENTRY S$$MKP,S$$CKP EXTERN S$$PGL,S$$MKS,S$$STB,S$$STS RADIX 10 SEARCH S$$NDF COMMENT/ CALL: JSP R9,S$$MKP[S$$CKP] ; WITH DESCR IN R1, MAKES SURE DESCR IS STRING OR PATTERN, OR MAKES STRING, RETURNING DESCR IN R1. IN ADDITION, S$$CKP SAVES A PATTERN DESCR ON ES, AND SETS UP A RESTART TO POP IT OFF/ S$$CKP: JSP R8,S$$MKP+1 ; FLAG NOT =0 S$$MKP: SETZ R8, ; FLAG = 0 TLNN R1,^O770000 ; IS IT A STRING? JRST (R9) ; YES, RETURN TLC R1,3B20 ; IS IT A PATTERN? TLNE R1,^O17B21 JRST MAKSTR ; NO TLC R1,3B20 ; YES JUMPE R8,(R9) ; RETURN IF S$$MKP EXCH PS,S$$STS ; SAVE PS, GET ES SAVED ADD ES,S$$STB ; UPDATE ES PUSH ES,R1 ; SAVE PATTERN DESCR ON ES SUB ES,S$$STB ; GET NEW ES SAVED EXCH PS,S$$STS ; SAVE, AND RESTORE PS PUSHJ PS,(R9) ; SAVE CKPRST ON PS AND RETURN CKPRST: MOVN R1,[XWD 1,1] ; POP ES SAVED ADDM R1,S$$STS POPJ PS, ; AND FAIL TO NEXT PREVIOUS RESTART MAKSTR: TLC R1,3B20 ; RESTORE DESCR MOVEM R9,S$$PGL SETO R0, ; MAKE STRING JSP R7,S$$MKS CFERR 1,S$$PGL ; CAN'T DO, ERROR JRST (R9) ; RETURN PRGEND SUBTTL S$$GPB,S$$PTS,S$$PTX PATTERN EXECUTION ROUTINES ENTRY S$$GPB,S$$PTS,S$$PTX EXTERN S$$PGL,S$$MST,S$$GRS,S$$DBT RADIX 10 SEARCH S$$NDF COMMENT/ GET PATTERN BLOCK CALL: JSP R12,S$$GPB ; WHERE NARG IS THE NUMBER OF PARMS+1 XWD NARG,SKIPAT ; AND SKIPAT IS THE FIRST LOCATION FOLLOW- ING THE PATTERN MATCH CODE. EXPECTS PARAMETERS ,IF ANY, ON ES, ACQUIRES A DATA BLOCK (IF ANY IS REQUIRED, OR USES DUMMY HEADER AT 1(R12)), TRANS- FERS PARAMETERS INTO DATA BLOCK, POPS ES, AND RETURNS WITH PATTERN DESCR IN R1 TO SKIPAT. THE RESTARTABLE FLAG IS SET IF NARG IS NEGATIVE OR IF A PARAMETER IS A RESTARTEABLE PATTERN SUCCEEDED PATTERN CALL: JRST S$$PTS ; IF PATTERN CANNOT BE RESTARTED, POP PS, POP DT OFF AS, AND POPJ AS BACK TO HIGHER PATTERN. IF PATTERN CAN BE RESTAR- TED, PUSH RETURN LINK, DT, AND PATTERN RESTART ONTO PS, POP DT OFF AS, AND POPJ AS BACK TO HIGHER PATTERN EXECUTE PATTERN CALL: JSP R9,S$$PTX ; WITH STRING OR PATTERN DESCR IN R1. IF STRING, GO TO S$$MST, OTHERWISE PUSHES RETURN LINK, DT ONTO AS, PATTERN FAIL ONTO PS, LOADS DT WITH NEW DESCR, AND GOES TO SUBPATTERN EXECUTION CODE/ ; GET PATTERN BLOCK S$$GPB: MOVE R11,(R12) ; GET PARAMETER WORD HLRE R0,R11 ; GET NPAR MOVEI R10,6B21 ; GET LH OF PATTERN DESCR JUMPGE R0,.+3 ; SKIP OVER IF NPAR>0 TRO R10,1B22 ; OTHERWISE SET RESTARTEABLE FLAG MOVN R0,R0 ; AND MAKE NPAR > 0 CAIE R0,1 ; IS NPAR = 1? AOJA R12,GETDBL ; NO, GET DATA BLOCK MOVEI R1,1(R12) ; YES, FORM POINTER TO DUMMY HEADER GPBRET: HRLI R1,(R10) ; FORM PATTERN DESCR JRST (R11) ; RETURN GETDBL: MOVEM R12,S$$PGL ; SAVE PROGRAM LINK JSP R6,S$$GRS ; GET BLOCK FOR DATA BLOCK HRRM R12,(R1) ; SAVE POINTER TO PATTERN MATCH CODE SOS R8,R0 ; GET ACTUAL # OF PARAMS JSP R9,S$$DBT ; TRANSFER PARMS INTO DATA BLOCK TRNE R10,1B22 ; IS RESTARTEABLE FLAG SET? JRST GPBRET ; YES, GO OUT HRLZI R7,^O15B22 ; NO , SEARCH DATA BLOCK FOR RESTART- MOVNI R8,(R8) ; EABLE PATTERN HRLZI R8,(R8) ADDI R8,1(R1) CAMG R7,(R8) ; IS DESCR A RESTARTEABLE PATTERN? TROA R10,1B22 ; YES, SET FLAG AND SKIP AOBJN R8,.-2 ; NO, LOOP JRST GPBRET ; OR GO OUT ; SUCCEEDED PATTERN S$$PTS: TLNN DT,1B22 ; CAN PATTERN BE RESTARTED? JRST PTCONT-1 ; NO, THROW AWAY BACKUP PUSH PS,-1(AS) ; YES, PUSH RETURN LINK ONTO PS PUSH PS,DT ; PUSH INNER DT ONTO PS PUSHJ PS,PTCONT ; PUSH PATRST ONTO PS , GO CONTINUE PATRST: PUSH AS,-1(PS) ; ON RESTART, PUSH RETURN LINK ONTO AS PUSH AS,DT ; AND PUSH OUTER DT ONTO AS SUB PS,[XWD 2,2] ; POP PS 2 PLACES MOVE DT,2(PS) ; RESTORE INNER DT AND IGNORE RETURN LINK POPJ PS, ; GO TO NEXT PREVIOUS RESTART SUB PS,[XWD 1,1] ; THROW AWAY PATFAIL PTCONT: POP AS,DT ; RESTORE OUTER DT FROM AS POPJ AS, ; GO SUCEED IN OUTER PATTERN ; EXECUTE PATTERN S$$PTX: TLNN R1,^O770000 ; IS IT STRING? JRST S$$MST ; YES, GO MATCH PUSH AS,R9 ; NO, PUSH RETURN LINK ONTO AS PUSH AS,DT ; PUSH OUTER DT ONTO AS MOVE DT,R1 ; SET UP DT FOR INNER PATTERN MOVE R1,(R1) ; GET PTR TO INNER PATTERN CODE PUSHJ PS,(R1) ; PUSH PATFAL ONTO PS AND GO TO INNER PATTERN PATFAL: SUB AS,[XWD 2,2] ; POP AS 2 PLACES MOVE DT,2(AS) ; RESTORE OUTER DT AND IGNORE RET LINK POPJ PS, ; FAIL TO NEXT PREVIOUS RESTART POINT PRGEND SUBTTL S$$DBT DATA BLOCK TRANSFER ROUTINE ENTRY S$$DBT RADIX 10 SEARCH S$$NDF P$BRKE=7 ; BREAK EVEN POINT BETWEEN BLT AND POPS COMMENT/ CALL: JSP R9,S$$DBT ; WITH DESCRIPTOR(S) ON ES, DATA BLOCK POINTER IN R1, NUMBER OF ELEMENTS IN R8. MOVES DESCRS OFF ES INTO BLOCK, LEAVING ES POINTING TO BEFORE FIRST DESCR. LEAVES R1, RH(R8) UNCHANGED/ S$$DBT: MOVNI R7,(R8) ; GET - # OF PARS CAIG R8,P$BRKE ; > BREAK EVEN POINT? JRST BOTPOP(R7) ; NO, DO SERIES OF POPS ADDI R7,1(ES) ; YES, DO BLT, POINT TO FIRST PAR ON ES HRLZI R7,(R7) ADDI R7,1(R1) ; POINT TO FIRST PAR LOC IN DATA BLOCK MOVEI R6,(R8) ; POINT TO LAST PAR LOC IN DATA BLOCK ADDI R6,(R1) BLT R7,(R6) ; MOVE PARMS HRLI R8,(R8) ; POP STACK CORRECT # OF PARMS SUB ES,R8 JRST (R9) ; RETURN P$BRKR=0 ; MAKE SERIES OF POPS REPEAT P$BRKE, < POP ES,P$BRKE-P$BRKR(R1) P$BRKR=P$BRKR+1> BOTPOP: JRST (R9) ; RETURN PRGEND SUBTTL S$$MST MATCH STRING ROUTINE ENTRY S$$MST RADIX 10 SEARCH S$$NDF P$BRKE=7 ; BREAK EVEN POINT FOR GOING TO FAST REG LOOP COMMENT/ CALL: JSP R9,S$$MST ; WITH DESCR IN R1/ S$$MST: SETZ R0, ; GET CHAR COUNT HRRZ R0,(R1) SUB RC,R0 ; SUBTRACT FROM REM CHARS JUMPL RC,MSFAIL ; FAIL IF TOO MANY FOR SUBJECT CAIL R0,P$BRKE ; LESS THAN BREAK EVEN POINT? JRST FSTMST ; NO, LOAD LOOP INTO FAST REGISTERS MSTLP1: SOJL R0,(R9) ; YES, SUCCEED IF STRING EXHAUSTED ILDB R2,R1 ; GET CHAR FROM STRING ILDB R3,CR ; GET CHAR FROM SUBJECT CAIN R2,(R3) ; DO THEY MATCH? JRST MSTLP1 ; YES, LOOP MSFAIL: POPJ PS, ; NO, FAIL TO NEXT PREVIOUS RESTART FSTMST: HRRM R9,MSTLP2 ; SAVE RETURN LINK MOVE R9,[XWD MSTLP2,MSTLP3] BLT R9,MSTFIN ; MOVE LOOP INTO R4-R9 JRST MSTLP3 ; AND START IT MSTLP2: PHASE 4 MSTLP3: SOJL R0,.-. ; R4: SUCCEED IF STRING EXHAUSTED ILDB R2,R1 ; R5: GET CHAR FROM STRING ILDB R3,CR ; R6: GET CHAR FROM SUBJECT CAIN R2,(R3) ; R7: DO THEY MATCH? JRST MSTLP3 ; R8: YES, LOOP MSTFIN: POPJ PS, ; R9: NO, FAIL DEPHASE END