Retro1.org codex

          IDENT  VFYLIB,FETS,VFYLIB
          ABS
          ENTRY  VFYLIB
          ENTRY  MFL=
          ENTRY  SSM=
          SYSCOM B1
 VFYLIB   TITLE  VFYLIB - VERIFY LIBRARY FILES.
*COMMENT  VFYLIB - VERIFY LIBRARY FILES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 VFYLIB   SPACE  4,10
***       VFYLIB - VERIFY LIBRARY FILES.
*         D. A. CAHLANDER.   69/02/16.
*         P. D. HAAS.        73/10/10.
*         A. D. FORET.       75/02/10.
          SPACE  4
***       VFYLIB COMPARES TWO LIBRARY FILES.  REPLACEMENTS, DELETIONS,
*         INSERTIONS, AND CHANGES IN RESIDENCE ARE RECORDED ON FILE
*         *OUTPUT*.
          SPACE  4
***       COMMAND.
*
*                VFYLIB(OLD,NEW,OUTPUT,NR)
*
*                OLD = OLD LIBRARY FILE (*OLD* ASSUMED).
*                NEW = NEW LIBRARY FILE (*NEW* ASSUMED).
*                OUTPUT = OUTPUT FILE (*OUTPUT* ASSUMED).
*                NR, IF SPECIFIED, OLD AND NEW ARE NOT REWOUND.
          SPACE  4,20
***       DAYFILE MESSAGES.
*
*         * FWA/LWA ERROR IN VFYLIB. * - FWA OF PROGRAM TEXT
*           IS LESS THAN THE LWA + 1 OF PROGRAM TEXT.
*
*         * UNKNOWN DEVICE TYPE -- LFN = XX. * - DISPLAYS UNKNOWN
*           DEVICE TYPE.
*
*         * TABLE OVERFLOW. JOB ABORTED. * - INSUFFICIENT FIELD LENGTH.
*
*         * VERIFY GOOD. * - THE TWO FILES VERIFIED GOOD.
*
*         * VFYLIB COMPLETE. * - NORMAL TERMINATION MESSAGE.  THE
*           DIFFERENCES BETWEEN *OLD* AND *NEW* FILES ARE LISTED
*           ON THE OUTPUT FILE SPECIFIED.
*
*         * XXXXXX FIELD LENGTH REQUIRED. * - FIELD LENGTH REQUIRED.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 OLDL     EQU    30061B      *OLD* BUFFER LENGTH
 NEWL     EQU    30061B      *NEW* BUFFER LENGTH
 ENTL     EQU    5           NUMBER OF WORDS/ENTRY IN *OPT* AND *NPT*
 OUTL     EQU    2010B       *OUTPUT* BUFFER LENGTH
 MINBL    EQU    4000B       MINIMUM BUFFER LENGTH
 MINC     EQU    1000B       MEMORY REQUEST INCREMENT
 ODEBL    EQU    16          LENGTH OF OD FET EXTENSION
****
 
 
*         SPECIAL ENTRY POINT.
 
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH
          SPACE  4,10
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSSRT
          TITLE  TABLE STRUCTURE.
**        TABLE STRUCTURE.
*         ALL TABLES ARE VARIABLE LENGTH MANAGED TABLES.  POINTERS
*         TO TABLE ABC ARE:
*                P.ABC = FWA OF TABLE ABC.
*                L.ABC = LENGTH OF TABLE ABC.
*                N.ABC = NUMBER OF WORDS/ENTRY.
*                D.ABC = NUMBER OF WORDS THE LENGTH OF TABLE IS
*                        INCREASED IF TABLE IS FULL.
*
*         OPT - OLD PROGRAM TABLE.
*
*                42/PROGRAM,12/LIB,6/TYPE
*                12/CHECKSUM,18/0,30/INDEX
*                60/ULIB
*                60/DATE
*                  1. PROGRAM = PROGRAM NAME LEFT JUSTIFIED.
*                  2. LIB = LIBRARY NUMBER.
*                  3. TYPE = PROGRAM TYPE FROM *COMCSRT*.
*                  4. CHECKSUM = CHECKSUM OF PROGRAM TEXT.
*                  5. INDEX = INDEX TO COMMENT TABLE.
*                  6. ULIB = ULIB NAME.
*                  7. DATE = DATE FROM 7700 TABLE.
*
*         NPT - NEW PROGRAM TABLE.
*
*                FORMAT THE SAME AS OLD PROGRAM TABLE.
*
*         CMT - COMMENT TABLE.
*
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                       ..
*                48/COMMENT TEXT,12/0
          TITLE  MACRO DEFINITIONS.
**        CALL - SUBROUTINE CALL.
*
*         THIS MACRO SETS UP A STANDARD CALLING SEQUENCE.
*
*         CALL   SUB,P1,P2,P3,P4,P5,P6
*
*         ENTRY  SUB = SUBROUTINE NAME.
*                PI = ADDRESS OF I-TH PARAMETER.
*         PARAMETER ADDRESSES ARE PASSED IN B-REGISTERS (AS IN FORTRAN)
*         WITH THE FIRST PARAMETER ADDRESS IN B2, SECOND IN B3, ETC.
 
 
 CALL     MACRO  SUB,P1,P2,P3,P4,P5,P6
          IFC    NE,$P1$$,1
          R=     B2,P1
          IFC    NE,$P2$$,1
          R=     B3,P2
          IFC    NE,$P3$$,1
          R=     B4,P3
          IFC    NE,$P4$$,1
          R=     B5,P4
          IFC    NE,$P5$$,1
          R=     B6,P5
          IFC    NE,$P6$$,1
          R=     B7,P6
          ENDIF
          RJ     SUB
          ENDM
          SPACE  4
**        TABLE - DEFINE MANAGED TABLE POINTERS.
*
*         MANAGED TABLES HAVE 4 POINTERS ASSOCIATED WITH THEM:
*         (P.NAME) = FWA OF MANAGED TABLE.
*         (L.NAME) = LENGTH OF MANAGED TABLE.
*         (N.NAME) = NUMBER OF WORDS IN AN ENTRY.
*         (D.NAME) = NUMBER OF WORDS THE LENGTH OF TABLE IS
*                    INCREASED IF TABLE IS FULL.
*
*         TABLE  NAME,WORD,DELTA
*
*         ENTRY  NAME = NAME OF TABLE.
*                WORD = NUMBER OF WORDS/ENTRY.
*                DELTA = SIZE OF TABLE INCREASE (NUMBER OF ENTRIES).
 
 
 TABLE    MACRO  NAME,WORD,DELTA
          LOCAL  NW,DW
 NW       SET    WORD   1
 DW       SET    DELTA  4
 P.NAME   VFD    42D/0L_NAME,18D/BUF
 L.NAME   VFD    60D/0
 N.NAME   VFD    60D/NW
 D.NAME   VFD    60D/NW*DW
          ENDM
          SPACE  4
