COMCBLP 
COMMON
          CTEXT  COMCBLP - BASIC LINE PROCESSOR.
          SPACE  4,10 
          IF     -DEF,QUAL$ 
          QUAL   COMCBLP
          ENDIF 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       COMCBLP - *BASIC* LINE PROCESSOR. 
* 
*         D. A. HIVELEY  71/02/14.
*         S. P. BOOTH    80/07/15.
          SPACE  4
***       COMCBLP REPLACES THE OLD LINE NUMBERS IN A *BASIC*
*         STATEMENT WITH THE EQUIVALENT NEW LINE NUMBERS WHICH ARE
*         CONTAINED IN A LINE NUMBER TABLE (*LNT*). 
          SPACE  4
**        THE *LNT* CONSISTS OF ONE WORD ENTRIES EITHER IN A BUFFER 
*         OR WRITTEN OUT TO A LOCAL DISK FILE.  THE FORMAT OF THE 
*         *LNT* ENTRY IS -
* 
*T        18/  NLN, 18/  OLN, 24/  UNUSED 
* 
*         NLN = NEW LINE NUMBER.
*         OLN = OLD LINE NUMBER.
  
          TITLE  WORKING STORAGE. 
  
*         GENERAL EQUATES.
  
 COL63    EQU    63B         63 CHARACTER SET COLON REPRESENTATION
 COL64    EQU    00B         64 CHARACTER SET COLON REPRESENTATION
 QUOTE    EQU    64B         QUOTE
 POUND    EQU    60B         POUND
 APOS     EQU    70B         APOSTROPHE 
 NUMD     EQU    5           MAXIMUM NUMBER OF DIGITS IN A LINE NUMBER
  
*         MISCELLANEOUS CELLS.
  
 BLWA     CON    0           BUFFER LWA + 1 
 COLON    CON    0           COLON
 TRNC     CON    0           TRUNCATION FLAG
  
**        LNTP - *LNT* PARAMETERS.
*T        1/  LWO, 1/  AS, 4/  0, 18/  FA, 18/  BLWA, 18/  BFWA 
* 
*         LWO  = 1 - *LNT* HAS BEEN WRITTEN OUT TO DISK.
*         AS   = 1 - ASSUME SORTED *LNT*. 
*         FA   = FET ADDRESS, IF *LNT* HAS BEEN WRITTEN TO DISK.
*                0, IF *LNT* IS CORE RESIDENT.
*         BLWA = LWA+1 OF *LNT* BUFFER. 
*         BFWA = FWA OF *LNT* BUFFER. 
  
 LNTP     CON    0
  
          TITLE  COMCBLP MAIN PROCESSOR.
 BLP      SPACE  4,20 
