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
- LIST ONE LINE.