**        SEARCH - SEARCH FOR ENTRY IN MANAGED TABLE.
*
*         THIS MACRO SETS UP A CALL TO SEARCH FOR AN ENTRY
*         IN A MANAGED TABLE.
*
*         SEARCH TABLE,ENTRY,MASK,INDEX,RETURN
*
*         ENTRY  TABLE = NAME OF MANAGED TABLE.
*                ENTRY = ADDRESS OF ENTRY.
*                MASK = ADDRESS OF SEARCH MASK.
*                INDEX = INDEX INTO TABLE.
*                RETURN = ADDRESS OF RETURN PARAMETER.
 
 
 SEARCH   MACRO TABLE,ENTRY,MASK,INDEX,RETURN
          SB2    P.TABLE
          SB3    ENTRY
          SB4    MASK   =77777777777777777777B
          SB5    INDEX  B0
          SB6    RETURN SMTA
          RJ     SMT
          ENDM
 READW    SPACE  4
**        READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS.
 
 
          PURGMAC READW
 
 READW    MACRO F,S,N
          R=     B6,S
          R=     B7,N
          R=     X2,F
          RJ     RDA
          ENDM
          TITLE  FETS AND TEMPORARY STORAGE.
 FETS     SPACE  4,10
**        FETS.
 
 
          ORG    104B
 FETS     BSS    0
 
          CON    -0
          CON    0
 OLD      FILEB  OLDB,OLDL,(FET=10)
          ORG    OLD+11B
          VFD    36/,6/ODEBL,18/OODEB POINTER TO *OD* EXT. BUFFER
          ORG    OLD+10
 
          CON    -0
          CON    0
 NEW      FILEB  NEWB,NEWL,(FET=10)
          ORG    NEW+11B
          VFD    36/,6/ODEBL,18/NODEB POINTER TO *OD* EXT. BUFFER
          ORG    NEW+10
 
 O        BSS    0
 OUTPUT   FILEC  OUTB,OUTL,(FET=8)
 TEMP     SPACE  4,10
*         OPTICAL DISK EXTENSION BUFFERS.
 
 OODEB    BSSZ   ODEBL       *OLD*
 NODEB    BSSZ   ODEBL       *NEW*
**        TEMPORARY STORAGE.
 
 
 CREW     CON    0           CLEAR REWIND FLAG
 LINE     CON    99999,0     LINE NUMBER COUNT
 LL       EQU    LINE+1      LINE LIMIT - PAGE SIZE
 PD       CON    0,0         PRINT DENSITY FORMAT CONTROL
 TF       EQU    PD+1        TERMINAL FILE FLAG
 PNUM     CON    0           PAGE NUMBER
 CFL      CON    0           CURRENT FIELD LENGTH
 MFL      VFD    30/-0,30/0  MAXIMUM FIELD LENGTH
          TITLE  MAIN PROGRAM.
**        VFYLIB - VERIFY LIBRARY FILES.
*
*         ENTRY  (ACTR) - ARGUMENT COUNT.
*                1. FILE *OLD* AND *NEW* ARE READ TO CREATE DICTIONARY.
*                2. REPLACEMENTS AND COPIES ARE CHECKED.
*                3. RESIDENCE CHANGES ARE FOUND.
*                4. DELETIONS ARE FOUND.
*                5. INSERTIONS ARE FOUND.
*
*         USES   A - 1, 2, 6.
*                B - 6.
*                X - 0, 1, 2, 3, 6.
*
*         CALLS  ARG, CDP, COD, CRC, CRP, PRS, RDF.
*
*         MACROS CALL, ENDRUN, MESSAGE, REWIND, WRITER.
 
 
 VFYLIB   BSS    0           ENTRY
          SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     ARG         PROCESS ARGUMENTS
          RJ     RDF         READ FILES
          SX6    VFYA
          SA6    OPND
          RJ     CRP         CHECK REPLACED PROGRAMS
          SX6    VFYB
          SA6    OPND
          RJ     CRC         CHECK RESIDENCE CHANGES
          SX6    VFYC
          SA6    OPND
          CALL   CDP,(P.OPT) CHECK DELETED PROGRAMS
          SX6    VFYD
          SA6    OPND
          CALL   CDP,(P.NPT) CHECK INSERTED PROGRAMS
 
*         END PROGRAM.
 
          SA1    P.BUF       ISSUE F.L. MESSAGE
          MX0    -18
          BX1    -X0*X1
          RJ     COD
          SA2    VFYE
          MX1    6*6         BUILD FL REQUIRED MESSAGE
          BX3    X1*X4
          BX6    -X1*X2
          BX6    X6+X3
          SA6    A2
          MESSAGE A6,3       FL REQUIRED
          SA1    PNUM        CHECK FOR PAGE NUMBER
          SX0    =C* VERIFY GOOD.*
          ZR     X1,VFY2     IF NO PAGE NUMBER DETECTED
          SX0    =C* VFYLIB COMPLETE.*
          WRITER OUTPUT
 VFY2     SA1    CREW
          NZ     X1,VFY3     IF NO REWIND FLAG SET
          REWIND OLD
          REWIND NEW
 VFY3     MESSAGE X0+
          ENDRUN
 
 VFYA     DATA   C*      RECORDS REPLACED.*
 
 VFYB     DATA   C*      CHANGES IN RESIDENCE.*
 
 VFYC     DATA   C*      DELETED RECORDS.*
 
 VFYD     DATA   C*      INSERTED RECORDS.*
 
 VFYE     DATA   C*NNNNNN FIELD LENGTH REQUIRED.*
          TITLE  SUBROUTINES.
**        ABT - ABORT JOB.
*
*         ENTRY  (X1) = ADDRESS OF MESSAGE.
*
*         USES   A - 1, 2.
*                X - 1, 2, 6.
*
*         MACROS ABORT, MESSAGE, WRITER.
 
 
 ABT      SUBR               ENTRY/EXIT
          MESSAGE X1         ISSUE ERROR MESSAGE
          SA1    OUTPUT+2    CLOSE OUT FILE *OUTPUT*
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,ABT1     IF NO OUTPUT
          WRITER OUTPUT
 ABT1     ABORT
          SPACE  4