**        BLP - BASIC LINE PROCESSOR. 
* 
*         ENTRY  (X1) = FWA OF *LNT*. 
*                (X2) = LWA+1 OF *LNT*. 
*                (X3) = FET ADDRESS.
*                       .EQ. 0, IF NO FET ADDRESS.
*                (X5) = 0, IF *LNT* NOT SORTED. 
*                     = 1, IF *LNT* SORTED. 
*                (X6) = LWA+1 OF BUFFER.
*                (B2) = LWA+1 OF BASIC STATEMENT IN BUFFER. 
*                (B7) = FWA OF BASIC STATEMENT IN BUFFER. 
* 
*         EXIT   (B7) = LWA+1 OF BASIC LINE.
*                (X1) = TRUNCATION FLAG.
*                       .EQ. 0 IF NO TRUNCATION OCCURRED. 
*                (X2) = LINE CHANGED FLAG.
*                       .EQ. 0 IF NO CHANGE.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL. 
* 
*         CALLS  ADL, ASL, CDD, SCN, SRC. 
  
 BLP      SUBR               ENTRY/EXIT 
          SA6    BLWA        SAVE LWA + 1 OF LINE BUFFER
          SX7    B2          CHECK FOR TRUNCATION 
          IX7    X6-X7
          SX6    B0+
          SA6    TRNC 
          SA6    BLPG 
          PL     X7,BLP0     IF BASIC LINE FITS INTO BUFFER 
          SX7    B1+
          SA7    TRNC 
 BLP0     MX4    -18
          BX1    -X4*X1 
          BX2    -X4*X2 
          LX2    18-0 
          MX0    1
          BX6    X1+X2
          ZR     X3,BLP1     IF NO FET ADDRESS SELECTED 
          BX3    -X4*X3 
          BX6    X6+X0
          LX3    36-0 
          BX6    X6+X3
 BLP1     LX0    58-59
          ZR     X5,BLP1.1   IF *LNT* NOT SORTED
          BX6    X0+X6
 BLP1.1   SA6    LNTP 
          SA1    CSMR        SET COLON ACCORDING TO CHARACTER SET MODE
          SX6    COL64
          NG     X1,BLP2     IF 64 CHARACTER SET
          SX6    COL63
 BLP2     SA6    COLON
 BLP3     LE     B2,B7,BLP50 IF NO STATEMENT TO PROCESS 
          SB2    B2-1 
          SA2    B2+
          SX7    X2-1R
          ZR     X7,BLP3     IF SPACE 
          SB2    B2+1 
          SX7    X6-COL64 
          NZ     X7,BLP5     IF NOT 64 CSET 
          BX6    X2-X6       CHECK LAST CHARACTER 
          NZ     X6,BLP5     IF NOT A TRAILING COLON
          SB2    B2+B1       ACCOUNT FOR COLON
          SX6    1R 
          SA6    B2-1        STORE A TRAILING SPACE 
 BLP5     SX6    B0+
          SA6    BLPA        CLEAR NESTING LEVEL
 BLP5.1   BX7    X7-X7
          SB4    B1+B1       ASSEMBLE FIRST 2 CHARACTERS IN STATEMENT 
          SA7    BLPC        ONLY 1 LINE NUMBER AT END OF STATEMENT 
          RJ     ASL
          BX7    X5 
          SB4    B1 
          SA7    BLPD        SAVE CURRENT STATEMENT 
  
*         PROCESS STATEMENT TYPES.
  
          SX1    X5-2RMA
          ZR     X1,BLP12    IF *MA* FOUND
          SX1    X5-2RPR
          ZR     X1,BLP13    IF *PR* FOUND
          SX1    X5-2RGO
          ZR     X1,BLP19    IF *GO* FOUND
          SX1    X5-2RON
          ZR     X1,BLP20    IF *ON* FOUND
          SX1    X5-2RIF
          ZR     X1,BLP23    IF *IF* FOUND
          SX1    X5-2RNO
          ZR     X1,BLP24    IF *NO* FOUND
          EQ     B2,B7,BLP50 IF END OF LINE 
          SX1    X5-2RRE
          NZ     X1,BLP6     IF *RE* NOT FOUND
          RJ     ASL         ASSEMBLE NEXT CHARACTER
          SX1    X5-1RM 
          NZ     X1,BLP6     IF *REM* NOT FOUND 
 BLP5.2   SB7    B2 
          EQ     BLP50       IGNORE REMAINDER OF LINE 
  
*         SEARCH FOR *ELSE*.
  
 BLP6     SB7    B5+         RESTORE PREVIOUS VALUE TO LINE POINTER 
          SB4    4
          SA4    =4RELSE
          SA1    BLPA 
          ZR     X1,BLP5.2   IF *ELSE* CLAUSE NOT EXPECTED
          SX6    X1-1 
          SA6    A1+
          RJ     SCN         SCAN LINE FOR *ELSE* 
          EQ     B2,B7,BLP50 IF *ELSE* NOT FOUND OR EOL 
          SX7    2RIF        INDICATE LINE NUMBER NOT NEEDED
          SA7    BLPD 
          EQ     BLP29       SEARCH REMAINDER OF LINE 
  
*         *MA* FOUND, 
*         CONTINUE SEARCH FOR *MAT PRINT*.
  
 BLP12    SB4    3           ASSEMBLE NEXT 3 CHARACTERS 
          RJ     ASL
          EQ     B2,B7,BLP50 IF END OF LINE 
          SX5    X5-3RTPR 
          NZ     X5,BLP6     IF *MAT PR* NOT FOUND
  
