         SYSTEM   SIG7
         SYSTEM   BPM
*M*      STNUTL IS USED TO CREATE AND MAINTAIN THE TP STATION NAMES FILE
R1       EQU      1                 REGESTER EQUIV
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
R16      EQU      16
CONSNZ   EQU      8                 NUMBER OF BYTES IN A STN-ID
ID       EQU      400               NUMBER OF BYTES FOR I/O BUF
***********************************
*        F:STAX FILE FORMAT
*        COL 1-8  STN-ID OR INSERT ID
*        COL 9-10 STATION TYPE OR BLANKS
*        COL 11   BLANK
*        COL 12-N NPS SEPARATED BY BLANKS
*                 ALLOWABLE PREFIXES ARE #@?%+
***********************************
F:STAX   DSECT    1                 DCB AREA
F:STAX   M:DCB    (DEVICE,'DC'),(INOUT),(SAVE),(ABN,CE3),;
                  (ERR,CE3),(RECL,ID),;
                  (KEYED),(FILE,'DUMMYFILE'),(DIRECT)
         REF      M:LO              LISTING AND DATA OUTPUT FILE
         REF      M:SI              DIRECTIVES AND DATA INPUT FILE
         CSECT    0
         BOUND    4                 CONSTANTS AND WORK AREA
CISV1    RES      1                 CARD/LINE READER LINKAGE
CILF     RES      1                 REMAINING NUMBER OF CHAR
CIPT     RES      1                 CURRENT BUF LOC
BUFCD    RES      ID                CARD/TTY INPUT AREA
INBF     RES      ID                ACTUAL WRITE BUFFER
WBF1     RES      ID                WORK BUFFER
WBF2     RES      ID                SECOND WORK BUFFER
CONBLN   TEXT     C'    '           BLANK SEEDS
CB1      TEXTC    C'SUB '           TABLE OF ALLOWABLE VERBS
CB2      TEXTC    C'SUBTRACT '
CB3      TEXTC    C'ADD '
CB4      TEXTC    C'DEL '
CB5      TEXTC    C'DELETE '
CB6      TEXTC    C'INS '
CB7      TEXTC C'INSERT '
CB8      TEXTC    C'LIS '
CB9      TEXTC    C'LIST '
CB10     TEXTC    C'LIS-EXP '
CB11     TEXTC    C'LIST-EXPAND '
CBVERB   GEN,8,24 1,BA(CB1)   SUBTRACT
         GEN,8,24 1,BA(CB2)   SUBTRACT
         GEN,8,24 2,BA(CB3)   ADD
         GEN,8,24 3,BA(CB4)   DELETE
         GEN,8,24 3,BA(CB5)   DELETE
         GEN,8,24 4,BA(CB6)   INSERT
         GEN,8,24 4,BA(CB7)   INSERT
         GEN,8,24 5,BA(CB8)   LIST
         GEN,8,24 5,BA(CB9)   LIST
         GEN,8,24 9,BA(CB10)   LIST-EXPAND
         GEN,8,24 9,BA(CB11)   LIST-EXPAND
CBVBEN   EQU      %                 END OF VERB TABLE
*P*      NAME: STNUTL
*P*      PURPOSE: THE STATION NAMES UTILITY IS USED TO CREATE AND MAIN-
*P*               TAIN THE STATION NAMES FILE.  THIS FILE IS USED
*P*               BY THE TRANSACTION PROCESSING TERMINAL INTERFACE
*P*               CONTROLLER (TP-TIC) TO DESCRIBE THE TP
*P*               COMMUNICATIONS NETWORK.  ALL TP LINES AND THEIR
*P*               LOGICAL CHARACTERISTICS ARE DESCRIBED IN THIS FILE.
*P*               AT TIC INITILIZATION THIS FILE IS READ AND USED
*P*               TO DESCRIBED ALL TP LINES ACQUIRED BY THE TIC.
*P*
*P*               THE STNUTL ACCEPTS DIRECTIVES AND DATA FROM M:SI
*P*               AND VALIDATES ITS CONTENTS.  APPROIATE ERROR MESSAGES
*P*               ARE DISPLAYED TO THE USER.  VARIOUS FACILITIES
*P*               ARE AVALIABLE - SUCH AS DELETING, ADDING AND MODIFYING
*P*               OF STATION NAMES .
*P*      REFERENCE: TRANSACTION PROCESSING REFERENCE MANUAL
*P*               90-31-12
*D*      NAME: STNUTL
*D*      ENTRY: STNUTL
*D*      CALL: THE STNUTL IS A FREE STANDING SLAVE PROGRAM.
*D*               IT IS USABLE EITHER ON-LINE OR IN THE BATCH MODE.
*D*      INTERFACE: NO SPECIAL INTERFACES ARE USED--ONLY STD I-O.
*D*      ENVIRONMENT: UNMAPPED,SLAVE,PRIVILEGE 40
*D*      DATA: THE STATION NAMES FILE IS KEYED (8 CHARACTER KEY)
*D*               THE FILE DATA CONSISTS OF THE VARIOUS NAME POSSIBILITY
*D*               STRINGS (NPS).
*D*
*D*               THE DCB NAME IS F:STAX AND IS OPENED IN-OUT.
*d*      INPUT: M:SI IS USED TO READ ALL INPUT DIRECTIVES AND INPUT
*D*               DATA.
*D*      OUTPUT: M:LO AND L:LL ARE USED FOR ALL UTILITY INFORMATION AND
*D*               ERROR MESSAGE OUTPUT.
STNUTL   EQU      %                 START STATION NAMES UTILITY
         LCI      2
         LM,R1    *0             R0 CONTAINS POINTER TO TEMP STACK IN TCB
         STM,R1   TSTACK
         M:OPEN   F:STAX,(KEYM,CONSNZ),(INOUT),(KEYED)
         M:PC     '<'
DRIVER   EQU      %
         M:SETDCB F:STAX,(ABN,CE3),(ERR,CE3)
         BAL,R1   CICARD            GO PRIME INPUT BUFFER
         LI,R1    0                 SET TO GO THRU TABLE(VERBS)
DRLOP    EQU      %
         LI,R4    BA(BUFCD)         GET JUST READ BUFFER LOC
         LW,R2    CBVERB,R1         GET ADDRESS OF VERBS
         LW,R5    R2                B A OF TEXTC
         AI,R5    1                 SKIP OVER COUNT
         AND,R5   =X'00FFFFFF'
         SLS,R2   -2                WANT WORD ADDRESS
         LW,R6    *R2               ONLY WANN COUNT
         AND,R6   =X'FF000000'
         OR,R5    R6
         CBS,R4   0
         BE       DRFND             GOT A HIT
         AI,R1    1                 INCREMENT THRU TABLE
         CI,R1    CBVBEN-CBVERB
         BL       DRLOP             MORE TO DO
         B        CE2               NO DIRECTIVE FOUND
DRFND    EQU      %                 GOT A GOOD DIRECTIVE
         STW,R4   DRC1              SAVE THE CURRENT LOCATION
         LW,R7    R6                COMPUTE REMAINING CHARS
         SLS,R7   -24
         SW,R7    CIPT              ENTIRE SIZE OF INPUT RCD
         MI,R7    -1                MAKE IT POSITIVE
         STW,R7   CIPT
         LW,R1    CBVERB,R1         GET APPROIATE ENTRY
         SLS,R1   -24
DRVEC    STW,R1   DRC2              SAVE TYPE OF DIRECTIVE
         B        DRGOT,R1