**        ADD - ADD WORD(S) TO MANAGED TABLE.
*
*         ENTRY  (B2) = ADDRESS OF TABLE POINTER.
*                (B3) = FWA OF ENTRY.
*
*         USES   A - 1, 2, 3, 4, 5, 7.
*                B - 4, 5, 6, 7.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ABT.
*
*         MACROS MEMORY.
 
 
 ADD      SUBR               ENTRY/EXIT
 ADD1     SA1    B2          SET TABLE ADDRESS
          SA2    B2+B1
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          IX7    X2+X3
          IX7    X7-X5
          SB6    X1
          SX6    B6+X7
          PL     X6,ADD3     IF NO ROOM FOR ENTRY
          SA1    B3          STORE ENTRY
 ADD2     BX7    X1
          SA7    B6+X2
          SX2    X2+B1
          SA1    A1+B1
          SX3    X3-1
          NZ     X3,ADD2     LOOP FOR ENTIRE ENTRY
          BX7    X2
          SA7    A2
          EQ     ADDX        RETURN
 
*         NO ROOM FOR ENTRY.  MOVE OTHER TABLES UP TO MAKE ROOM FOR
*         ENTRY.
 
 ADD3     SA1    P.BUF
          SA2    L.BUF
          IX6    X2-X4
          PL     X6,ADD4     IF ENOUGH FL
          SA1    CFL         INCREMENT CURRENT FIELD LENGTH
          SA3    MFL         FIELD LENGTH LIMIT
          SX6    X1+MINC     NEW FIELD LENGTH
          SX7    X2+MINC     NEW LENGTH
          AX3    30
          SA6    A1
          SA7    A2+
          IX3    X3-X6
          NG     X3,ADD8     IF INSUFFICIENT FIELD LENGTH
          BX1    X6
          MEMORY CM,,R,X1
          EQ     ADD1        RESTART ALLOCATION
 
 ADD4     SB5    X1          (B5) = LWA OF MOVE
          SB6    X5          (B6) = FWA OF MOVE
          SA6    A2
          SB4    A1
 ADD5     SA1    B4          INCREMENT TABLE POINTERS
          SB4    B4-4
          IX7    X1+X4
          SA7    A1
          NE     B4,B2,ADD5  LOOP
          SA2    B5
          EQ     B5,B6,ADD1  JUMP IF NO DATA TO MOVE
          SB7    X4+
 ADD6     SA1    A2-B1       MOVE TABLES
          SA2    A1-B1
          SB5    B5-2
          BX6    X1
          LX7    X2
          SA6    A1+B7
          SA7    A2+B7
          NE     B5,B6,ADD6
          SX7    B0          CLEAR NEW AREA
          SB7    B6+B7
 ADD7     SA7    B6
          SB6    B6+B1
          NE     B6,B7,ADD7  IF NOT END OF CLEAR
          EQ     ADD1        MAKE ENTRY
 
 ADD8     SX1    =C*TABLE OVERFLOW. JOB ABORTED.*
          RJ     ABT         ABORT
          SPACE  4
**        ARG - PROCESS ARGUMENTS ON CONTROL CARD.
*
*         USES   A - 1, 2, 3, 4, 6.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 4, 6.
*
*         CALLS  CDT, SFN, STF.
*
*         MACROS CALL, OPEN, READCW, RECALL, REWIND, WRITEW.
 
 
 ARG      SUBR               ENTRY/EXIT
          SA1    ACTR        SET ARGUMENT COUNT
          MX0    42
          SB7    X1
          SA1    ARGR
          SA2    ARGA        SET LIST OF OPTIONS
 ARG1     ZR     B7,ARG3     IF END OF ARGUMENTS
          BX6    X0*X1
          SA3    X2
          SB7    B7-B1
          BX3    -X0*X3
          ZR     X6,ARG2     IF NO FILE NAME
          BX6    X6+X3
          SA6    X2
 ARG2     SA1    A1+B1       READ NEXT PARAMETER
          SA2    A2+B1
          NZ     X2,ARG1     LOOP FOR NEXT PARAMETER
 
*         SET TERMINAL FLAG.
 
 ARG3     SX2    O
          RJ     STF         SET TERMINAL FILE
          SA6    TF
          WRITEW O,A6-B1,X6  CONDITIONALLY WRITE FORMAT EFFECTOR
 
*         STORE FET POINTERS STARTING AT RA+2.
 
          SA1    ARGA        SET FET LIST
          SB6    ARGR
 ARG4     SA2    X1
          BX6    X0*X2
          BX6    X6+X1
          SA6    B6
          SB6    B6+B1
          SA1    A1+B1
          NZ     X1,ARG4     LOOP FOR ALL FILES
          SX6    B0          TERMINATE LIST
          SA6    B6
 
*         SET FILE NAMES IN TITLE.
 
          SA2    OLD
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          SX1    1RN&1R
          SA2    NEW
          BX6    X6-X1
          SA6    WPHB+3
          BX1    X0*X2
          SA4    CREW
          RJ     SFN
          SA6    WPHB+5
          NZ     X4,ARG5     IF NO REWIND FLAG SET
          OPEN   OLD,READ,R
          OPEN   NEW,READ,R
          EQ     ARG6        CONTINUE
 
 ARG5     OPEN   OLD,READNR,R
          OPEN   NEW,READNR,R
 ARG6     SA1    OLD+1       CHECK DEVICE TYPE
          RJ     CDT
          ZR     X7,IDT      IF UNKNOWN DEVICE
          READCW OLD,17B
          SA1    NEW+1       CHECK DEVICE TYPE
          RJ     CDT
          ZR     X7,IDT      IF UNKNOWN DEVICE
          READCW NEW,17B
          EQ     ARGX        RETURN
 
 ARGA     CON    OLD         TABLE OF DEFAULT OPTIONS
          CON    NEW
          CON    OUTPUT
          CON    CREW
          CON    0
          SPACE  4