*         *MAT PR* OR *PR* FOUND, 
*         CONTINUE SEARCH FOR *PRINT USING*.
  
 BLP13    SB4    3           ASSEMBLE NEXT 3 CHARACTERS 
          RJ     ASL
          EQ     B2,B7,BLP50 IF END OF LINE 
          SX5    X5-3RINT 
          NZ     X5,BLP6     IF *PRINT* NOT FOUND 
          SX0    B7+         SAVE CURRENT LINE POSITION 
          SA4    =5RUSING 
          SB4    5
          RJ     SCN         SCAN LINE FOR *USING*
          SB5    X0+         RESTORE PREVIOUS LINE POSITION 
          EQ     B2,B7,BLP6  IF *USING* NOT FOUND OR EOL
          EQ     BLP29       SEARCH FOR OLD STATEMENT NUMBER
  
*         *GO* FOUND, 
*         CONTINUE SEARCH FOR *GOTO* OR *GOSUB*.
  
 BLP19    SB4    2           ASSEMBLE NEXT 2 CHARACTERS 
          RJ     ASL
          SX1    X5-2RTO
          ZR     X1,BLP29    IF *GOTO* FOUND
          SX1    X5-2RSU
          NZ     X1,BLP6     IF *GOSU* NOT FOUND
          SB4    B1          ASSEMBLE NEXT CHARACTER
          RJ     ASL
          SX1    X5-1RB 
          ZR     X1,BLP29    IF *GOSUB* FOUND 
          EQ     BLP6        CONTINUE SCAN
  
*         *ON* FOUND, 
*         CONTINUE SEARCH FOR *ON ERROR*, *ON EXPRESSION*, OR 
*         *ON ATTENTION*. 
  
 BLP20    SB4    5           ASSEMBLE NEXT 5 CHARACTERS 
          SA4    =5RERROR 
          SX0    B7          SAVE CURRENT POSITION
          RJ     SCN         SCAN FOR *ERROR* 
          BX5    X4-X5
          ZR     X5,BLP23.1  IF *ERROR* FOUND 
          SB7    X0          RESTORE PREVIOUS VALUE TO LINE POINTER 
          SA4    =9RATTENTION 
          SB4    9
          RJ     SCN         SCAN FOR *ATTENTION* 
          BX5    X4-X5
          ZR     X5,BLP23.1  IF *ATTENTION* FOUND 
          SX7    B1 
          SB7    X0          RESTORE PREVIOUS VALUE TO LINE POINTER 
          SA7    BLPC        INDICATES MULTIPLE LINE NUMBERS TO PROCESS 
          SB4    5
          SA4    =5RGOSUB 
          RJ     SCN         SCAN REMAINDER OF LINE FOR *GOSUB* 
          BX5    X5-X4
          ZR     X5,BLP29    IF *ON EXPRESSION GOSUB* FOUND 
          SB7    X0          RESTORE PREVIOUS VALUE TO LINE POINTER 
          EQ     BLP23.1     SCAN FOR THEN
  
*         *IF*, *ON ERROR ...*, *ON ATTENTION*, OR *ON EXPRESSION*
*         BUT NOT *ON EXPRESSION GOSUB* FOUND, CONTINUE SEARCH
*         FOR *THEN* OR *GOTO*. 
  
 BLP23    SA1    BLPA        INCREMENT *IF* STATEMENT NESTING LEVEL 
          SX6    X1+B1
          SA6    A1 
 BLP23.1  SB4    4
          SA4    =4RTHEN
          SX0    B7          SAVE CURRENT LINE POINTER
          RJ     SCN         SCAN REMAINDER OF LINE FOR *THEN*
          BX5    X5-X4
          ZR     X5,BLP29    IF *THEN* FOUND
          SB7    X0+         RESTORE PREVIOUS VALUE TO LINE POINTER 
          SB4    4
          SA4    =4RGOTO
          RJ     SCN         SCAN REMAINDER OF LINE FOR *GOTO*
          BX7    X7-X7
          SA7    BLPD        INDICATE LINE NUMBER NEEDED
          EQ     B2,B7,BLP50 IF *GOTO* NOT FOUND OR EOL 
          EQ     BLP29       SEARCH FOR OLD STATEMENT NUMBER
  