DRC1     RES      1                 CURRENT LOCATION
DRC2     RES      1                 TYPE OF DIRECTIVE
DRGOT    B        CE2               NO ENTRY FOUND
         B        SU                SUBTRACT A NPS (CB1,CB2)
         B        AD                ADD AN NPS (CB3)
         B        DE                DELETE A STATION (CB4,CB5)
         B        IN                INSERT A STATION (CB6,CB7)
         B        LIST              SOME SORT OF LIST (CB8,CB9)
         B        LN                GIVEN NPS LIST STN-IDS
         B        LA                LIST ENTIRE FILE
         B        LS                LIST STN-IDS ETC
         B        LE                SOME SORT OF EXPAND
         B        CE2               NO ENTRY FOUND
LIST     EQU      %                 SOME SORT OF LIST WANTED
         LI,R2    0                 NO EXPAND FLAG
LISTE    STW,R2   EXFL              EXPAND FLAG
         LW,R2    CIPT
         BLZ      LA1               LIST ENTIRE FILE
         LW,R1    DRC1              GET CURRENT LOCATION
         LW,R2    DRC1
         AND,R2   =X'00000003'      WANT BYTE LOCATION
         SLS,R1   -2                WORD ADDRESS
         LB,R15   *R1,R2
         LI,R6    LI2               GIVEN NPS WANT STN-ID
         BAL,R5   CUNPS             GO TO COMPARE RTN
         LI,R1    8                 STATION-ID
         B        DRVEC
LA1      LI,R1    7                 LIST ENTIRE FILE
         B        DRVEC
LI2      LI,R1    6                 GIVEN NPS LIST ST-ID
         B        DRVEC
LE       LI,R2    1                 SET EXPAND FLAG
         B        LISTE
EXFL     RES      1                 EXPAND FLAG
LI1      TEXT     C'#?@%Y+++'
LNEN     EQU      %
CUNPS1   RES      1                 XR6 HIT ON ONE CHAR RETURN
CUNPS    EQU      %                 CHECK FOR NPS PREFIX
         STW,R6   CUNPS1            X6 COMPARE HIT RETURN
         LI,R6    0                 X5 NO HIT RETURN
CUNPS2   LB,R13   LI1,R6            X15 HAS SUBJECT CHARACTER
         CW,R13   R15               X13 HAS HIT CHARACTER
         BE       *CUNPS1           GOT A HIT
         AI,R6    1
         CI,R6    BA(LNEN)-BA(LI1)
         BE       *R5
         B        CUNPS2
IN       EQU      %                 INSERT A STATION ETC
         LW,R3    =C'    '          FOR BLANK FILLING NAMES
         STW,R3   INBF
         STW,R3   INBF+1
         STW,R3   INBF+2
         LI,R3    0                 BUILDER COUNTER
         LW,R2    DRC1              WHERE WE ARE ON INPUT CUB
         AND,R2   =X'3'
         STW,R2   INOFST            SAVE THE OFFSET
         LW,R1    DRC1              NOW WE WANT LOCATION
         SLS,R1   -2                WORD ADDRESS
         LB,R15   *R1,R2            GET FIRST CHARACTER
         AI,R2    1
         LI,R4    CONSNZ            SIZE OF STN ID
INSN     STB,R15  INBF,R3           MOVE THE STN-ID
         AI,R4    -1                ONLY DO EIGHT CHAR
         BEZ      INTYNX            ALLL DONE
         AI,R3    1
         CW,R3    CIPT
         BG       CE4
         LB,R15   *R1,R2
         CI,R15   C' '              BLANK TEST
         BE       INTYNX+1
         AI,R2    1
         B        INSN
INTYNX   LB,R15   *R1,R2            BLANK ENDS THE STN-ID
         AI,R2    1
         LI,R3    8                 THIS BLANK FILLS THINGS
         CI,R15   C' '
         BNE      CE4               ERROR IF NO BLANK
         LI,R4    0                 SEE IF THIS IS AN INSERT
         LB,R13   INBF,R4           TYPE OF KEY
         CI,R13   C'+'
         BE       IN2B
         LB,R15   *R1,R2            CHECK FOR AN NPS
         AI,R2    1
         LI,R6    IN3B              PUT 3 BLANKS IF NO STN-TYP
         BAL,R5   CUNPS
INTY     STB,R15  INBF,R3           INSERT THE FIRST CHAR
         AI,R3    1                 GOT A STN TYPE
         LB,R15   *R1,R2
         AI,R2    1
         CI,R15   C' '
         BE       CE5               MUST HAVE TWO CHARACTERS
         STB,R15  INBF,R3
         AI,R3    1
         LB,R15   *R1,R2
         AI,R2    1
         CI,R15   C' '              NO MORE THAN THREE
         BNE      CE5
         B        INMVBL            GO CHECK FIRST CHAR
INMV     STB,R15  INBF,R3           MOVER RTN
         AI,R3    1
         LB,R15   *R1,R2
         SW,R2    INOFST            ADD OFFSET
         CW,R2    CIPT
         BE       INWRT
         AW,R2    INOFST
         AI,R2    1
         CI,R15   C' '              CHECK FOR A BLANK
         BNE      INMV              IF NOT JUST MOVE IT
INMVBL   STB,R15  INBF,R3           IF SO CHECK FOR A NEXT
         AI,R3    1                 CHAR TO BE A VALID NPS
         LB,R15   *R1,R2
         AI,R2    1
         LI,R5    CE5               IF NOT ERROR
         BAL,R6   CUNPS
INQT     EQU      %                 Y QUOTE STRING PROCESSING
         CI,R15   C'Y'              CHECK
         BNE      INMV              NO YSTRING
         STB,R15  INBF,R3           SAVE THE NPS
         AI,R3    1
         LI,R6    0                 INITILIZE THE X 6 SWITCH
INQTLB   LB,R15   *R1,R2            GET NEXT CHARACTER
         SW,R2    INOFST            CHECK IF WE ARE DONE
         CW,R2    CIPT
         BE       INWRT             ALL DONE
         AW,R2    INOFST            ADD BACK THE OFFSET
         AI,R2    1
         CI,R15   X'7D'             CHECK FOR A QUOTE
         EXU      INQSW,R6
         STB,R15  INBF,R3           SAVE QUOTE STRING
         AI,R3    1
         LI,R6    1                 NOW CHECK FOR ENDING QUOTE
         B        INQTLB            RE LOOP THRU BUILDER
INQTDN   EQU      %                 ALL DONE CHECK FOR A BLANK
         STB,R15  INBF,R3           SAVE THE ENDING QUOTE
         AI,R3    1
         LB,R15   *R1,R2
         SW,R2    INOFST            CHECK IF WE AREDONE
         CW,R2    CIPT
         BGE      INWRT
         AW,R2    INOFST
         AI,R2    1                 KEEP THE COUNT GOING
         CI,R15   C' '              TRAILING BLANK
         BNE      CE5               ERROR IF NO SPACE AFTER QUOTE
         B        INMVBL
INQSW    BNE      CE5               NO BEGINNING QUOTE
         BE       INQTDN            CLOSING QUOTE
IN3B     EQU      %                 INSERT THREE BLANKS
         AI,R3    3                 POINT TO NEXT LOCATION
         B        INQT
IN2B     AI,R3    2                 ALSO INSERT THREE BLANKS
         B        INMVBL            NOW DO QUOTE CHECKING
INWRT    EQU      %                 WRITE ROUTINE
         STW,R3   CIPT              SAVE THE NEW SIZE
         LI,R4    CONSNZ            KEY SIZE
         SLS,R4   24
         LI,R3    BA(KEY)+1         MOVE THE KEY
         OR,R3    R4
         LI,R2    BA(INBF)
         MBS,R2
         M:SETDCB F:STAX,(ABN,CE8)
         M:WRITE  F:STAX,(BUF,INBF),(WAIT),(KEY,KEY),;
                  (SIZE,*CIPT),;
                  (NEWKEY)
         M:PRINT  (MESS,INM)        TELL HIM WE DID IT
         LW,R2    CIPT              PRINT IMAGE
         LI,R3    WA(INBF)          BUFFER LOCATION
         BAL,R1   CUPT              GENERAL PRINT ROUTINE
         B        DRIVER