**        CCM - COPY COMMENT.
*
*         ENTRY  (B2) = ADDRESS OF FILE PARAMETER AREA.
*                (B4) = ADDRESS OF WORKING STORAGE.
*
*         EXIT   (B3) = FWA OF PROGRAM TEXT.
*
*         USES   A - 1, 4, 6.
*                B - 3, 6.
*                X - 1, 3, 4, 6, 7.
*
*         CALLS  CPT.
 
 
 CCM      SUBR               ENTRY/EXIT
          SA4    B2+.TL
          SA1    B2+B1       INSERT LIBRARY NUMBER
          LX4    6
          BX6    X1+X4
          SA6    A1
          MX3    .CL-.RL     CLEAR FILE PARAMETER AREA
          BX6    X6-X6
          SB6    B2+ENTL+1
          SA6    A4-B1       CLEAR FILE PARAMETER AREA
          SX7    X1          SAVE RECORD TYPE
 CCM1     LX3    1
          SA6    A6-B1
          NG     X3,CCM1     IF NOT END OF CLEAR
          SA1    B4
          SB3    B0
          SA4    A6          RESET (A6) FOR CPT
          LX6    X4
          SA6    A4
          ZR     X7,CCM2     IF TYPE TEXT SKIP PREFIX TABLE COMMENTS
          RJ     CPT
          ZR     X6,CCM2     IF LAST WORD EMPTY
          SB6    B6-1
 CCM2     SX6    A6-B6       SET COMMENT LENGTH
          SB3    A1+B3
          NG     X6,CCMX     IF NO COMMENTS
          SA6    B2+.CL      STORE COMMENT LENGTH
          EQ     CCMX        RETURN
          SPACE  4
**        CCS - CALCULATE CHECKSUM.
*
*         CHECKSUM PROGRAM TEXT FROM (B3) TO (B4).
*
*         ENTRY  (B2) = ADDRESS OF FILE PARAMETER AREA.
*                (B3) = FIRST WORD ADDRESS OF PROGRAM TEXT.
*                (B4) = LAST WORD ADDRESS + 1 OF PROGRAM TEXT.
*
*         USES   A - 1, 4, 6.
*                B - 3.
*                X - 1, 4, 6.
*
*         CALLS  ABT.
 
 
 CCS1     SA1    B3
          SB3    B3+B1
          BX4    X4-X1
          LX4    1
          NE     B3,B4,CCS1  LOOP TO DETERMINE CHECKSUM
          BX6    X4
          SA6    A4
 
 CCS      SUBR               ENTRY/EXIT
          SA4    B2+.CS      GET CURRENT CHECKSUM
          SA1    B2+.RL      ADVANCE RECORD LENGTH
          SX6    B4-B3
          IX6    X1+X6
          SA6    A1+
          LT     B3,B4,CCS1  IF FWA .LT. LWA+1
          SX1    =C* FWA/LWA ERROR IN VFYLIB.*
          RJ     ABT         ABORT
          SPACE  4
**        CDP - CHECK FOR DELETED OR INSERTED PROGRAMS.
*
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME TABLE POINTER.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  OPN.
*
*         MACROS CALL.
 
 
 CDP      SUBR               ENTRY/EXIT
          SX6    B2
          SX7    B0          SET TABLE INDEX
          SA6    CDPA
          SA7    CDPB
 CDP1     SA1    CDPA
          SA1    X1
          SA2    A1+B1
          SA3    CDPB
          SB6    X1
          SB7    B6+X2
          SB2    B6+X3
          EQ     B2,B7,CDPX  IF END OF PROGRAM NAME TABLE - RETURN
          SA1    B2
          SX6    X3+ENTL
          MX0    30
          SA6    A3
          ZR     X1,CDP1     IF ENTRY IS BLANK
          CALL   OPN,B2      OUTPUT PROGRAM NAME
          EQ     CDP1        LOOP
 
 CDPA     DATA   0           ADDRESS OF PROGRAM NAME TABLE POINTER
 CDPB     DATA   0           TABLE INDEX
          SPACE  4
**        CRC - CHECK RESIDENCE CHANGE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 6, 7.
*                X - 1, 2, 3, 6, 7.
*
*         CALLS  OPN.
*
*         MACROS CALL, SEARCH.
 
 
 CRC      SUBR               ENTRY/EXIT
          SX7    B0          SET INDEX IN OPT
          SA7    CRCA
 CRC1     SA1    P.OPT       CHECK RESIDENCE CHANGE
          SA2    L.OPT
          SA3    CRCA
          SB6    X1
          SB7    B6+X2
          SB6    B6+X3
          SA1    B6
          EQ     B6,B7,CRCX  IF END OF OPT - RETURN
          ZR     X1,CRC3     IF ENTRY IS BLANK
          SEARCH NPT,B6
          SA6    CRCC
          SA1    P.OPT
          SA3    CRCA
          IX1    X1+X3
          NZ     X6,CRC2     IF PROGRAM IN SAME LIBRARY
          SEARCH NPT,X1,CRCB
          ZR     X6,CRC3     IF PROGRAM NOT FOUND
          SA6    CRCC
          CALL   OPN,X6      OUTPUT PROGRAM NAME
 CRC2     SA1    P.OPT       CLEAR ENTRIES
          SA2    CRCC
          SA3    CRCA
          IX1    X1+X3
          MX7    0
          SA7    X1
          SA7    X2
 CRC3     SA1    CRCA        ADVANCE INDEX
          SX6    X1+ENTL
          SA6    A1
          EQ     CRC1        LOOP
 
 CRCA     DATA   0           INDEX INTO OLD PROGRAM TABLE
 CRCB     DATA   77777777777777000077B
 CRCC     CON    0           NPT ADDRESS
          SPACE  4
**        CRP - CHECK REPLACED PROGRAMS.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  OPN.
*
*         MACROS CALL, SEARCH.
 
 
 CRP      SUBR               ENTRY/EXIT
          SX7    B0          SET INDEX IN OPT
          SA7    CRPA
 CRP1     SA1    P.OPT       DO LOOP FOR CHECKING FOR REPLACED PROGRAMS
          SA2    L.OPT
          SA3    CRPA
          SB6    X1
          SB7    B6+X2
          SB6    B6+X3
          SA1    B6
          EQ     B6,B7,CRPX  IF END OF OPT - RETURN
          ZR     X1,CRP4     IF ENTRY IS BLANK
          SEARCH NPT,B6
          SA1    P.OPT       COMPARE CHECKSUMS
          SA3    CRPA
          IX1    X1+X3
          ZR     X6,CRP2     IF PROGRAM IS NOT IN SAME LIBRARY
          MX0    30
          SA3    X1+B1
          SA4    X6+B1
          BX7    X3-X4
          BX7    X0*X7
          NZ     X7,CRP3     IF CHECKSUM CHANGE
          SA3    A3+.RL-.CS
          SA4    A4+.RL-.CS
          IX7    X4-X3
          NZ     X7,CRP3     IF LENGTH CHANGE
          SA7    A3+.PD-.RL  CLEAR PROGRAM NAME AND TYPE
          SA7    A4+.PD-.RL
          EQ     CRP4        PROCESS NEXT RECORD
 
