VFYLIB
          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 