KEY      GEN,8,24 CONSNZ,0
         RES      2
INOFST   RES      1                 OFFSET COUNTER
INM      TEXTC    C'.....FOLLOWING STATION INSERTED'
CE4      EQU      %
         M:PRINT  (MESS,CE44)
         B        DRIVER            COMMON EXIT
CE44     TEXTC    C'*****INVALID STATION ID SPECIFIED'
CE5      STW,R3   COMVAL            SAVE GOOD CHAR POSITION
         M:PRINT  (MESS,CE55)
         B        CECM              COMMON EXIT
CE55     TEXTC    C'*****NAME POSSIBILITY STRING ERROR'
CE8      EQU      %                 WRITE ERROR RETURN
         LW,R4    R10               GET STATUS
         SLS,R4   -24
         CI,R4    X'16'             CHECK FOR EXISTANT KEY
         BE       CESAME
         B      CE3
CESAME   M:PRINT  (MESS,CE88A)
         B        DRIVER
CE88A    TEXTC    C'*****STATION/INSERT NPS ALREADY EXISTS'
COMVAL   RES      1                 LAST GOOD CHAR POSITION
CECM     LW,R2    COMVAL            SIZE
         LI,R3    INBF              BUFFER LOCATION
         LI,R1    DRIVER
         B        CUPT              COMMON PRINT RTN
LASW     RES      1                 KEY READ SWITCH
LAKEY    GEN,8,24 CONSNZ,0
         RES      3
LA       EQU      %                 LIST ENTIRE FILE USING
         LI,R10   0                 ZERO IT OUT FOR STATUS
         M:PFIL   F:STAX,(BOF)      STN-ID AS KEY
         B        LAFIRST           NO KEY ON FIRST TRY
LALOOP   M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),(KEY,LAKEY),;
                  (ABN,LAEND)
LAFIRST  M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),(ABN,LAEND)
         LI,R1    0                 SET KEY SWITCH
         STW,R1   LASW              TO NOT USE KEY
         LI,R2    CONSNZ            KEY SIZE FOR KEEPING IT
         SLS,R2   24
         LI,R3    BA(LAKEY)+1
         OR,R3    R2
         LI,R2    BA(WBF1)          JUST READ KEY
         MBS,R2   0
         LW,R2    F:STAX+4          GET JUST READ SIZE
         SLS,R2   -17
         LW,R1    EXFL              CHECK EXPAND FLAG
         BEZ      LARAW             NO EXPANSION NEEDED
         STW,R2   WBCE              ENDING LOCATION
         BAL,R1   CEGO              GO PRINT THE WHOLE THING
         LW,R2    WBCE              EXPANDED--
         LI,R3    INBF              BUFFER LOCATION
         B        %+2
LARAW    LI,R3    WBF1              JUST READ BUFFER
         LI,R1    LALOOP            RETURN TO LOOP
         LW,R5    LASW              CHECK IF WE HAVE TO SEEK KEY
         BNEZ     CUPT              YES READ A KEY
         LI,R1    LAFIRST           NO JUST SEQUENTIAL READ
         B        CUPT              PRINT ROUTINE
LAEND    EQU      %                 ABN LOCATION FOR READ
         LW,R4    R10               GET STATUS
         SLS,R4   -24
         CI,R4    X'06'             EOF
         BNE      CE3               ONLY E O F TERMINATES
         M:PRINT  (MESS,LAENDMS)    TELL ABOUT E O F
         B        DRIVER
LAENDMS  TEXTC    C'.....ENTIRE STAX FILE SCANNED'
         B      CE3                 ANYTHING ELSE LET MONITOR HNDL IT
CELINK   RES      1                 RETURN LINKAGE FOR EXPANDER
WBAC     RES      1                 CURRENT WORK BUF POINTER
WBAN     RES      1                 NEXT WORK BUF POINTER
WBCS     RES      1                 CURRENT BUF START BYTE
WBCE     RES      1                 CURRENT BUF END BYTE
INBFPT   RES      1                 FINALD BUF LAST CHAR POINTER
CEKEY    GEN,8,24 CONSNZ,0          KEY FOR + NPS SEEK
         RES      2
CEGO     EQU      %                 EXPANDER SUBRTN
         STW,R1   CELINK            RETURN LINKAGE
         LI,R1    WBF1              FIRST WORK BUFF INITILIZE
         STW,R1   WBAC              MAKE IT CURRENT
         LI,R1    WBF2              SECOND WORK BUFF AS NEXT
         STW,R1   WBAN               MAKE IT NEXT  INITILIZE
         LI,R1    0
         STW,R1   WBCS              STARTING LOC OF CURRENT BUF
***NOTE ASSUME CALLER INITILIZED ENDING LOCATION OF BUF (WBCE)
         STW,R1   INBFPT            FINAL BUF CHAR COUNTER
CELOOP   EQU      %                 MOVE LOOP
         LW,R1    WBAC              GET CURRENT BUFFER
         LW,R2    WBCS              STARTING LOCATION
         CW,R2    WBCE              SEE IF WE ARE ALL DONE
         BL       %+2               NOT DONE YET
         B        CEEXT             ALL DONE SO RETURN
         LI,R3    INBF              CALLERS FINAL BUFFER LOCATION
         LW,R4    INBFPT            POINTER TO LAST CHARACTER
CESML    LB,R15   *R1,R2            GET A CHARACTER
         AI,R2    1                 INCREMENT CURRENT POSITION
         CW,R2    WBCE              CHECK IF WE ARE DONE
         BG       CEEXT             ALL DONE
         CI,R15   C' '              IF BLANK WE HAVE A NPS
         BE       CEBLNK            MAYBE ITS A +
         STB,R15  *R3,R4            SAVE  IT IN FINAL
         AI,R4    1
         B        CESML             DO NEXT CHARACTER
CEBLNK   EQU      %                 NEW NPS CHECK FOR A +
         STB,R15  *R3,R4            SAVE THE BLANK
         AI,R4    1
         LB,R15   *R1,R2
         AI,R2    1
         CI,R15   C'+'              CHECK FOR AN INSERT NPS
         BE       CEPLUS            YES A PLUS
         B        CESML+2
CEPLUS   EQU      %                 GET AN INSERT NPS
         STW,R2   CE7A              JUST IN CASE NPS NOT DEFINED
         STW,R4   INBFPT            SAVE CURRENT POSITION
         LW,R6    KEYINT            GET CONSTANT KEY SIZE
         STW,R6   LASW              JUST SET A KEY SWITCH
         STW,R6   CEKEY
         LW,R7    =C'    '          BLANK FILL REST OF KEY
         STW,R7   CEKEY+1
         STW,R7   CEKEY+2
         LI,R6    1                 BUILD KKEY START ADDR
         B        CEPLBL+2
CEPLBL   LB,R15   *R1,R2            BUILD KEY
         AI,R2    1
         CW,R2    WBCE              SEE IF BUFFER EXHAUSED
         BG       CEPLRD            IF SO ITS OK
         CI,R15   C' '              BLANK ALSO STOPS BUILDING
         BE       CEPLRD
         STB,R15  CEKEY,R6
         AI,R6    1
         CI,R6    CONSNZ+1          CHECK IF WE DID ENTIRE KEY
         BLE      CEPLBL            BUILD MORE KEY
         LB,R15   *R1,R2            GET NEXT BYTE
         CI,R15   C' '              MUST BE A BLANK
         BNE      CE6               ERROR IF NOT
         AI,R2    1