*         RECORD NOT IN SAME LIBRARY.
 
 CRP2     SEARCH NPT,X1,CRPB
          ZR     X6,CRP4     IF PROGRAM NOT FOUND
          MX0    30
          SA1    P.OPT       COMPARE CHECKSUMS
          SA3    CRPA
          IX1    X1+X3
          SA3    X1+B1
          SA4    X6+B1
          BX7    X3-X4
          BX7    X0*X7
          NZ     X7,CRP3     IF CHECKSUM CHANGE
          SA3    A3+.RL-.CS
          SA4    A4+.RL-.CS
          IX7    X4-X3
          ZR     X7,CRP4     IF NO LENGTH CHANGE
 CRP3     CALL   OPN,X6      OUTPUT PROGRAM NAME
 CRP4     SA1    CRPA        ADVANCE INDEX
          SX6    X1+ENTL
          MX0    30
          SA6    A1
          EQ     CRP1        LOOP
 
 CRPA     DATA   0           INDEX INTO OLD PROGRAM TABLE
 CRPB     DATA   77777777777777000077B
 CRPC     DATA   0           RESIDENCE FLAG
          SPACE  4
**        C6S - CONVERT 6 DIGITS WITH LEADING ZERO SUPPRESSION.
*
*         ENTRY  (B2) = ADDRESS OF RIGHT JUSTIFIED NUMBER.
*                (B3) = ADDRESS TO STORE RESULT.
*
*         USES   A - 1, 2, 3, 4, 6.
*                B - 2, 5, 6, 7.
*                X - 0, 1, 2, 3, 4, 5, 6.
 
 
 C6S      SUBR               ENTRY/EXIT
          SA2    =0.1000000001P48
          SA3    =10.0P0
          SA4    =1H
          SB6    6
          SB5    1R0-1R
          SA1    B2
          SB2    18
          PX1    X1
          BX6    X4
 C6S1     DX4    X1*X2
          FX1    X1*X2
          SB7    X1
          LX6    54
          SB2    B2+B6
          FX5    X4*X3       CALCULATE REMAINDER DIGIT
          SX0    X5+B5
          IX6    X0+X6
          NZ     B7,C6S1     IF NOT ENTIRE NUMBER
          LX6    X6,B2       POSITION NUMBER
          SA6    B3
          EQ     C6SX        RETURN
          SPACE  4
**        LOL - LIST ONE LINE.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
*
*         CALLS  WPH.
*
*         MACROS WRITEC.
 
 
 LOL      SUBR               ENTRY/EXIT
          SA1    LINE        CHECK LINE NUMBER
          SX6    X1+B1
          SA6    A1
          SA1    A1+B1       GET LINE LIMIT
          IX6    X6-X1
          SX2    O
          NG     X6,LOL1     IF NOT END OF PAGE
          RJ     WPH
          SX6    X6+2        ADVANCE LINE COUNT
          SA6    LINE
          WRITEC X2,(=1L )
 LOL1     WRITEC X2,OUTPUTB
          EQ     LOLX        RETURN
          SPACE  4
**        OPN - OUTPUT PROGRAM NAME.
*
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME TABLE ENTRY.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  C6S, LOL, SFN, WPH.
*
*         MACROS CALL, WRITEC.
 
 
 OPN      SUBR               ENTRY/EXIT
          SX6    B2
          SA6    OPNA
          SA1    OPND
          ZR     X1,OPN2     IF HEADER WRITTEN
          SA2    LINE        CHECK LINE POSITION
          SX2    X2+4
          SA1    A2+B1       GET LINE LIMIT
          IX6    X2-X1
          NG     X6,OPN1     IF NOT END OF PAGE
          RJ     WPH
 OPN1     WRITEC O,(=1L )
          SA4    OPND        GET HEADER MESSAGE ADDRESS
          SA3    LINE
          BX7    X7-X7
          SX6    X3+3        UPDATE LINE COUNT
          SA7    A4
          SA6    A3
          WRITEC X2,X4       WRITE HEADER MESSAGE
          WRITEC X2,(=1L )
 
*         LIST PROGRAM NAME.
 
 OPN2     SA1    OPNA        OUTPUT PROGRAM NAME
          SA4    X1
          MX0    42
          BX1    X0*X4
          RJ     SFN         SPACE FILL NAME
          SA3    A3
          SA6    OUTPUTB+1
          MX0    -6
          LX7    X3
          BX2    -X0*X4
          SA1    OPNB+X2     OUTPUT PROGRAM TYPE
          SA7    A6-B1
          BX6    X1
          AX4    6
          SA6    A6+B1
          MX0    7*6         OUTPUT ULIB NAME
          SA1    OPNA
          SA5    X1+.UN-.PD
          BX1    X0*X5
          RJ     SFN         SPACE FILL ULIB NAME
          SA6    A6+B1
          MX0    -12
          BX7    -X0*X4      OUTPUT LIBRARY NUMBER
          SX7    X7+
          SA7    OPNC
          CALL   C6S,A7,A6+B1
          SA1    OPNA        OUTPUT DATE AND COMMENT
          SA1    X1+.CS-.PD  X1 = COMMENT INDEX
          SA2    A1+.DT-.CS
          MX0    -30
          LX6    X2
          BX4    -X0*X1
          SA6    A6+B1
          SA2    P.CMT
          IX6    X2+X4
          AX4    18
          SB6    X4
          ZR     X4,OPN4     IF NO COMMENTS
          SA1    X6
 OPN3     BX6    X1          MOVE COMMENTS
          SB6    B6-B1
          SA1    A1+B1
          SA6    A6+B1
 OPN4     NZ     B6,OPN3     LOOP
          BX6    X6-X6
          SA6    A6+B1
          CALL   LOL
          EQ     OPNX        RETURN
 
 OPNA     DATA   0           ADDRESS OF ENTRY
 
 OPNB     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT//
          DATA   H/RT/
 .A       ELSE
          DATA   0           UNDEFINED RECORD TYPE
 .A       ENDIF
 .E       ENDD
 
 OPNC     DATA   0           GROUP NUMBER
 OPND     CON    0           HEADER MESSAGE ADDRESS
          SPACE  4