*         *NO* FOUND, 
*         CONTINUE SEARCH FOR *NODATA*. 
  
 BLP24    SB4    4           ASSEMBLE NEXT 4 CHARACTERS 
          RJ     ASL
          SA1    =4RDATA
          BX5    X5-X1
          NZ     X5,BLP6     IF *NODATA* NOT FOUND
          EQ     B2,B7,BLP50 IF *NODATA* FOUND BUT AT END OF LINE 
          SB4    B1          ASSEMBLE NEXT CHARACTER
          RJ     ASL
          SX1    X5-POUND 
          NZ     X1,BLP28    IF NUMBER SIGN NOT FOUND 
          SX4    1R,
          SB4    B1 
          RJ     SCN         SCAN LINE FOR *,*
          EQ     B2,B7,BLP50 IF END OF INCOMPLETE *NODATA* STATEMENT
          EQ     BLP29       SEARCH FOR OLD STATEMENT NUMBER
  
*         SEARCH REMAINDER OF LINE FOR OLD STATEMENT NUMBER TO BE 
*         REPLACED WITH ITS CORRESPONDING NEW STATEMENT NUMBER. 
*         IF LOCATION *BLPC* CONTAINS A ZERO, ONLY ONE STATEMENT NUMBER 
*         IS TO BE PROCESSED, OTHERWISE PROCESSING OF STATEMENT NUMBERS 
*         IS CONTINUED UNTIL A LETTER OR SPECIAL CHARACTER OTHER THAN A 
*         COMMA IS ENCOUNTERED OR UNTIL AN ERROR IS DETECTED. 
  
 BLP28    SB7    B5+         RESTORE PREVIOUS VALUE TO LINE POINTER 
 BLP29    SX7    1R 
          SB5    B7+         SAVE CURRENT LINE POINTER
          SB6    NUMD 
          SB4    B0 
          BX6    X6-X6
 BLP30    EQ     B2,B7,BLP32 IF END OF LINE 
          SA1    B7 
          BX2    X1-X7
          SB7    B7+1 
          ZR     X2,BLP30    IF BLANK 
          SX2    X1-1R+ 
          PL     X2,BLP31    IF SPECIAL CHARACTER 
          SX2    X1-1R0 
          NG     X2,BLP31    IF LETTER
          SA7    B7-B1       FILL CURRENT WORD WITH BLANK 
          LX5    X6,B1
          LX6    3
  
*         ACCUMULATE OCTAL INTEGER REPRESENTATION OF OLD LINE NUMBER. 
  
          IX6    X6+X5
          IX6    X6+X2
          SB4    B4+B1
          SB3    B7+
          EQ     BLP30       CHECK NEXT CHARACTER 
  
 BLP31    SB7    B7-1 
 BLP32    NZ     B4,BLP33    IF NUMBER FOUND
          SA1    BLPD 
          SX1    X1-2RIF
          NZ     X1,BLP6     IF NOT *IF* STATEMENT
          SB7    B5+         RESTORE LINE POINTER 
          EQ     BLP5.1      PROCESS *IF* CONDITIONAL 
  
 BLP33    EQ     B3,B7,BLP34 IF NO BLANK AFTER LINE NUMBER
          SB7    B7-1        PRESERVE BLANK 
 BLP34    SB3    B3-B4
          EQ     B3,B5,BLP35 IF NO BLANK BEFORE LINE NUMBER 
          SB5    B5+B1       PRESERVE BLANK 
 BLP35    SX7    B5+B6       SAVE INSERTION POINTER 
          SB4    B6-B4
          NG     B4,BLP6     IF MORE THAN FIVE DIGITS 
          SB4    B3-B4
          GE     B5,B4,BLP36 IF NOT ENOUGH BLANKS BEFORE LINE NUMBER
          SX7    B4+B6
 BLP36    SA7    BLPB 
          SB4    B7-B5
          SB4    B4-B6
          GE     B4,BLP38    IF ROOM TO INSERT NEW LINE NUMBER
          SB2    B2-B4       POINTS TO NEW END OF LINE
          SB4    B2+B4       POINTS TO OLD END OF LINE
          SA1    BLWA 
          SB6    X1+
          SB5    B2+
          LE     B2,B6,BLP37 IF NEW LINE IS NOT TOO LONG
          SX7    B1+         SET TRUNCATION FLAG AND ADJUST POINTERS
          SA7    TRNC 
          SB2    B2-B6
          SB4    B4-B2
          SB2    B6 
          SB5    B2 
  