CEPLRD   STW,R2   WBCS              LAST USED CHARACTER +1
         M:SETDCB F:STAX,(ERR,CE7)
         M:READ   F:STAX,(BUF,*WBAN),(SIZE,ID),(KEY,CEKEY),;
                  (WAIT)
*NOW MOVE REMAINDING PART OF 'CURRENT' WORK BUFFER TO TAIL
*OF JUST READ BUFFER
         LW,R1    F:STAX+4          NUMBER OF JUST READ CHARS
         SLS,R1   -17
         LW,R3    WBAN              BEGINNING LOC OF JUST READ BUF
         SLS,R3   2
         AW,R3    R1                ENDING LOC OF JUST READ BUF
         LW,R2    WBAC              REMAINING PORTION OF 'CURRENT'
         SLS,R2   2                 TO BE MOVED TO TAIL OF JUST
         AW,R2    WBCS              READ DATA
         AI,R2    -1                GET BLANK ALSO
         LW,R6    WBCE              COMPUTE REMAINDING COUNT
         SW,R6    WBCS
         AI,R6    1                 HOUSEKEEPING
         AW,R1    R6                GET TOTAL NEW SIZE
         STW,R1   WBCE
         SLS,R6   24                FOR MOVE COUNT
         OR,R3    R6
         MBS,R2   0                 MOVE IT
         LW,R1    WBAC              NOW EXCHANGE POINTERS
         XW,R1    WBAN              CURRENT AND NEXT
         STW,R1   WBAC
         LI,R1    CONSNZ+3          START AFTER KEY AND BLANK
         STW,R1   WBCS              NEW CURRENT BUFFER
         B        CELOOP
CEEXT    STW,R4   WBCE              SAVE NEW TOTAL SIZE
         B        *CELINK
CE6      M:PRINT  (MESS,CE66)       INSERT NPS ERROR
         LW,R2    R4                GET JUST PROCESSED SIZE
         B        CECM+1            BYPASS SIZE INITILIZER
CE66     TEXTC    C'*****INSERT (+) NPS ERROR'
CE7      M:PRINT  (MESS,CE77)
         LI,R15   C'+'              JUST PRINT THE + NPS
         LW,R2    CE7A              LIKE NOTHING HAPPENED
         B        CESML+2
CE7A     RES      1                 PRIOR X R 2 SETTING
CE77     TEXTC    C'*****INSERT (+) NPS NOT DEFINED YET'
DE       EQU      %                 DELETE A KEYED RECORD
         LW,R4    CIPT              COUNT OF WORK CHARACTERS
         LW,R7    KEYINT            INITILIZE KEY
         STW,R7   CEKEY
         LW,R7    =C'    '          BLANK INITILIZE
         STW,R7   CEKEY+1
         STW,R7   CEKEY+2
         LW,R3    DRC1              COUNT
         AND,R3   =X'3'
         LW,R6    DRC1
         SLS,R6   -2                WORD ADDRESS
         LI,R5    1
DELOOP   LB,R15   *R6,R3            MOVE THE KEY
         AI,R3    1
         STB,R15  CEKEY,R5
         AI,R5    1
         CI,R5    CONSNZ+1          CHECK FOR 8 CHARACTERS
         BG       CE4               ERROR IF HE TYPED TOO MUCH
         AI,R4    -1
         BGZ      DELOOP
         M:SETDCB F:STAX,(ABN,CE10)
         M:DELREC F:STAX,(KEY,CEKEY)
         M:PRINT  (MESS,DE01)       TELL HIM WE DID IT
         B        DRIVER
DE01     TEXTC    C'.....DELETED'
KEYINT   GEN,8,24 CONSNZ,C'   '
CE10     M:PRINT  (MESS,CE101)
         B        DRIVER
CE101    TEXTC    C'*****DELETE RECORD NOT FOUND'
CE12     M:PRINT  (MESS,CE121)
         B        DRIVER
CE121    TEXTC    C'*****INCORRECT STATION/KEY SPECIFIED'
LS       EQU      %                 LIST NAMED STATIONS
         LW,R1    DRC1              GET WORD ADDRES OF WORK IMAGE
         SLS,R1   -2
         STW,R1   LSWA              SAVE WORD ADDRESS
         LW,R2    DRC1              NOW WANT CHAR POS
         AND,R2   =X'3'
         STW,R2   LSPOS             SAVE CHAR POSITION
         LW,R3    CIPT              TOTAL CHARACTERS TO PROCESS
LSLOOP   BLEZ     DRIVER            ALL DONE
         LW,R4    KEYINT            INITILIZE KEY
         STW,R4   KEY
         LW,R4    =C'    '          BLANK OUT THE REST
         STW,R4   KEY+1
         STW,R4   KEY+2
         LI,R5    1                 USED FOR BUILDING KEY
LSKBL    LB,R15   *R1,R2            KEY BUILDING LOOP
         AI,R2    1
         AI,R3    -1                DECREMENT CHARACTER COUNTER
         BLZ      LSRD              ALL DONE SO GET LAST
         CI,R15   C' '              CHECK FOR END OF KEY
         BE       LSRD              ALSO CAUSES A READ
         STB,R15  KEY,R5            BUILDING KEY
         CI,R5    CONSNZ            SEE IF S WHOLE KEY IS BUILT
         BG       LSRD              IS SO DONE
         AI,R5    1
         B        LSKBL
LSRD     STW,R1   LSWA              SAVE WORD ADDRESS
         STW,R2   LSPOS             SAVE CHAR POSITION
         STW,R3   CIPT              SAVE COUNT
         M:SETDCB F:STAX,(ERR,CE12)
         M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),;
                  (KEY,KEY)
         LW,R2    F:STAX+4          GET SIZE
         SLS,R2   -17
         LW,R1    EXFL
         BEZ      LSRAW             SEE IF EXPAND WANTED
         STW,R2   WBCE              SET UP EXPAND DATA
         BAL,R1   CEGO              GO EXPAND IT
         LW,R2    WBCE              NOT COMMON PRINT
         LI,R3    INBF              BUFFER LOCATION
         B        %+2
LSRAW    LI,R3    WBF1              JUST READ BUFFER FOR RAW
         BAL,R1   CUPT              GO PRINT IT
         LW,R1    LSWA              DO NEXT STATION
         LW,R2    LSPOS             PICK-UP WHERE WE LEFT OFF
         LW,R3    CIPT              COUNT
         B        LSLOOP            RE LOOP
LSWA     RES      1                 W A OF WORK BUFFER
LSPOS    RES      1                 CHAR POS OF LAST STN-ID
ADQSW    BNE      ADER3             ERROR NO QUOTE AFTER Y NPS
         BE       ADYDON            ENDING QUOTE
AD       EQU      %                 ADD A NEW NPS TO NAMED
         LW,R1    DRC1              STATION(S)
         SLS,R1   -2                WORD ADDR OF WORK BUF
         STW,R1   ADRD              SAVE FOR LATER RESTORATION
         LW,R2    DRC1              NOW GET BYTE OFFSET
         AND,R2   =X'3'             CLEAN UP EXTRA STUFF
         STW,R2   ADOFF             SAVE THE OFFSET
         AWM,R2   CIPT              FOR END CHECK
         LW,R2    ADOFF
         LB,R15   *R1,R2            MAKE SURE FIRST CHAR
         LI,R5    ADER3             IS A VALID NPS
         BAL,R6   CUNPS
         AI,R2    1                 ITS OK
         CI,R15   C'Y'              SEE IF WE HAVE A Y NPS
         BNE      ADLP              NOPE SO PROCEED
         LI,R6    0                 SET QUOTE SWITCH
