File: COMPAF.PA of Tape: Sources/Other/new-16
(Source file text)
/COMPAF
/COMPARE ALL FILES ON TWO DEVICES
/15-AUG-77
/DAVID SPECTOR, DEC
VERSION=2
PATCH="A&77
/** REQUIRES 16K MEMORY! **
/MEMORY MAP:
/00000 COMMAND DECODER
/02000 PROGRAM
/06200 HANDLERS
/10000 USR
/12000 PRINT BUFFER (13 BLOCKS)
/20000 DIRECTORY, DEV 1 (6 BLOCKS)
/23000 BUFFER, DEV 1 (11 BLOCKS)
/30000 DIRECTORY, DEV 2 (6 BLOCKS)
/33000 BUFFER, DEV 2 (11 BLOCKS)
/ASSEMBLY:
/ .PAL COMPAF(L89)=2000
/ .SA SYS COMPAF
/EDIT HISTORY:
/V1A INITIAL RELEASE
/V2A INTERNAL LOOKUP INSTEAD OF USR FOR SPEED
/ RUNS ON OLD MACHINES
/ COUNTS I/O ERRORS
/ TERM.PA ELIMINATED
/ BUFLEN INCREMENTED
/ NUMBERS PRINTED IN DECIMAL
/EQUALITIES
CUR=00 /PROGRAM FIELD
BUFFER=3000 /COMPARE BUFFERS
BUFLEN=11 /BUFFER LENGTH, BLOCKS
F1=20 /FIELD OF DEV 1 STUFF
F2=30 /FIELD OF DEV 2 STUFF
PRBUF=2000 /PRINT BUFFER (FIELD 1, 2000-7377)
PF=10 /FIELD OF PRINT BUFFER
/HANDLER BUFFERS (2 PAGES EACH)
ODEVB=7200
IDEVB1=6600
IDEVB2=6200
/PAGE 0 VARIABLES
T=30 /TEMPORARIES
T2=31
T3=32
T4=33
T5=34
ODEVN=35 /DEVICE NUMBERS
IDEVN1=36
IDEVN2=37
ODEVH=40 /HANDLER ENTRY POINTS
IDEVH1=41
IDEVH2=42
PRBUFP=43 /PRINT BUFFER POINTER
ST=44 /STARTING BLOCK, "SCAN"
LEN=45 /-LENGTH, "SCAN"
ST1=46
LEN1=47
*2000
/START HERE
/LOCK IN USR
START, CIF 10
JMS I (7700)
10 /LOCK IN USR
/DISALLOW RESTARTING
TAD (JMP I START+1)
DCA START
TAD (7605)
DCA START+1
/CALL COMMAND DECODER
RESTAR, CIF 10
JMS I (200)
5 /CALL CD
0 /NO DEFAULT EXTENSION
/INITIALIZE PRINT BUFFER
TAD (PRBUF)
DCA PRBUFP
/ANALYZE WHAT USER TYPED
/1ST OUTPUT DEV?
JMS LD1; 7600
SNA
JMP ERR1 /NONE
/YES - SAVE NR
AND (17)
DCA ODEVN
/2ND OUTPUT DEV?
JMS LD1; 7605
SZA CLA
JMP ERR1 /EXISTS
/3RD OUTPUT DEV?
JMS LD1; 7612
SZA CLA
JMP ERR1 /EXISTS
/IS OUTDEV NON-FILE?
JMS LD2; ODEVN
SPA CLA
JMP ERR1 /NO
/1ST INPUT DEV?
JMS LD1; 7617
SNA
JMP ERR1 /NONE
/YES - SAVE NR
AND (17)
DCA IDEVN1
/1ST FILENAME?
JMS LD1; 7620
SZA CLA
JMP ERR1 /EXISTS
/IS INDEV1 FILED?
JMS LD2; IDEVN1
SMA CLA
JMP ERR1 /NO
/2ND INPUT DEV?
JMS LD1; 7621
SNA
JMP ERR1 /NONE
/YES - SAVE NR
AND (17)
DCA IDEVN2
/2ND FILENAME?
JMS LD1; 7622
SZA CLA
JMP ERR1 /EXISTS
/NOTE: 3RD, ETC. INPUT NAMES IGNORED
/IS INDEV2 FILED?
JMS LD2; IDEVN2
SMA CLA
JMP ERR1 /NO
/END OF ANALYSIS OF USER INPUT
/FETCH OUTPUT HANDLER
TAD (FE1-1)
JMS FETCH
/FETCH INPUT HANDLER 1
TAD (FE2-1)
JMS FETCH
/FETCH INPUT HANDLER 2
TAD (FE3-1)
JMS FETCH
/READ DIRECTORY 1
JMS I IDEVH1
6^200+F1 /6 BLOCKS, FIELD 2
0 /ADDR
1 /BLOCK
JMP ERR2
/READ DIRECTORY 2
JMS I IDEVH2
6^200+F2 /6 BLOCKS, FIELD 3
0 /ADDR
1 /BLOCK
JMP ERR2
/SWITCH OUTPUT TO OUTPUT DEV
TAD (NOP)
DCA PRSW
/OUTPUT REPORT HEADING
TAD (M6)
JMS TYPE
/INIT SCAN OF DIRECTORY 1
TAD (SC1)
DCA DIR1
/LOOP:
/GET NEXT NAME FROM DIR 1
GNND1, TAD (DIR1-1)
JMS SCAN
JMP EP /DONE
TAD 11
DCA 14 /SAVE ENTRY ADDR
TAD ST /SAVE STARTING BLOCK
DCA ST1
TAD LEN /AND -LENGTH
DCA LEN1
ST2=ST
LEN2=LEN
/INIT SCAN OF DIR 2
TAD (SC1)
DCA DIR2
JMP PAGE1 /CONTINUE
PAGE
PAGE1,
/LOOK FOR MATCHING NAMES
/GET NEXT NAME FROM DIR 2
GNND2, TAD (DIR2-1)
JMS SCAN
JMP NNFD /DONE
/DO THE NAMES MATCH?
TAD 14
DCA 11 /RESTORE ADDR OF DEV1 ENTRY
TAD (NAME-1) /ALSO SAVE IN "NAME"
DCA 13
JMS NMTCH
JMS NMTCH
JMS NMTCH
JMS NMTCH
/THE NAMES MATCH
/COMPARE THE TWO FILES
/SAME LENGTH?
PAGE2, TAD LEN1
CIA
TAD LEN2
SZA CLA
JMP BAD /NO
/LENGTH = 0 ?
TAD LEN1
SZA CLA
JMP CONTM /NO: OK
/YES - PRINT MSG
JMS PRFINA
TAD (M4)
JMS TYPE
/COUNT FILES AS COMPARING OK
ISZ CNT1
JMP GNND1 /AND CONTINUE
BADFLG, 7777 /7777=NO BAD MATCH FOUND YET
/FILES COMPARE BAD
BAD, ISZ BADFLG /IS THIS THE 1ST BAD MATCH?
JMP BAD1 /NO
TAD (M5) /YES - PRINT HEADING FIRST
JMS TYPE
BAD1, JMS PRFINA
JMS CRLF
ISZ CNT3
JMP GNND1
/SET UP COMPARISON
CONTM, TAD LEN1 /-LENGTH
CIA
DCA T
TAD ST1 /STARTING BLOCK
DCA CMB1
TAD ST2
DCA CMB2
/COMPARE LOOP:
/FILES STILL LARGE?
CMLOOP, TAD (-BUFLEN)
TAD T
SMA SZA
JMP CMPA /YES
CLA /NO - LAST 'T' BLOCKS
TAD T
JMS CMPBUF
/FILES COMPARE OK
ISZ CNT1
JMP GNND1
/COMPARE NEXT BLOCKS OF LARGE FILE
CMPA, DCA T
TAD (BUFLEN)
JMS CMPBUF
JMP CMLOOP
/COMPARE N BLOCKS OF FILE
CMPBUF, 0
DCA T2
TAD T2
CLL RTR;RTR;RTR /BLOCKS*200
AND (3600) /MAKE SURE WRITE BIT IS NEVER SET
TAD (F1)
DCA CMF1 /FUNCTION CONTROL WORD
TAD CMF1
TAD (F2-F1)
DCA CMF2
/READ N BLOCKS OF FILE ON DEV1
JMS I IDEVH1
CMF1, 0 /FUNCTION CONTROL WD
BUFFER /ADDR
CMB1, 0 /BLOCK
JMP BADIO
/READ DEV2
JMS I IDEVH2
CMF2, 0
BUFFER
CMB2, 0
JMP BADIO
/UPDATE BLOCK NR
TAD T2
TAD CMB1
DCA CMB1
TAD T2
TAD CMB2
DCA CMB2
/SETUP TO SCAN N BLOCKS
TAD T2
CLL RTR;RTR;RAR /BLOCKS*400 = WORDS
CIA
DCA T2
TAD (BUFFER)
DCA T3
/INNER COMPARE LOOP
INCMP, CDF F1
TAD I T3
CIA
CDF F2
TAD I T3
CDF CUR
SZA CLA
JMP BAD /WORDS NOT EQUAL
ISZ T3 /ON TO THE NEXT WORD
ISZ T2
JMP INCMP
JMP I CMPBUF /ALL N BLOCKS COMPARE OK
/I/O ERROR OCCURRED WITHIN A FILE
BADIO, CLA
TAD (M7)
JMS TYPE /REPORT IT
JMS PRFINA
JMS CRLF
ISZ CNT5 /COUNT IT
JMP GNND1 /GO ON TO NEXT PAIR
PAGE
/NO MORE FILES ON DEV2
NNFD, ISZ CNT4 /COUNT ONE EXTRA FILE ON DEV1
JMP GNND1 /AND CONTINUE
/NO MORE FILES ON DEV1
/SCAN DEV2 TO COUNT FILES ON DEV2
/INITIALIZE SCAN OF DIR 2
EP, TAD (SC1)
DCA DIR2
/COUNT FILES
EP1, TAD (DIR2-1)
JMS SCAN
JMP DONE
ISZ CNT2 /COUNT TOTAL FILES ON DEV2
JMP EP1
/DONE: PRINT RESULTS
DONE, JMS CRLF
TAD CNT1
TAD CNT3
TAD CNT5 /I/O ERROR COUNT
DCA T2 /TOTAL FILE PAIRS
TAD T2
JMS PRINTN
TAD (M8)
JMS TYPE
TAD CNT1
JMS PRINTN
TAD (M9)
JMS TYPE
TAD CNT3
JMS PRINTN
TAD (M10)
JMS TYPE
TAD CNT5 /I/O ERROR COUNT
SNA
JMP DONE3
JMS PRINTN
TAD (M13)
JMS TYPE
DONE3, TAD CNT4
SNA
JMP DONE1
JMS PRINTN
TAD (M11)
JMS TYPE
DONE1, TAD T2
CIA
TAD CNT2
SNA
JMP DONE2
JMS PRINTN
TAD (M12)
JMS TYPE
DONE2, JMS DUMP /DUMP OUTPUT BUFFER
JMP 7605 /RETURN TO MONITOR
PAGE
/SUBROUTINES, ETC.
/LOAD FROM FIELD 1
LD1, 0
TAD I LD1
ISZ LD1
DCA T
CDF 10
TAD I T
CDF CUR
JMP I LD1
/LOAD FROM SYSTEM TABLE IN FIELD 1
LD2, 0
TAD I LD2
ISZ LD2
DCA T
TAD I T
TAD (7757)
DCA LD2A
JMS LD1
LD2A, 0
JMP I LD2
/TYPE BAD SYNTAX ERROR MESSAGE
ERR1, CLA
TAD (M2)
JMS TYPE
JMP RESTAR
/TYPE I/O ERROR MESSAGE
ERR2, CLA
TAD (M3)
JMS TYPE
JMP 7605
/FETCH A DEVICE HANDLER INTO ITS BUFFER
FETCH, 0
DCA 10 /SEE PARAMETERS BELOW
TAD I 10
DCA FETCH1
TAD I 10
DCA T
TAD I 10
DCA T2
TAD I T
CIF 10
JMS I (200)
1 /FETCH
FETCH1, 0 /BUFFER ADDR
JMP ERR2
TAD FETCH1
DCA I T2
JMP I FETCH
/PARAMETER LISTS FOR "FETCH"
FE1, ODEVB+1
ODEVN
ODEVH
FE2, IDEVB1+1
IDEVN1
IDEVH1
FE3, IDEVB2+1
IDEVN2
IDEVH2
/MATCH NEXT TWO CHARS OF FILENAMES, AND STORE IN "NAME"
NMTCH, 0
CDF F1
TAD I 11
CDF CUR
DCA T
TAD T
DCA I 13
TAD T
CDF F2
CIA
TAD I 12
CDF CUR
SNA CLA
JMP I NMTCH
JMP GNND2 /BAD MATCH - TRY NEXT ENTRY IN DIR2
/"CURRENT" FILENAME
NAME, ZBLOCK 4
/FILE COUNTS
CNT1, 0 /NR COMPARED OK
CNT2, 0 /TOTAL NR ON DEV2
CNT3, 0 /NR COMPARED BAD
CNT4, 0 /EXTRAS ON DEV1
CNT5, 0 /PAIRS WITH I/O ERRORS
/PRINT CURRENT FILE NAME
PRFINA, 0
TAD (NAME-1)
DCA 10
JMS PRFN2
JMS PRFN2
JMS PRFN2
TAD (".)
JMS PRINT
JMS PRFN2
JMP I PRFINA
PRFN2, 0
TAD I 10
DCA T
TAD T
RTR;RTR;RTR
JMS PRINTH
TAD T
JMS PRINTH
JMP I PRFN2
PAGE
/COROUTINE TO SCAN DIRECTORY
/ INPUT: AC=PARAM LIST-1
/ OUTPUT: RETURN 1: DONE (NO MORE ENTRIES FOUND)
/ RETURN 2: NORMAL
/ 11=ADDR OF F1 ENTRY
/ 12=ADDR OF F2 ENTRY
/ ST=STARTING BLOCK
/ LEN=-LENGTH
SCAN, 0
DCA 10
TAD 10
DCA 13 /FOR USE WHEN RETURNING
/SAVE ALL LOCAL VARIABLES
TAD (SCVAR-1)
DCA 15
SC9, TAD I 15
SNA
JMP SCFLD
DCA T
TAD I 10
DCA I T
JMP SC9
SCFLD, CDF F1 /SET PROPER FIELD
JMP I SC /CONTINUE COROUTINE
SC, SC1 /ADDR OF CURRENT COROUTINE SECTION
CDF CUR /RESET FIELD ON RETURN
/RESTORE ALL LOCAL VARIABLES ON RETURN
TAD (SCVAR-1)
DCA 15
SC12, TAD I 15
SNA
JMP SC13
DCA T
TAD I T
DCA I 13
JMP SC12
SC13, ISZ SCAN /NORMAL RETURN
JMP I SCAN
/INITIALIZE DIRECTORY SCAN
SC1, DCA SEGM /SEGMENT 1, LOC X0000
TAD (-6)
DCA SC2
/INIT SEGMENT SCAN
SC3, TAD I SEGM /-NR ENTRIES
SNA
JMP SC4
DCA SC5
/SET TO FIRST STARTING BLOCK
TAD SEGM
IAC
DCA T
TAD I T /START BLOCK
DCA ST
DCA LEN /NO PREVIOUS FILE LENGTH
/FIND SIZE OF EACH ENTRY
TAD (4)
TAD SEGM
DCA T
TAD I T /-NR OF INFO WDS
CIA
TAD (5) /ENTRY SIZE
DCA SIZE
/LOCATE TO FIRST ENTRY
TAD T
IAC /FIRST ENTRY ADDR
DCA NENTRY
/PROCESS NEXT ENTRY
/CALCULATE BLOCK NR
SC7, TAD LEN /-(PREVIOUS FILE LENGTH)
CIA
TAD ST
DCA ST
/LOCATE TO NEXT ENTRY
TAD NENTRY
DCA ENTRY
/NOW LOCATE FOLLOWING ENTRY
TAD I ENTRY /IS CURRENT ENTRY EMPTY?
SZA CLA
JMP SC10 /NO - "SIZE" WDS LONG
TAD (2) /YES - 2 WDS LONG
SKP
SC10, TAD SIZE
TAD ENTRY
DCA NENTRY
/FIND LENGTH OF CURRENT ENTRY
STA
TAD NENTRY
DCA T
TAD I T
DCA LEN
/SKIP EMPTY FILE ENTRIES
TAD I ENTRY
SNA CLA
JMP SC8
/SKIP TENTATIVE FILE ENTRIES
/AND FILES OF LENGTH ZERO
TAD LEN
SNA CLA
JMP SC8
/FOUND A FILE ENTRY
/SAVE ENTRY POINTER FOR OUTPUT
STA /AUTO-INDEXED REFERENCE
TAD ENTRY
ENTRYA, DCA 11 /OR DCA 12
/RETURN
JMS SC
/MORE ENTRIES?
SC8, ISZ SC5
JMP SC7 /YES
/NO - LOCATE TO NEXT SEGMENT
SC4, TAD (2)
TAD SEGM
DCA T /ADDR OF LINK WD
TAD I T
SNA
JMP SC11 /NO MORE SEGS
/CONVERT BLOCK NR TO BASE ADDR FOR SEG
TAD (-1)
CLL RTR;RTR;RAR /(BLOCK-1)*400
DCA SEGM
ISZ SC2 /HAVE 6 SEGS BEEN SCANNED?
JMP SC3 /NO - OK
/ERROR: ATTEMPT TO LINK TO MORE THAN 6 SEGMENTS (IGNORE)
/OTHERWISE SCAN IS DONE
SC11, CDF CUR /RESTORE FIELD
JMP I SCAN /"DONE" RETURN
/LOCAL VARIABLES FOR "SCAN"
SC2, 0 /SEGMENT COUNTER
SC5, 0 /ENTRY COUNTER
SIZE, 0 /SIZE OF EACH ENTRY
ENTRY, 0 /POINTER TO NEXT ENTRY
SEGM, 0 /BASE ADDR OF CURRENT DIR SEG
NENTRY, 0 /ADDR OF NEXT ENTRY
/LOCAL VARIABLE LIST FOR SAVING/RESTORING
SCVAR, SC /MUST COME FIRST
SCFLD /MUST COME 2ND
ENTRYA /MUST COME 3RD
SC2
SC5
SIZE
ENTRY
SEGM
NENTRY
ST
LEN
0
PAGE
/PARAMETERS FOR CALLS TO "SCAN"
DIR1, SC1 / (SC) INITIALIZE THIS LOC
CDF F1 / (SCFLD) FIELD OF DEV 1 STUFF
DCA 11 / (ENTRYA) WHERE TO PUT ENTRY ADDR FOUND
ZBLOCK 10 /REST OF VARIABLES
DIR2, SC1 /INITIALIZE THIS LOC
CDF F2
DCA 12
ZBLOCK 10
/OUTPUT ROUTINES
/PRINT CHAR
/ INPUT: AC=CHAR (7 OR 8 BIT)
PRINT, 0
PRSW, JMP PRT /CHANGES TO NOP
CDF PF
DCA I PRBUFP
CDF CUR
ISZ PRBUFP
JMP I PRINT
/TERMINAL OUTPUT INITIALLY
PRT, TLS
TSF
JMP .-1
CLA
JMP I PRINT
/DUMP OUTPUT BUFFER
DUMP, 0
TAD (232) /CTRL/Z=END OF FILE
JMS PRINT
JMS I ODEVH
6600+PF /WRITE UP TO 26 PAGES, FIELD PF
PRBUF /ADDR
1 /BLOCK (UNUSED)
JMP ERR2
JMP I DUMP
/CRLF
CRLF, 0
TAD (215)
JMS PRINT
TAD (212)
JMS PRINT
JMP I CRLF
/PRINT 4-DIGIT DECIMAL NR
/DOES NOT USE T2
PRINTN, 0
DCA T
TAD (PTAB-1)
DCA 10
TAD (-4)
DCA T3
/PRINT NEXT DIGIT
/SET UP NEXT DIVISION
PN1, TAD I 10
DCA T4
DCA T5
/DIVISION LOOP
PN2, TAD T
TAD T4
SPA
JMP PN3
ISZ T5 /COUNT SUCCESSFUL SUBTRACT
DCA T /RESTORE DIVIDEND
JMP PN2
/PRINT THE DIGIT
PN3, CLA
TAD T5
TAD ("0) /CONVERT TO ASCII
JMS PRINT
ISZ T3 /4 DIGITS YET?
JMP PN1 /NO
JMP I PRINTN /YES, RETURN
/TABLE OF POWERS OF TEN
PTAB, -1750;-144;-12;-1
/TYPE A MESSAGE
TYPE, 0
DCA PRINTN
TYP1, TAD I PRINTN
RTR;RTR;RTR
JMS TYP2
TAD I PRINTN
JMS TYP2
ISZ PRINTN
JMP TYP1
TYP2, 0
AND (77)
SNA
JMP I TYPE /<00>=TERMINATOR
TAD (-37) /"_" MEANS END-OF-LINE (CRLF)
SNA
JMP TYP3
TAD (37) /RESTORE AC AFTER TEST
JMS PRINTH
JMP I TYP2
TYP3, JMS CRLF
JMP I TYP2
/PRINT 6-BIT CHAR IN RIGHT HALF OF AC
PRINTH, 0
AND (77)
SZA
TAD (240)
AND (77)
TAD (240)
JMS PRINT
JMP I PRINTH
PAGE
/TEXT STRINGS
M2, TEXT "PLEASE USE FORMAT: LISTDEV:<FILEDEV1:,FILEDEV2:_"
M3, TEXT "FATAL I/O ERROR_"
M4, TEXT " MATCH BUT HAVE ZERO LENGTH_"
M5, TEXT "_THE FOLLOWING FILE(S) DID NOT MATCH:_"
M6, TEXT "COMPAF V?? FILE COMPARISON REPORT_"
ZZ=.
*M6+4
VERSION+"0&77^100+PATCH
*ZZ
M7, TEXT "AN I/O ERROR OCCURRED IN ONE OF THE FILE PAIR "
M8, TEXT " (DECIMAL) FILE PAIRS HAVING THE SAME NAME FOUND_"
M9, TEXT " MATCHED EXACTLY, "
M10, TEXT " DID NOT MATCH_"
M11, TEXT " EXTRA FILES FOUND ON FIRST DEVICE_"
M12, TEXT " EXTRA FILES FOUND ON SECOND DEVICE_"
M13, TEXT " CONTAINED I/O ERRORS_"
/END OF COMPAF