*         RIGHT SHIFT LINE SO EXTRA DIGITS CAN BE INSERTED. 
  
 BLP37    SB4    B4-B1
          SB5    B5-B1
          LT     B4,B7,BLP38.1  IF MOVE COMPLETE
          SA1    B4 
          BX7    X1 
          SA7    B5+
          EQ     BLP37       MOVE NEXT CHARACTER
  
 BLP38.1  SB7    B5+1 
 BLP38    SX0    X6          SET UP ENTRY CONDITIONS
          RJ     SRC         SEARCH LINE TABLE FOR OLD LINE NUMBER
          GT     B4,BLP39    IF OLD LINE NUMBER FOUND 
          SX1    X0 
          EQ     BLP40       RESTORE PREVIOUS LINE NUMBER 
  
 BLP39    BX2    X1 
          SX6    B1 
          MX1    -18
          AX2    42-0        GET NEW LINE NUMBER
          SA6    BLPG        SET LINE CHANGED FLAG
          BX1    -X1*X2 
 BLP40    SB6    B2          SAVE END OF LINE POINTER 
          RJ     CDD         CONVERT NEW LINE NUMBER
          SB2    B6 
          BX2    X6 
          SA1    BLPB        GET INSERTION POINTER
          SB6    X1+
          RJ     ADL         INSERT LINE NUMBER IN LINE 
          EQ     B2,B7,BLP50 IF END OF LINE 
          SA1    BLPC 
          SB5    B7 
          ZR     X1,BLP6     IF REMAINDER OF STATEMENT IS TO BE IGNORED 
          SB4    B1          ASSEMBLE NEXT CHARACTER
          SX0    B5+         SAVE CURRENT LINE POINTER
          RJ     ASL
          SX5    X5-1R, 
          ZR     X5,BLP29    IF ADDITIONAL LINE NUMBERS TO PROCESS
          EQ     BLP6        SEARCH FOR *ELSE*
  
*         SET UP VALID EXIT CONDITIONS. 
  
 BLP50    SA1    TRNC 
          SA2    BLPG 
          EQ     BLPX        RETURN 
  
 BLPA     CON    0           *IF* STATEMENT NESTING LEVEL 
 BLPB     CON    0           TEMPORARY HOLD AREA FOR LINE POINTER 
 BLPC     CON    0           MULTIPLE LINE NUMBER FLAG
 BLPD     CON    0           LINE NUMBER MANDATORY FLAG 
 BLPG     CON    0           LINE CHANGED FLAG
          TITLE  COMCBLP SUBROUTINES. 
 ADL      SPACE  4,15 
**        ADL - ADD LINE NUMBER 
* 
*         *ADL* PLACES THE NEW LINE NUMBER INTO THE BUFFER, WORKING 
*         FROM THE LEAST SIGNIFICANT DIGIT TO THE MOST SIGNIFICANT. 
*         LEADING ZEROS ARE ADDED FOR LINE NUMBERS LESS THAN *NUMD* 
*         DIGITS LONG.
* 
*         ENTRY  (B6) = STRING BUFFER ADDRESS+1 OF INSERT POINT.
*                (X2) = LINE NUMBER RIGHT JUSTIFIED WITH LEADING
*                       BLANKS. 
*                (B2) = LWA+1 OF BASIC STATEMENT. 
* 
*         EXIT   NUMBER STORED IN STRING BUFFER.
* 
*         USES   X - 0, 2, 5, 6, 7. 
*                A - 6, 7.
*                B - 5, 6.
  
  
  
 ADL      SUBR               ENTRY/EXIT 
          SB5    NUMD 
          SX7    1R0
          SX0    77B
 ADL1     BX6    X0*X2
          SX5    X6-1R
          ZR     X5,ADL3     IF BLANK 
          SB6    B6-1 
          LE     B2,B6,ADL2  IF PAST BUFFER LWA 
          SA6    B6+
 ADL2     SB5    B5-B1
          ZR     B5,ADLX     IF 5 DIGITS
          AX2    6
          EQ     ADL1        ADD NEXT DIGIT 
  
 ADL3     SB6    B6-B1
          LE     B2,B6,ADL4  IF PAST BUFFER LWA 
          SA7    B6          PAD WITH LEADING ZEROS 
 ADL4     SB5    B5-1 
          NZ     B5,ADL3     IF NOT FIVE DIGITS 
          EQ     ADLX        RETURN 
 ASL      SPACE  4,15 