ADQT2    LB,R15   *R1,R2            START SCANNING QUOTE STRING
         AI,R2    1                 INCREMENT THRU STRING
         CI,R15   X'7D'             SEE IF WE HAVE A QUOTE
         EXU      ADQSW,R6          DO APPROIATE ACTION
         LI,R6    1                 NOW CHECK FOR ENDING ONE
         CW,R2    CIPT              SEE IF IT IS AN ADD ALL
         BG       ADALL             SO ADD IT TO ENTIRE FILE
         B        ADQT2             KEEP COUNTING CHARACTERS
ADYDON   LB,R15   *R1,R2            CHECK FOR FOLLOWING BLANK
         AI,R2    1
         CW,R2    CIPT              CHECK FOR ADD ALL
         BG       ADALL             ALL TO ENTIRE FILE
         CI,R15   C' '              CHECK FOR A BLANK
         BNE      ADER3
         B        ADST
ADLP     LB,R15   *R1,R2            NOW DETERMINE SIZE OF
         AI,R2    1                 THE ADD NPS
         CI,R15   C' '              BLANK TERMINATES
         BE       ADST              ALL DONE WITH NOP
         CW,R2    CIPT
         BG       ADALL             ADD IT TO ENTIRE FILE
         B        ADLP
ADST     SW,R2    ADOFF
         STW,R2   ADCNT
ADBKEY   LW,R5    KEYINT            BLANK OUT THE DEY
         STW,R5   KEY
         LW,R5    =C'    '          BLANK FILL KEY
         STW,R5   KEY+1
         STW,R5   KEY+2
         LI,R5    1                 KEY SIZE COUNTER
ADKLP    LB,R15   *R1,R2
         AI,R2    1
         CW,R2    CIPT              THIS GETS LAST ENTRY
         BG       ADREAD            GO READ ENTRY
         CI,R15   C' '              BLANK TERMINATS
         BE       ADREAD            GO READ ENTRY
         STB,R15  KEY,R5
         AI,R5    1
         CI,R5    CONSNZ            MAKE SURE ABOUT KEY SIZE
         BLE      ADKLP
         B        CE4               ERROR TOO LARGE A KEY
ADREAD   STW,R2   ADPOS
         M:SETDCB F:STAX,(ERR,CE12) NO RECORD ENTRY
         M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),;
                  (KEY,KEY)
         LW,R2    F:STAX+4          GET READ SIZE
         SLS,R2   -17
         LI,R3    BA(WBF1)
         AW,R3    R2                ENDING LOC OF JUST READ
         AW,R2    ADCNT             SIZE OF NPS
         STW,R2   ADSZ              NEW TOTAL RECORD SZ
         LW,R2    DRC1              LOCATION OF NPS
         AI,R2    -1                WANT THE SPACE ALSO
         LW,R4    ADCNT             GET NPS SIZE
         SLS,R4   24
         OR,R3    R4
         MBS,R2   0
         M:WRITE  F:STAX,(BUF,WBF1),(SIZE,*ADSZ),;
                  (WAIT),(KEY,KEY)
         LI,R3    WBF1              PRINT OUT  JUST WROTE BUF
         LW,R2    ADSZ              SIZE OF NEW RECORD
         BAL,R1   CUPT
         M:PRINT  (MESS,ADTX)
         LW,R1    ADRD
         LW,R2    ADPOS
         CW,R2    CIPT
         BGE      DRIVER
         B        ADBKEY            DO NEXT
ADALL    EQU      %                 ADD THIS NPS TO ENTIRE FILE
         LI,R10   0
         M:PRINT  (MESS,ADALMS)
         SW,R2    ADOFF             GET TRUE COUNT
         STW,R2   ADCNT             SAVE THE COUNT
         M:PFIL   F:STAX,(BOF)
ADALRD   M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),;
                  (ABN,LAEND)
         LW,R2    F:STAX+4          GET JUST READ SIZE
         SLS,R2   -17
         LI,R3    BA(WBF1)
         AW,R3    R2
         AW,R2    ADCNT
         STW,R2   ADSZ              NEW SIZE
         LW,R2    DRC1              LOCATION OF NPS
         AI,R2    -1                GET SPACE ALSO
         LW,R4    ADCNT
         SLS,R4   24                ALIGN COUNT
         OR,R3    R4
         MBS,R2   0
         LI,R4    CONSNZ            SET UP TO BUILD A KEY
         SLS,R4   24                USED FOR MBS OF KEY
         STW,R4   KEY
         LI,R2    BA(WBF1)          USE THE KEY IN THE RECORD
         LI,R3    BA(KEY)+1
         OR,R3    R4
         MBS,R2   0                 MOVE THE KEY
         M:WRITE  F:STAX,(BUF,WBF1),(WAIT),(SIZE,*ADSZ),;
                  (KEY,KEY)
         B        ADALRD            READ NEXT
ADER3    M:PRINT  (MESS,CE55)
         B        DRIVER            BAD N P S
ADALMS   TEXTC    C'.....ADD NAMED NPS TO THE ENTIRE FILE'
ADSZ     RES      1                 NEW TOTAL RECORD SIZE
ADRD     RES      1                 BEGIN WORD OF INPUT WORK BF
ADPOS    RES      1                 CURRENT POSITION IN WORD BF
ADCNT    RES      1                 SIZE OF NPS TO BE ADDED
ADOFF    RES      1                 CHARACTER OFFSET
ADTX     TEXTC    C'.....ADDED'
LN       EQU      %                 GIVEN NPS LIST STNS
         LW,R1    DRC1              STARTING ADDR OF NPSS
         SLS,R1   -2                WORD ADDRESS
         STW,R1   LN1               SAVE IT
         LW,R2    DRC1              GET CHARACTER POSITION
         AND,R2   =X'3'
         STW,R2   LN2               SAVE CHAR POSITION
         AWM,R2   CIPT              FOR END CALCULATION
LNBS     EQU      %                 BUILD A CONTROL NPS
         LW,R2    LN2               COME HERE AFTER EOF ON STAX
         CW,R2    CIPT              ARE WE DONE
         BGE      LAEND             YES DONE TELL HIM ABOUT IT
         LW,R1    LN1
         LI,R3    0                 CHARACTER COUNTER
         LW,R4    R1                BA OF CURRENT NPS
         SLS,R4   2
         AW,R4    R2
         LB,R15   *R1,R2            CHECK FOR A Y NPS
         CI,R15   C'Y'              IF SO CHECK QUOTE STRING
         BNE      LNBS1
         AI,R2    1
         AI,R3    1                 KEEP INCREMENTING
         LB,R15   *R1,R2            NOW CHECK FOR A QUOTE
         CI,R15   X'7D'             ITS REQUIRED
         BNE      LNERR             ERROR IF NOT
LNQT     AI,R2    1
         AI,R3    1
         CI,R2    CIPT              CHECK FOR NO CLOSING QUOTE
         BGE      LNERR             ERROR IF NONE
         LB,R15   *R1,R2
         CI,R15   X'7D'             LOOK FOR ENDING QUOTE
         BNE      LNQT              KEEP SCANNING
         AI,R2    1
         AI,R3    1                 KEEP COUNT GOING
         CW,R2    CIPT              SEE IF ITS LAST NPS
         BGE      LNB3
         LB,R15   *R1,R2            NOW CHECK FOR REQUIRED SPACE
         CI,R15   C' '
         BNE      LNERR             ERROR IF NONE
         AI,R2    1
         AI,R3    1
         B        LNB3              NOW DO STANDARD TRICK
LNERR    M:PRINT  (MESS,CE55)       INVALID NPS
         B        DRIVER