**        RDF - READ FILES.
*
*         BOTH FILES ARE READ SIMULTAINIOUSLY.  COMMON ROUTINES
*         ARE USED BETWEEN THE TWO READS.  IN THESE ROUTINES
*         (RDFB) = POINTER TO DATA AREA.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  ADD, CCM, CCS, SFN.
*
*         MACROS CALL, MESSAGE, READW.
 
 
 RDF      SUBR               ENTRY/EXIT
 
 RDF1     EQ     RDF3
          SA1    RDFA        TOGGLE BETWEEN FILE *OLD* AND *NEW*
          SA2    A1+B1
          SA3    A2+B1
          SA4    RDF1
          AX3    30
          BX7    X4
          SB5    X3
          SA7    A3
          BX6    X1
          LX7    X2
          SA6    A2
          SA7    A1
          SA2    X7
          SA5    A1
          JP     B5
 
 
 RDF2     SA1    X5+.TL      ADVANCE LIBRARY NUMBER
          SX6    X1+B1
          SA6    A1
 RDF3     RJ     RDF1        START READ
          READW  X2,WSA,WSAL
          NG     X1,RDF16    IF EOF
          SA5    RDFA        SET EOR INDICATOR
          BX6    X1
          SA6    RDFC
          SB7    WSA
          EQ     B6,B7,RDF2  IF ZERO LENGTH RECORD
 
*         CHECK PROGRAM TYPE AND MAKE ENTRY INTO THE PROGRAM NAME TABLE.
 
          SX1    B6          LWA+1 OF DATA READ
          SX2    B7          FWA OF BUFFER (WSA)
          RJ     SRT         SET RECORD TYPE
          SA6    X5+B1
          BX1    X7
          BX7    X7-X7       CLEAR CHECKSUM WORD
          SA7    A6+B1
          MX0    -6          CHECK RECORD TYPE
          BX4    -X0*X6
          SB4    X4
          SB2    ODRT        TYPE = OPLD
          SA4    X5+.TU
          ZR     X4,RDF5     IF ULIB .EQ. 0
          EQ     B4,B2,RDF4  IF REC TYPE .EQ. OPLD
          BX7    X4          SET UP ULIB IN TABLE ENTRY
          SA7    A7+B1
          EQ     RDF6        CONTINUE PROCESSING THE ENTRY
 
 RDF4     BX7    X7-X7       ZERO OUT ULIB
          SA7    A7+B1
          SA7    X5+.TU
          EQ     RDF6        CONTINUE PROCESSING THE ENTRY
 
 RDF5     SB2    ULRT        CHECK RECORD TYPE
          NE     B4,B2,RDF6  IF REC TYPE .NE. ULIB
          MX0    7*6         SAVE ULIB
          BX7    X0*X6
          SA7    A7+B1       SET ULIB IN TABLE ENTRY
          SA7    X5+.TU
 RDF6     RJ     SFN         SPACE FILL NAME
          AX5    54
          SB5    X5
          SA6    RDFF+X5
          MESSAGE A6-B5,B1
          SA5    A5
          CALL   CCM,X5,,WSA
          SA5    RDFA
          SA1    RDFC
          NZ     X1,RDF7     IF EOR READ
          SX1    WSA+WSAL
 RDF7     CALL   CCS,X5,B3,X1
          SA1    RDFC
          NZ     X1,RDF11    IF EOR READ
 
*         READ REST OF RECORD.
 
 RDF8     RJ     RDF1
          READW  X2,WSA,WSAL
          BX6    X1          SET INDICATOR
          SA6    RDFC
          SX4    B6-WSA
          ZR     X4,RDF11    IF NO DATA
          PL     X1,RDF9     IF NO EOF
          SX1    B6+         SET LWA+1
 RDF9     NZ     X1,RDF10    IF EOR OR EOF READ
          SX1    WSA+WSAL
 RDF10    CALL   CCS,X5,WSA,X1
          SA1    RDFC
          ZR     X1,RDF8     IF NOT EOR READ
 
*         ADD ENTRY TO PROGRAM NAME TABLE.
 
 RDF11    SA5    RDFA
          SB2    P.CMT
          SB3    X5+ENTL+1
          SA1    X5+.CL      CHECK COMMENT LENGTH
          MX7    0
          BX6    X1
          ZR     X1,RDF15    IF NO COMMENTS
          SA4    N.CMT
          SA2    B2+B1
          BX7    X6-X4       CHECK LENGTH OF PREVIOUS ENTRY
          SA6    A4
          NZ     X7,RDF13
          SA3    B2
          SB4    B0
          IX1    X2-X4       (L.CMT) - (N.CMT)
          SB6    X4
          IX7    X3+X1
 RDF12    EQ     B4,B6,RDF14 IF SAME COMMENTS
          SA3    B3+B4
          SA4    X7+B4
          BX1    X3-X4       COMPARE COMMENTS
          SB4    B4+B1
          ZR     X1,RDF12    IF MATCH
 RDF13    LX6    2
          SA6    A6+B1
          CALL   ADD,B2,B3
 RDF14    SA1    A2+B1       SAVE COMMENT TABLE INDEX
          IX7    X2-X1
          LX1    18          INSERT COMMENT LENGTH
          BX7    X1+X7
 RDF15    SB3    B3-ENTL
          SA5    B3+B1       FOLD CHECKSUM
          MX0    -12
          BX1    -X0*X5
          AX5    12
          BX6    -X0*X5
          IX1    X1+X6
          AX5    12
          BX6    -X0*X5
          IX1    X1+X6
          AX5    12
          BX6    -X0*X5
          IX1    X1+X6
          AX5    12
          BX6    -X0*X5
          IX1    X1+X6
          IX6    X1+X0
          BX6    -X0*X6
          LX6    48
          BX6    X6+X7       MERGE FOLDED CHECKSUM AND COMMENT LENGTH
          SA6    A5
          SA5    RDFA
          AX5    30
          CALL   ADD,X5,B3
          EQ     RDF3        LOOP TO EOF
 
*         WAIT FOR EOF ON BOTH FILES.
 
 RDF16    SA1    RDFB
          NZ     X1,RDFX     IF BOTH FILES FINISHED - RETURN
          SX6    B1          SET EOF FLAG
          SA6    A1
          SA5    RDFA
          AX5    54
          SA1    =H*END FILE.*
          BX6    X1
          SA6    RDFF+X5
          MESSAGE RDFF,1
 RDF17    RJ     RDF1        WAIT FOR 2ND FILE TO COMPLETE
          EQ     RDF17
 
 RDFA     VFD    6/1,24/P.OPT,30/RDFD
          VFD    6/2,24/P.NPT,30/RDFE
          EQ     RDF3
 
 RDFB     DATA   0           EOF INDICATOR
 RDFC     DATA   0           EOR INDICATOR
 