**        ASL - ASSEMBLE LETTERS. 
* 
*         ENTRY  (B2) = POINTER TO END OF LINE. 
*                (B4) = NUMBER OF NON-BLANK CHARACTERS TO BE ASSEMBLED. 
*                (B7) = STRING BUFFER ADDRESS OF START OF ASSEMBLY. 
* 
*         EXIT   (X5) = ASSEMBLED CHARACTERS (RIGHT JUSTIFIED). 
*                (B7) = UPDATED STRING BUFFER ADDRESS.
*                (B5) = STRING BUFFER ADDRESS OF START OF ASSEMBLY. 
* 
*         USES   X - 2, 3, 5. 
*                A - 2. 
*                B - 4, 5, 7. 
  
  
 ASL      SUBR               ENTRY/EXIT 
          SB5    B7+
          SX5    B0+
 ASL1     EQ     B2,B7,ASLX  IF END OF LINE 
          SA2    B7 
          SB7    B7+B1
          SX3    X2-1R
          ZR     X3,ASL1     IF SPACE 
          MX3    54 
          BX3    X3*X2
          ZR     X3,ASL4     IF DISPLAY CODE CHARACTER
          SX3    X3-7600B 
          NZ     X3,ASL3     IF ESCAPE CODE *74*
          MX3    -6 
          BX2    -X3*X2 
          ZR     X2,ASL2     IF NOT A LOWER CASE ALPHABETIC CHARACTER 
          SX3    X3-33B 
          NG     X3,ASL4     IF A LOWER CASE ALPHABETIC CHARACTER 
 ASL2     SX2    1R?
          EQ     ASL4        ADD DUMMY CHARACTER TO STRING
  
 ASL3     SX2    X2-7404B 
          NZ     X2,ASL2     IF NOT AN EXTENDED COLON 
          SA2    COLON
 ASL4     LX5    6           ADD CHARACTER
          SB4    B4-1 
          IX5    X5+X2
          NZ     B4,ASL1     IF ALL CHARACTERS NOT ASSEMBLED
          EQ     ASLX        RETURN 
 SCN      SPACE  4,15 