LNBS1    LB,R15   *R1,R2            CALCULATE NPS SIZE
         AI,R2    1
         AI,R3    1
         CI,R15   C' '              CHECK FOR A SPACE
         BE       LNB3              IT SIGNALS AN NPS
         CW,R2    CIPT              ARE  WE AT THE LAST ONE
         BL       LNBS1             NO MORE TO GO
LNB3     STW,R2   LN2               SAVE POSITION FOR NEXT TIME
         SLS,R3   24                SAVE THE NPS SIZE
         OR,R4    R3                BUILD A CBS WORD
         STW,R4   LNNPS             USE IT AS A COMPARE BASE
         LI,R5    BA(WBF1)          TEMP FOR PRINTING NPS
         OR,R5    R3                SIZE
         MBS,R4   0
         M:PRINT  (MESS,LNMSG)      TELL HIM NPS
         LW,R2    R3                GET SIZE
         SLS,R2   -24
         LI,R3    WBF1              BUFFER LOCATION
         BAL,R1   CUPT              PRINT NPS OUT
         M:PFIL   F:STAX,(BOF)      REWIND STAX FILE
         B        LNFIRST
LNLOOP   M:READ   F:STAX,(WAIT),(KEY,LNKEY)
LNFIRST  M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),;
                  (ABN,LNBS)
         LI,R1    0                 SET NO REPOSTION SWITCH
         STW,R1   LASW
         LW,R3    F:STAX+4          GET SIZE
         SLS,R3   -17
         STW,R3   LNR1              SAVE JUST READ SIZE
         LI,R1    WBF1              STARTING LOC OF JUST READ
         LI,R2    0                 READ BUFFER CHAR 0
LNCMP    LW,R4    R1                NOW DO COMPARES START AT
         SLS,R4   2                 SET UP TO DO A COMPARE
         AW,R4    R2
         LW,R5    LNNPS             GET PREBUILT BASE
         CBS,R4   0
         BE       LNPRNT            GOT A HIT
LNCNTR   LB,R15   *R1,R2            SEARCH FOR A BLANK
         AI,R2    1
         CI,R15   C' '
         BE       LNCMP             GOT A NPS
         CW,R2    LNR1              ARE WE DONE WITH THIS STN
         BG       LNFIRST           IF SO READ ANOTHER RECORD
         B        LNCNTR            KEEP SPINNING
LNPRNT   EQU      %                 PRINT OUT JUST READ STN
         LW,R1    EXFL              SEE IF EXPANSION WANTED
         BEZ      LNRAW             NOPE RAW
         LI,R2    CONSNZ            SAVE CURRENT KEY
         SLS,R2   24                INCASE WE HAVE TO REPOSITION
         LI,R3    BA(LNKEY)+1
         OR,R3    R2                SIZE
         LI,R2    BA(WBF1)          KEY LOCATION
         MBS,R2   0                 MOVE THE KEY
         M:PRINT  (MESS,LNEXMS)
         LW,R1    LNR1              GET SIZE FOR EXPAND
         STW,R1   WBCE              ENDING LOCATION
         BAL,R1   CEGO              GO EXPANSION
         LW,R2    WBCE              GET SIZE
         LI,R3    INBF              AND LOCATION FROM EXPAND
         BAL,R1   CUPT              PRINT OUT IMAGE
         LW,R1    LASW              ANY NEED TO REPOSITION
         BNEZ     LNLOOP            MUST REPOSITION STAX
         B        LNFIRST           JUST CONTINUE
LNRAW    EQU      %                 RAW LISTING
         LW,R2    LNR1              SIZE OF RECORD
         LI,R3    WBF1              ADDRES
         BAL,R1   CUPT              GO PRINT IT
         B        LNFIRST           NO NEED TO REPOSITION
LN1      RES      1                 CURRENT BUF LOCATIONN
LN2      RES      1                 ITS BYTE LOCATION
LNNPS    RES      1                 COMPARE NPS KEY
LNMSG    TEXTC    C'.....NPS IS'
LNEXMS   TEXTC    C'.....EXPANDED NPS'
LNR1     RES      1                 SIZE OF JUST READ STN RCD
LNKEY    GEN,8,24 CONSNZ,0
         RES      3
SU       EQU      %                 SUBTRACT AN NPS FROM NAMED OR
         LW,R1    DRC1              ENTIRE FILE
         SLS,R1   -2                GET WORD ADDRESS OF INPUT
         STW,R1   SU1               CARDS
         LW,R2    DRC1              AND ALSO BYTE OFFSET
         AND,R2   =X'3'
         STW,R2   SU2               ALSO SAVE THE OFFSET
         AWM,R2   CIPT              FOR END CHAR CMPR
         LI,R3    0                 COUNTER
         LB,R15   *R1,R2            START SEEING HOW LARGE THE
         LI,R5    SUE1              NPS IS AFTER VERIFYING
         BAL,R6   CUNPS             ITS CORRECTNESS
         CI,R15   C'Y'              CHECK FOR A Y NPS
         BE       SUYQ              CHECK FOR THE QUOTE
SULP     AI,R2    1                 NOW COUNT CHARACTERS
         AI,R3    1
         CW,R2    CIPT              ARE THERE ANY STNS SPECIFIED
         BGE      SUNOST            IF NOT SUBTRACT FROM ENTIRE
         LB,R15   *R1,R2
         CI,R15   C' '              BLANK TERMINATES
         BE       SUOK
         B        SULP              KEEP COMPARING
SUYQ     EQU      %                 CHECK THE Y NPS AND QUOTE
         LI,R6    0                 SET CHECK NO CHECK SWITCH
         AI,R2    1
         AI,R3    1
         LB,R15   *R1,R2            CHECK THE QUOTE STRING
         CI,R15   X'7D'             QUOTE CHECK
         EXU      SUSWQ,R6
         LI,R6    1
         B        SUYQ+1
SUSWQ    BNE      SUE1              ERROR IF NO QUOTE AFTER Y
         BE       SUQOK             ALL DONE
SUQOK    AI,R2    1
         AI,R3    1
         CW,R2    CIPT              SEE IF ITS FROM ENTIRE FILE
         BGE      SUNOST            YES ENTIRE FILE
         LB,R15   *R1,R2            CHECK FOR TRAILING BLANK
         CI,R15   C' '
         BNE      SUE1              ERROR IF NOT
         B        SUOK
SUOK     EQU      %                 PREBUILD NPS FOR LATER
         AI,R3    1                 ALSO COMPARE A BLANK
         SLS,R3   24
         OR,R3    DRC1              COMPARES
         STW,R3   SUSVN             SAVE IT
         LI,R1    SUNEXT            COME HERE AFTER EACH
         STW,R1   SU1LNK            STATION IS DONE
         STW,R2   SU2               SAVE OUR POSITION
         STW,R2   SUWS              SET NO FIND SWITCH
SUNEXT   EQU      %                 LOOP AREAD FOR STATIONS
         LW,R1    SUWS              CHECK IF WE WAN A NO FIND MSG
         BNEZ     SUNEX1            FOUND HIT OR FIRST TIME
         M:PRINT  (MESS,NOFIND)
SUNEX1   EQU      %
         LW,R1    SU1               RESET X R 1
         LW,R2    SU2               AND 2
         CW,R2    CIPT              SEE IF WE ARE DONE
         BGE      DRIVER            ALL DONE
         LW,R3    KEYINT            BUILD A STATION KEY
         STW,R3   SUKEY             BLANK IT OUT FIRST
         LW,R3    =C'    '
         STW,R3   SUKEY+1
         STW,R3   SUKEY+2
         LI,R3    1