*         FILE PARAMETER AREA.
 
 RDFD     BSS    0           OLD FILE PARAMETER LIST
 
          LOC    0
 .PN      CON    OLD         OLD FILE FET FET ADDRESS
 .PD      VFD    42/,12/,6/  42/PROGRAM,12/LIB,6/TYPE
 .CS      CON    0           30/CHECKSUM,30/COMMENT INDEX
 .UN      CON    0           USER LIBRARY NAME
 .RL      CON    0           RECORD LENGTH
 .DT      CON    0           DATE
          ERRNZ  *-ENTL-1    NPT/OPT TABLE LENGTH ERROR
 
 .CM      BSSZ   13          COMMENT TEXT
 .CL      CON    0           COMMENT LENGTH
 .TL      CON    1           CURRENT LIBRARY NUMBER OF FILE
 .TU      CON    0           SAVE AREA FOR CURRENT ULIB
 
 FPAL     BSS    0           FILE PARAMETER LENGTH
          LOC    *O
 
 RDFE     BSS    0           NEW FILE PARAMETER LIST
 
          LOC    0
 .PN      CON    NEW         NEW FILE FET ADDRESS
 .PD      VFD    42/,12/,6/  42/PROGRAM,12/LIB,6/TYPE
 .CS      CON    0           30/CHECKSUM,30/COMMENT INDEX
 .UN      CON    0           USER LIBRARY NAME
 .RL      CON    0           RECORD LENGTH
 .DT      CON    0           DATE
          ERRNZ  *-ENTL-1    NPT/OPT TABLE LENGTH ERROR
 
 .CM      BSSZ   13          COMMENT TEXT
 .CL      CON    0           COMMENT LENGTH
 .TL      CON    1           CURRENT LIBRARY NUMBER OF FILE
 .TU      CON    0           SAVE AREA FOR CURRENT ULIB
 
 FPAL     BSS    0           FILE PARAMETER LENGTH
          LOC    *O
 
*         DISPLAY MESSAGE.
 
 RDFF     DATA   H*READING   *
          DATA   10H
          DATA   10H
          DATA   0
 RDA      SPACE  4
**        RDA - READ DATA.
*
*         PROCESSES CALLS TO READ WORDS (RDW=).
*         DEBLOCKS DATA IF CONTROL WORD READS.
*
*         USES   A - 1, 3, 6, 7.
*                B - 5, 6, 7.
*                X - 1, 3, 4, 6, 7.
*
*         CALLS  RDW=.
 
 
 RDA5     SX6    B5-B7       UPDATE WORDS REMAINING
          SA6    A1
          RJ     RDW=        READ WORDS
 
 RDA      SUBR               ENTRY/EXIT
 RDA1     SA1    X2-2        GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1+
          PL     X1,RDA2     IF NOT FIRST READ
          SX7    B7+         SET WORDS NEEDED
          SA7    RDAA
          JP     RDA4
 
 RDA2     GE     B5,B7,RDA5  IF ENOUGH DATA TO FILL BUFFER
          SA3    X2-1        CHECK EOR FLAG
          PL     X3,RDA3     IF NOT EOR ON FILE
          MX6    1           SET NEW READ FLAG
          SB7    B5+B1       SET WORDS TO READ
          SA6    A3
          SA6    A1
          RJ     RDW=        READ WORDS
          SA1    B6-B1       CHECK CONTROL WORD
          AX1    48
          SX6    X1-17B
          MX1    -1
          SB6    B6-B1       BACK UP LAST WORD ADDRESS
          ZR     X6,RDA      IF *EOF* CONTROL WORD
          SX1    B6          SET *EOR* INDICATION
          EQ     RDAX        RETURN
 
 RDA3     SX6    B7-B5       SAVE ADDITIONAL WORDS NEEDED
          SA6    RDAA
          SB7    B5+B1       SET WORDS TO TRANSFER
          RJ     RDW=        READ WORDS
          SB6    B6-1        BACK UP OVER LAST CONTROL WORD
 RDA4     SB7    B1          READ CONTROL WORD
          RJ     RDW=
          NG     X1,RDA      IF EOF/EOI
          SB6    B6-B1       BACK UP WORKING BUFFER
          SA1    B6          CONTROL WORD
          SX7    5
          SX4    X1+4        ROUND UP
          AX1    36          EXTRACT BLOCK SIZE
          SX3    X1
          IX7    X4/X7       WORDS IN BLOCK
          IX6    X7-X3       SAVE EOR FLAG
          SA7    X2-2        STORE WORD COUNT
          SA6    X2-1        EOR FLAG
          SA1    RDAA        RESET WORDS NEEDED
          SB7    X1
          JP     RDA1        LOOP
 
 RDAA     CON    0
 CDT      SPACE  4
**        CDT - CHECK DEVICE TYPE.
*
*         ENTRY  (X1) = (FET+1).
*
*         EXIT   (X7) = 0, IF CONTROL WORD READ/WRITE NOT SUPPORTED
*                       ON DEVICE.
*
*         USES   A - 2.
*                X - 0, 1, 2, 6, 7.
 
 
 CDT2     LX1    12          CHECK *TT*
          BX6    -X0*X1
          SX7    X6-2RTT
 
 CDT      SUBR               ENTRY/EXIT
          MX0    -12
          PL     X1,CDT2     IF ALLOCATABLE
          LX1    12
          SA2    CDTA        SEARCH DEVICE TABLE
          SX7    0           ASSUME NO FIND
 CDT1     ZR     X2,CDTX     IF NOT FOUND - RETURN
          BX6    X1-X2
          AX2    12
          BX6    X2*X6
          SA2    A2+B1
          NZ     X6,CDT1     IF NOT MATCH
          SX7    1           INDICATE CONTROL WORD POSSIBLE
          EQ     CDTX        RETURN
 
 CDTA     VFD    36/,12/7703B,12/4002B
          VFD    36/,12/7703B,12/4102B
          VFD    36/,12/7777B,12/2RMT+4000B
          VFD    36/,12/7777B,12/2RNT+4000B
          VFD    36/,12/7777B,12/2RCT+4000B
          VFD    36/,12/7777B,12/2RAT+4000B
          CON    0
 IDT      SPACE  4