**        SCN - SCAN LINE.
* 
*         *SCN* SCANS THE REST OF THE LINE LOOKING FOR THE
*         CHARACTER STRING SPECIFIED IN (X4).  CHARACTERS 
*         WITHIN QUOTES (LITERALS), AND CHARACTERS AFTER AN 
*         APOSTROPHE (EMBEDDED COMMENTS), ARE IGNORED.
* 
*         ENTRY  (B2) = POINTER TO END OF LINE. 
*                (B4) = LENGTH OF CHARACTER STRING IN X4. 
*                (B7) = POINTER TO CURRENT WORD IN LINE.
*                (X4) = CHARACTER STRING RIGHT JUSTIFIED TO SCAN FOR. 
* 
*         EXIT   (X5) = LAST ASSEMBLED CHARACTER STRING.
*                (B7) = UPDATED LINE POINTER - POINTS TO POSITION 
*                       IMMEDIATELY FOLLOWING LAST CHARACTER ASSEMBLED
*                       OR TO THE END OF LINE.
* 
*         USES   X - 1, 5.
*                A - 5. 
*                B - 4, 6, 7. 
* 
*         CALLS  ASL. 
  
  
 SCN      SUBR               ENTRY/EXIT 
          SB6    B4+         SAVE LENGTH OF CHARACTER STRING IN X4
          SX5    B0+
 SCN1     EQ     B2,B7,SCNX  IF END OF LINE 
          SA5    B7 
          SB7    B7+B1
          SX1    X5-1R
          ZR     X1,SCN1     IF BLANK 
          SX1    X5-QUOTE 
          ZR     X1,SCN2     IF QUOTE 
          SX1    X5-APOS
          ZR     X1,SCN3     IF EMBEDDED COMMENT FOUND
          SB7    B7-B1
          SB4    B6          REINITIALIZE TO LENGTH OF STRING IN X4 
          RJ     ASL         ASSEMBLE NEXT CHARACTER(S) FROM LINE 
          BX1    X5-X4
          ZR     X1,SCNX     IF CHARACTER STRING IN X4 FOUND IN LINE
          SB7    B5+B1
          EQ     SCN1        CHECK NEXT CHARACTER 
  
 SCN2     EQ     B2,B7,SCNX  IF END OF LINE 
          SA5    B7 
          SB7    B7+B1
          SX1    X5-QUOTE 
          NZ     X1,SCN2     IF MATCHING QUOTE NOT FOUND
          EQ     SCN1        CHECK NEXT CHARACTER 
  
 SCN3     SB7    B2          SET END OF LINE
          EQ     SCNX        RETURN 
 SRC      SPACE  4,20 
**        SRC - SEARCH LINE NUMBER TABLE. 
* 
*         ENTRY  (X0) = OLD LINE NUMBER.
* 
*         EXIT   (B4) = SEARCH FLAG.
*                       .LT. 0, LINE NUMBER NOT FOUND USING ASSUMED 
*                               SORT OPTION.
*                       .EQ. 0, LINE NUMBER NOT FOUND.
*                       .GT. 0, LINE NUMBER FOUND.
*                (X1) = *LNT* ENTRY.
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                A - 2, 3, 6. 
*                B - 4, 5, 6. 
* 
*         MACROS READEI, READO, REWIND. 
  
  
 SRC      SUBR               ENTRY/EXIT 
          SA2    LNTP 
          SB6    0-24 
          BX6    X2 
          PL     X6,SRC2     IF *LNT* NOT WRITTEN OUT 
  
*         READ IN *LNT* OFF MASS STORAGE. 
  
          LX6    0-36 
          SX6    X2 
          SA6    SRCA 
          REWIND X6 
          READEI X2 
 SRC1     SA2    SRCA 
          READO  X2 
          SA3    LNTP 
          BX2    X6 
          ZR     X1,SRC4     IF NO ERROR
          EQ     SRC6        LINE NUMBER NOT FOUND
  
 SRC2     SA3    LNTP 
          BX4    X3 
          LX4    0-18        GET LWA+1 OF *LNT* BUFFER
          SB4    X3 
          SB5    X4 
          EQ     B4,B5,SRC6  IF *LNT* EMPTY 
 SRC3     SA2    B4+         GET NEXT ENTRY 
 SRC4     MX1    -18
          LX6    B6,X2
          BX6    -X1*X6 
          IX6    X6-X0
          ZR     X6,SRC8     IF MATCH FOUND 
          LX4    B1,X3
          PL     X4,SRC5     IF NOT SORTED ON OLD LINE NUMBER 
          PL     X6,SRC7     IF NOT FOUND 
 SRC5     NG     X3,SRC1     IF *LNT* WRITTEN OUT TO DISK 
          SB4    B4+1 
          LE     B4,B5,SRC3  IF NOT END OF *LNT* TABLE
  
*         SET FLAG TO *NOT FOUND*.
  
 SRC6     SB4    B0 
          EQ     SRCX        RETURN 
  
*         SET FLAG TO *NOT FOUND* USING ASSUMED SORT OPTION.
  
 SRC7     SB4    -B4
          EQ     SRCX        RETURN 
  
 SRC8     BX1    X2 
          SB4    B1 
          EQ     SRCX        RETURN 
  
 SRCA     CON    0           FET ADDRESS
  
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 BLP      EQU    /COMCBLP/BLP 
 QUAL$    ENDIF 
          ENDX