SUBKEY   AI,R2    1
         LB,R15   *R1,R2            BUILDING KEY
         CI,R15   C' '              BLANK TERMINATES
         BE       SUKDN             ALL DONE
         CI,R15   C'.'              A PERIOD ALSO DOES
         BE       SUKDN
         STB,R15  SUKEY,R3
         AI,R3    1
         CI,R3    CONSNZ            BE SURE  KEY IS NOT TOO BIG
         BE       CE12              IF SO ERROR
         CW,R2    CIPT
         BG       SUKDN             ALL DONE IF LAST ONE
         B        SUBKEY
SUKDN    EQU      %                 GET READY TO READ IT
         STW,R2   SU2               SAVE POSTION FOR NEXT READ
         LW,R2    SUKEY             IF ANYTHING TO BE READ
         CW,R2    KEYINT
         BE       DRIVER            NOTHING TO BE READ
         M:SETDCB F:STAX,(ERR,CE12) IF NONE ERROR
         M:READ   F:STAX,(BUF,WBF1),(KEY,SUKEY),(WAIT),;
                  (SIZE,ID)
SUALL    LI,R1    0                 DELETE ALL ALSO COMES HERE
         STW,R1   SUWS              RE-WRITE/NO RE-WRITE SWITCH
         LI,R1    WBF1              COMMON READ BUFFER
         LI,R2    CONSNZ+2          SKIP PAST THE STN-NAME
         LW,R3    F:STAX+4          SIZE OF RECORD
         SLS,R3   -17
         STW,R3   SUCNT             SAVE IT FOR WRITE
SUCM     LB,R15   *R1,R2            NOW SEARCH FOR MATCHING NPS
         AI,R2    1
         CW,R2    SUCNT             ARE WE DONE
         BGE      SUWRT             IF SO SEE IF WE WANT TO WRITE
         CI,R15   C' '
         BNE      SUCM
         LW,R4    R1
         SLS,R4   2                 SEE IF IT MATCHES
         AW,R4    R2                POSITION
         STW,R4   SUCMP4            IN CASE WE GET A HIT
         LW,R5    SUSVN             PRE-BUILT NPS
         LW,R3    R5                CHECK FOR ENOUGH CHARACTERS
         SLS,R3   -24
         LW,R7    SUCNT             CHECK BY SUB CURRENT FROM
         SW,R7    R2                TOTAL SIZE
         CW,R3    R7
         BLE      SUOKC             YES WE ARE NOT ON LAST NPS
         AI,R3    -1                SEE IF WE WANT TO CMP LAST
         CW,R3    R7
         BG       SUWRT             NOT ENOUGH
         AW,R5    =-X'01000000'
SUOKC    EQU      %                 BLANK
         CBS,R4   0
         BNE      SUCM              NOPE NO HIT
         STW,R2   SU2A              SAVE OUR CURRENT POSITION
         LW,R1    SUWS              DO WE WANT TO PRINT OLD
         BNEZ     SUNOOL            NOPE ALREADY DONE
         M:PRINT  (MESS,SUOLD)
         LI,R3    WBF1              BUFFER LOCATION
         LW,R2    SUCNT             SIZE
         BAL,R1   CUPT              GO PRINT IT
SUNOOL   LW,R6    SUSVN             GET NPS SIZE
         STW,R6   SUWS              THIS JUST SETS REWRITE SW
         SLS,R6   -24               NOW DO SIZE TRICK
         LW,R7    SUCNT             SUB OFF THE NPS SIZE
         SW,R7    R6
         STW,R7   SUCNT             NOW ITS SMALLER
         SW,R7    R2                SEE HOW MUCH WE HAVE LEFT
         SLS,R7   24
         LW,R5    SUCMP4            MOVE TO ADDRESS
         OR,R5    R7
         MBS,R4   0                 X 4 IS AT THE END OF THE
         LW,R2    SU2A              RESTORE X R 2
         AI,R2    -1                BACKUP ONE POSITION
         LI,R1    WBF1
         B        SUCM              DELETED NPS
SUWRT    EQU      %                 POSSIBLE WRITE RTN
         LW,R1    SUWS              WRITE SWITCH
         BEZ      *SU1LNK           RETURN TO CORRECT CALLER
         M:SETDCB F:STAX,(ABN,CE3),(ERR,CE3)
         M:WRITE  F:STAX,(BUF,WBF1),(WAIT),(KEY,SUKEY),;
                  (SIZE,*SUCNT)
         M:PRINT  (MESS,SUNEW)
         LW,R2    SUCNT
         LI,R3    WBF1              NOW DISPLAY IT TO USER
         BAL,R1   CUPT
         B        *SU1LNK           RETURN TO CORRECT CALLER
SUNOST   EQU      %                 DELETE NPS FROM ENTIRE FILE
         AI,R3    1                 ALSO COMPARE A BLANK
         SLS,R3   24                PRE BUILD NPS
         OR,R3    DRC1
         STW,R3   SUSVN             SAVE IT
         LI,R15   C' '              THIS BLANKS OUT THE PERIOD
         STB,R15  *R1,R2            FOR STRING-BLANK BASE
         LI,R3    SUALL1            THIS SPINS THRU READ
         STW,R3   SU1LNK
         M:PRINT  (MESS,SUALMS)
         M:PFIL   F:STAX,(BOF)
SUALL1   M:READ   F:STAX,(BUF,WBF1),(WAIT),(SIZE,ID),;
                  (ABN,DRIVER)
         LI,R4    CONSNZ            BUILD A KEY
         SLS,R4   24
         STW,R4   KEY               KEY SIZE
         LI,R2    BA(WBF1)          KEY LOCATION
         LI,R3    BA(SUKEY)+1
         OR,R3    R4                KEY SIZE
         MBS,R2   0
         B        SUALL             COMMON COMPARE RTN
SUE1     M:PRINT  (MESS,CE55)       BAD NPS
         B        DRIVER
SUALMS   TEXTC    C'.....SUBTRACT NAMED NPS FROM ENTIRE FILE'
NOFIND   TEXTC    C'.....NPS NOT FOUND IN STATION RECORD'
         B        DRIVER
SU1      RES      1                 BEGINNING OF GIVEN NPS
SU2      RES      1                 ITS OFFSET
SU2A     RES      1                 POSITION AFTER A HIT
SUSVN    RES      1                 PRE BUILD NPS LOCATION
SU1LNK   RES      1                 RETURN  LINKAGE
SUKEY    GEN,8,24 CONSNZ,0          KEY FOR STN-NAMES
         RES      3
SUCNT    RES      1                 COUNT FOR JUST READ STN-RCD
SUWS     RES      1                 WRITE AND OLD PRINT SWITCH
SUCMP4   RES      1                 USED FOR SQUEEZE DELETING
SUOLD    TEXTC    C'.....OLD STATION RECORD'
SUNEW    TEXTC    C'.....NEW STATION RECORD'
RDCHK    DATA     0                 RMC 3-14-74
CICARD   EQU      %
         LI,R6    0                 SET QUOTE SWITCH
         STW,R1   CISV1             SAVE RETURN LINKAGE
         LW,R2    CONBLN            BLANK OUT INPUT BUFFER
         STW,R2   BUFCD
         LI,R2    BA(BUFCD)
         LI,R3    BA(BUFCD)+1
         OR,R3    =X'47000000'      ABOUT 80 CHARACTERS
         MBS,R2   0
         LI,R3    0                 INITILIZE WORK BUFFER COUNTE
         LI,R5    0                 SET BLANK SQUEEZE SWITCH
CIRDLP   M:READ   M:SI,(BUF,BUFCD),(SIZE,80),(WAIT),;
         (ABN,PAU)
         LW,R1    M:SI+4            GET JUST READ CHARACTERS
         SLS,R1   -17
         CI,R1    71                ONLY ALLOW 71 CHARACTERS
         BL       %+2
         LI,R1    72
         LW,R2    BUFCD             GET LAST INPUTTED CHAR
         AND,R2   =X'FFFFFF00'      GET RID OF LAST CHARACTER
         CW,R2    =X'C5D5C400'      CHECK FOR AN END CARD
         BE       PAUALL            ALL DONE WITH THIS RUN