**        IDT - ISSUE UNKNOWN DEVICE MESSAGE.
*
*         ENTRY  (A1) = FET ADDRESS + 1.
*                (X7) = 0.
*
*         EXIT   TO ABT.
*
*         USES   A - 1, 7.
*                B - 4.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  MSG=.
 
 
 IDT      MX0    42
          SA1    A1-B1       READ FILE NAME
          MX3    26+10
          BX6    X0*X1
          MX2    6
          LX3    59          POSITION LEGAL CHARACTER MASK
          BX1    X1-X1
          MX0    -6
 IDT1     LX7    6
          BX7    X7+X1       ASSEMBLE FILE NAME
          LX6    6
          BX1    -X0*X6
          SB4    X1          FIND END OF FILE NAME
          LX4    B4,X3
          NG     X4,IDT1     IF NOT END OF NAME
          LX7    6
          SX1    1R.         ADD *.* TO FILE NAME
          BX7    X7+X1
 +        LX7    6           LEFT JUSTIFY ASSEMBLY
          BX6    X2*X7
          ZR     X6,*        IF NOT LEFT JUSTIFIED
          SA7    IDTB
          MESSAGE IDTA
          CALL   ABT
 
 IDTA     DATA   30H UNKNOWN DEVICE TYPE -- LFN =
 IDTB     CON    0
 WPH      SPACE  4
**        WPH - WRITE PAGE HEADER.
*
*         EXIT   PAGE HEADER WRITTEN.
*
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7.
*
*         CALLS  C6S, WTW=.
 
 
 WPH      SUBR               ENTRY/EXIT
          SA2    PNUM
          SX6    X2+B1       ADVANCE PAGE NUMBER
          SA6    A2
          CALL   C6S,A2,WPHA
          LX6    36
          MX0    -24
          SA1    WPHA+1
          BX6    -X0*X6      INSERT PAGE NUMBER
          IX7    X1+X6
          SA7    CRPG
          WRITEW O,WPHB,WPHD
          SX6    3           SET LINE COUNT
          SA6    LINE
          EQ     WPHX        RETURN
 
 WPHA     BSS    1           CONVERTED PAGE NUMBER
          CON    6LPAGE
 
 WPHB     DATA   H*1     VFYLIB.      OLD FILE = XXXXXXX  N*
          DATA   H*EW FILE = XXXXXXX   *
 CRDT     CON    0           CURRENT DATE
 CRTM     CON    0           CURRENT TIME
          DATA   10H
 CRPG     CON    0           CURRENT PAGE
          CON    0
 
 WPHC     DATA   H*0          RECORD    TYPE      ULIB          LIB*
          DATA   C* DATE      COMMENT*
 WPHD     EQU    *-WPHB
          SPACE  4
**        SMT - SEARCH MANAGED TABLE.
*
*         ENTRY  (B2) = ADDRESS OF TABLE POINTER.
*                (B3) = ADDRESS OF ENTRY.
*                (B4) = ADDRESS OF MASK.
*                (B5) = INDEX INTO TABLE.
*
*         EXIT   (B6) = ADDRESS OF ADDRESS OF ENTRY IF FOUND.
*                (B6) = ADDRESS OF 0 IF NOT FOUND.
*                (X6) = ADDRESS OF ENTRY, IF FOUND.
*                     = 0, IF NOT FOUND.
*
*         USES   A - 1, 2, 3, 4, 5, 6.
*                B - 2, 3, 4, 7.
*                X - ALL.
 
 
 SMT      SUBR               ENTRY/EXIT
          SA1    B2          SET TABLE POINTER
          SA2    A1+B1       SET TABLE LENGTH
          SA3    A2+B1       SET NUMBER OF WORDS/ENTRY
          SA4    B3          (X4) = ENTRY
          SB2    X1          (B2) = FWA TABLE
          SB7    X2+B2       (B7) = LWA TABLE
          SB3    X3          (B3) = WORDS/ENTRY
          SA5    B4          (X5) = MASK
          MX0    7*6
 SMT1     EQ     B2,B7,SMT2  IF END OF TABLE
          SA1    B2+B5
          BX6    X4-X1
          BX6    X5*X6
          SB2    B2+B3
          NZ     X6,SMT1     IF NOT FOUND
          SA2    A4+2        CHECK ULIB
          SB4    B2-B3
          SA3    B4+2
          BX7    X2-X3
          BX7    X0*X7
          NZ     X7,SMT1     IF DIFFERENT ULIB
          SX6    B4
          SA6    B6
          EQ     SMTX        RETURN
 
 SMT2     SX6    B0          SET NOT FOUND
          SA6    B6
          EQ     SMTX        RETURN
 
 SMTA     CON    0
          SPACE  4
**        TABLE POINTERS.
 
 
 TABLE    TABLE  OPT,ENTL
          TABLE  NPT,ENTL
          TABLE  CMT,7
          TABLE  BUF         UNUSED STORAGE TABLE
 COMMON   TITLE  COMMON DECKS AND STORAGE ALLOCATION.
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPT
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSRT
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTW
 PRESET   TITLE  VFYLIB PRESET.
 PRS      SPACE  4,20
**        PRS - PRESET VFYLIB.
*
*         ENTRY  (A0) - FL.
*
*         EXIT   (LL) = LINE LIMIT.
*                (PD) = PRINT DENSITY.
*                (CFL) = CURRENT FIELD LENGTH.
*                (MFL) = MAXIMUM FIELD LENGTH.
*                (CRDT) - CURRENT DATE.
*                (CRTM) - CURRENT TIME.
*
*         USES   A - 6, 7.
*                B - 6, 7.
*                X - 6, 7.
*
*         MACROS CLOCK, DATE, GETPP, MEMORY.
 
          USE    //          FORCE LITERALS
 
 PRS      SUBR               ENTRY/EXIT
          MEMORY CM,MFL,R    MAXIMUM FIELD LENGTH
          DATE   CRDT        SET DATE
          CLOCK  CRTM        SET TIME
          GETPP  BUF,LL,PD   GET PAGE SIZE PARAMETERS
          SX7    A0-BUF      SET LENGTH OF TABLES
          SX6    A0          CURRENT FIELD LENGTH
          SA7    L.BUF
          SA6    CFL
          EQ     PRSX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCCPM
*CALL     COMCSTF
 
          ERRPL  *-OUTB      OVERFLOW INTO OUTPUT BUFFER
 BUFFERS  SPACE  4,10
**        BUFFER ALLOCATION.
 
 
 OUTPUTB  EQU    PRS         OUTPUT WORKING BUFFER
 OUTPUTL  EQU    14
 WSA      EQU    OUTPUTB+OUTPUTL WORKING BUFFER
 WSAL     EQU    1000B       LENGTH OF WORKING STORAGE
 OUTB     EQU    WSA+WSAL    OUTPUT BUFFER
 OLDB     EQU    OUTB+OUTL   OLD BUFFER
 NEWB     EQU    OLDB+OLDL   NEW BUFFER
 BUF      EQU    NEWB+NEWL   START OF MANAGED TABLES
 MFL=     EQU    BUF+MINBL+200000B
 END      SPACE  4,10
          END