STNSW    LW,R2    NEVER
         STW,R2   STNSW             DO IT ONLY ONCE
         LW,R2    BUFCD
         CW,R2    STNCD
         BE       CIRDLP
STNSWN   EQU      %
         LI,R2    1
         STW,R2   RDCHK   TP-0513 RMC 3014074 SET READING FLAG
         AI,R1    -1                GET RID OF CR
         LB,R15   BUFCD,R1          CHECK FOR SI FILE
         CI,R15   X'40'
         BL       %+2
         AI,R1    1
         STW,R1   CILF              JUST READ CHAR CNT
         LI,R2    -1                CHAR COUNTER
         CI,R6    X'7D'             SEE IF WE ARE IN A QUOTE STRING
         BE       QTLP1             YES SO RETURN THERE
CINX     AI,R2    1                 JUST GOT READ
         CW,R2    CILF              IS THERE MORE
         BGE      CIRDLP            READ ANOTHER IMAGE
         LB,R15   BUFCD,R2          GET A CHARACTER
         CI,R15   X'7D'             CHECK FOR QUOTE
         BNE      NOQTS             NOT QUOTE
         LI,R6    X'7D'             SET QUOTE FLAG
QTLP     STB,R15  WBF1,R3           BUILD QUOTE STRING
         AI,R3    1
         CI,R3    ID                CHECK FULL SIZE
         BGE      CE1
QTLP1    AI,R2    1
         CW,R2    CILF              SEE HOW MUCH IS LEFT
         BGE      CIRDLP            READ ANOTHER IMAGE
         LB,R15   BUFCD,R2
         CI,R15   X'7D'             CHECK FOR A QUOTE
         BNE      QTLP              STILL IN QUOTE STRING
         LI,R6    0                 FINISHED
         B        CIQT
NOQTS    EQU      %                 NO QUOTE STRING
         CI,R15   C' '              CHECK FOR A BLANK
         BE       CIBL              GOT A BLANK
         LI,R5    0                 ALWAYS KEEP NON BLANKS
         CI,R15   C'.'              CHECK FOR ALL DONE
         BE       CIDONE            DONE
         CI,R15   C';'              CARD CONTINUATION
         BE       CIRDLP            READ ANTOHER IMAGE
CIQT     STB,R15  WBF1,R3           STORE CHAR AWAY(ALWAYS FOR ')
         AI,R3    1
CISTB1   CI,R3    ID                SEE IF WE JUST FILLED BUF
         BGE      CE1               BUFFER FULL
         B        CINX
CISTB    STB,R15  WBF1,R3           KEEP FIRST BLANK
         NOP
CIAD     AI,R3    1
         NOP
CIBL     EQU     %                  DELETE BLANK FLAG
         EXU      CISTB,R5
         EXU      CIAD,R5
         LI,R5    1
         B        CISTB1            GET NEXT CHARACTER
CIDONE   EQU      %                 SAVE CHAR COUNT
         AI,R3    -1                CHECK FOR A SPACE BEFOR A PERIOD
         LB,R15   WBF1,R3           GET LAST READ CHARACTER
         CI,R15   C' '
         BE       %+2               YES PERIOD SO DECREMENTED COUNT
         AI,R3    1                 BUMP IT BACK UP
         STW,R3   CIPT
         LI,R5    BA(BUFCD)         MOVE THE WHOLE THING BACK
         LI,R4    BA(WBF1)          CONFLICT
         LI,R2    0
CHKCOUNT CW,R3    XFF               X'FF' IS MAXIMUM BYTE COUNT ALLOWED
         BLE      OK                IN MBS RU1
         SW,R3    XFF
         STW,R3   BALBYTE           SAVE BALANCE OF BYTE COUNT > X'FF'
         LW,R3    XFF
         B        %+2
OK       STW,R2   BALBYTE           INSURE THAT BALANCE IS SET TO ZERO
         STB,R3   R5                R5 CONTAINS COUNT AND DEST. BYTE
         MBS,R4   0                 STRING.  R4 = SOURCE BYTE STRING
         MTW,0    BALBYTE           SEE IF THRU WITH MOVE
         BEZ      CONTINU           BRANCH IF SO
         LW,R3    BALBYTE           NO. THEN LOAD IN REMAINING COUNT
         B        CHKCOUNT          AND GO MOVE SOME MORE
CONTINU  EQU      %
         MBS,R4   0
         MTW,-1   RDCHK             UNSET READING FLAG
         LW,R2    CIPT              GET SIZE
         LI,R3    WA(BUFCD)
         BAL,R1   CUPT              PRINT JUST READ IMAGE
         B        *CISV1            RETURN TO CALLER
CUPT     EQU      %                 GENERAL PRINT RTN
         LCI      3
         PSM,R1   TSTACK            SAVE R1, R2, R3
         LW,R1    R2
         CI,R2    120               SIZE OF OUTPUT LINE
         BLE      WRITE
         LI,R2    120
WRITE    M:WRITE  M:LO,(BUF,*R3),(WAIT),(SIZE,*R2)
         SW,R1    R2
         BLEZ     PULLEM
         AI,R3    30                STEP UP BUFFER POINTER
         CI,R1    120
         BGE      WRITE             BRANCH IF STILL MORE DATA
         LW,R2    R1                OTHERWISE LOAD R2 WITH REMAINDER
         B        WRITE
PULLEM   LCI      3
         PLM,R1   TSTACK
         B        *R1               X3=LOC,X2=SIZE,X1=LINKAGE
CE1      M:PRINT  (MESS,CE11)
         B        DRIVER
CE11     TEXTC    C'*****INTERNAL BUFFER FULL'
CE2      M:PRINT  (MESS,CE22)
         B        DRIVER
CE22     TEXTC    C'*****INVALID DIRECTIVE SPECIFIED'
CE3      EQU      %                 COMMON ERROR ROUTINE
         LW,R1    R10               CHECK ERROR TYPE
         SLS,R1   -24
         CI,R1    3                 CHECK IF FILE IS DEFINED
         BNE      WINDUP            JUST STOP RUN
         M:OPEN   F:STAX,(OUTIN),(SAVE),(KEYED),(KEYM,CONSNZ)
         M:CLOSE  F:STAX,SAVE
         B        STNUTL            NOW CONTINUE
WINDUP   EQU      %
         M:PRINT  (MESS,CE33)
         B        PAU
CE33     TEXTC    C'*****F:STAX FILE ERROR'
PAU      EQU      %                 WIND-UP THE UTILITY
         M:SETDCB F:STAX,(ABN,PAUALL),(ERR,PAUALL)
         M:CLOSE  F:STAX,SAVE
         MTW,0    RDCHK             SEE IF WE WERE READING
         BE       PAUALL            NOPE SO ALL DONE
         M:PRINT (MESS,CE99)        TELL HIM OF ERROR
         LW,R2    R3                GET SIZE
         LI,R3    WA(WBF1)          BUFFER LOCATION
         BAL,R1   CUPT              PRINT IT OUT
PAUALL   EQU      %
         M:EXIT
NEVER    B        STNSWN
STNCD    TEXT     C' STNUT'
BALBYTE  DATA     0
XFF      DATA     X'FF'
         BOUND    8
TSTACK   DATA     0,0               TEMP STACK DOUBLEWORD
PATCH    RES      25
CE99     TEXTC    C'*****UNEXPECTED END OF FILE REACHED ON INPUT'
         END      STNUTL

