File: OCOMP.PA of Tape: OS8/OS8-V40/v40-2
(Source file text)
/ OCTAL COMPARE V40
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1980 BY DATAPLAN GMBH, LAUDA, BRD
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DATAPLAN GMBH.
/DATAPLAN GMBH ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR
/IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DATAPLAN'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DATAPLAN.
/
/DATAPLAN GMBH ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DATAPLAN.
/
/
/
/
/
/
/
/
/
/
/
/WVDM, DP, ZUERICH, FEB-1980
/ OCOMP.PA 78.04.03 OCTAL COMPARE AND DUMP
/ 1/24/77 LATEST MOD
/ BY:
/ DENNIS MCGHIE
/ DEPT. OF CARDIOVASCULAR SURGERY
/ STANFORD MEDICAL CENTER
/ STANFORD, CALIF. 94305
/ 1978 APRIL 3 MODIFIED FOR OS/8 V3D (FIXED CCB MASK)
/ 2ND INPUT DEVICE WITH NO FILENAME NOW USES 1ST FILENAME
/ TIM CLARKE MENLO COMPUTER ASSOCIATES
/ BOX 298
/ MENLO PARK, CALIFORNIA 94025
/
/ WVDMARK GERMAN MESSAGES
/
GERMAN=1
/
/ OCOMP IS AN OS/8 UTILITY PROGRAM USED TO
/ COMPARE OR DUMP OS/8 FILES. BOTH MASKING AND
/ SEARCHING ARE ALLOWED. THE MASK IS ENTERED BY
/ THE "=" OPTION (ONLY THE LEAST SIGNIFICANT 12
/ BITS ARE USED) AND FOR CONVENIENCE, A MASK OF 0000
/ IS CHANGED TO 7777 UNLESS /S IS SPECIFIED.
/ THE SEARCH FEATURE IS SPECIFIED BY THE "/S" OPTION.
/ ALL OUTPUT IS IN OCTAL.
/ A. THE THREE MODES OF OPERATION ARE:
/
/ 1. COMPARE: TWO INPUT FILES SPECIFIED ARE
/ COMPARED WORD-FOR-WORD UNDER THE MASK,
/ ANY DIFFERENCES CAUSE THE OCTAL VALUE
/ OF THE UNMATCHED WORDS TO BE PUT IN THE
/ OUTPUT FILE.
/
/ 2. DUMP: ONLY ONE INPUT FILE IS SPECIFIED AND
/ IT IS DUMPED (IN OCTAL) TO THE OUTPUT FILE.
/ IF A MASK IS SPECIFIED, ONLY THOSE WORDS
/ WITH ALL MASKED BITS IN THE 1 STATE ARE
/ OUTPUT.
/
/ 3. SEARCH: ONLY ONE INPUT FILE IS SPECIFIED,
/ ALONG WITH "/S". ONLY THOSE WORDS EQUAL TO
/ THE MASK ARE DUMPED TO THE OUTPUT FILE.
/
/
/ B. IN ADDITION, IF /I IS SPECIFIED, THE ABOVE
/ MODES ARE AVAILABLE, BUT THE INPUT FILES ARE
/ ASSUMED TO BE "SAVE" FILES. THE CCB IS DECODED
/ AND COMPARISONS ARE BY MEMORY ADDRESS, RATHER
/ THAN RELATIVE BLOCK NUMBER.
/
/
/ C. IF /C IS SPECIFIED IN ADDITION TO /I, THE
/ DECODED CCB WILL BE PRINTED AS PART OF THE TITLE.
/
/
/ D. DIFFERENCES: A SPECIAL MODE IS AVAILABLE WHEN /D
/ IS SPECIFIED. IN THIS CASE, TWO FILES ARE
/ CHECKED FOR DIFFERENCES ONLY.
/
/ OUTPUT WILL BE EITHER
/ "FILES SAME"
/ OR "FILES DIFFERENT"
/
/
/ E. IF /F IS SPECIFIED, ANY BLOCK WHICH PRODUCES
/ OUTPUT WILL HAVE A FORM FEED CHARACTER PRECEEDING
/ ITS HEADER LINE. THIS MODE IS USEFUL WHEN THE
/ OUTPUT IS TO A SCOPE.
/
/
/ F. IF /T IS SPECIFIED, THE OUTPUT FORMAT IS CHANGED
/ SO THAT IT WILL FIT ON THE 72 CHARACTER LINE OF
/ A TELETYPE.
/
/
/ G. A HEADER LINE IS NORMALLY PRINTED IN THE OUTPUT FILE
/ UNLESS THE OUTPUT IS TO TTY:. /H WILL CAUSE THE
/ HEADER TO BE PRINTED EVEN IF OUTPUT IS TO TTY:
/
/ OTHER PROGRAM ACTIONS:
/ A. SPECIFYING NO INPUT FILE WILL CAUSE A RETURN
/ TO THE COMMAND DECODER. IF A SECOND INPUT
/ DEVICE IS SPECIFIED WITHOUT A FILENAME, THE
/ FILENAME FROM THE FIRST INPUT SPECIFICATION
/ IS USED.
/ B. "USER ERROR ..." MESSAGES WILL BE OUTPUT
/ UNDER THE FOLLOWING CONDITIONS:
/ ERROR CONDITION
/ 1 MORE THAN TWO INPUT FILES.
/ 2 OUTPUT FILE TOO SMALL.
/ 3 OUTPUT HANDLER FETCH OR ENTER FAILED.
/ 4 INPUT HANDLER FETCH OR LOOKUP FAILED.
/ 5 INPUT FILE #1 ERROR.
/ 6 INPUT FILE #2 ERROR.
/ 7 OUTPUT FILE ERROR.
/ 8 OUTPUT FILE CLOSE FAILED.
/ 9 INVALID CCB IN /I INPUT FILE.
/ C. "NO OUTPUT" OR "NO DIFFERENCES" WILL BE PUT
/ IN THE OUTPUT FILE IF NOTHING ELSE IS OUTPUT.
/ D. THE DEFAULT INPUT EXTENSION IS ".SV" IF /I
/ OTHERWISE NO DEFAULT IS APPLIED.
/ E. THE DEFAULT OUTPUT DEVICE IS TTY:
/ F. THE DEFAULT OUTPUT EXTENSION IS ".LS".
/ COMMAND DECODER USAGE:
/ .R OCOMP
/ *OFILE < IFILE1 [,IFILE2] [(OPTIONS)] [=NNNN]
/ ITEMS IN [...] ARE OPTIONAL.
/ ASSEMBLY INFORMATION:
/ .R PAL8
/ *OCOMP<OCOMP/L$
/ .SAVE ... OCOMP;12000=6403
/
/ PAGE 0 DEFINITIONS:
IWD1= 0 / INPUT 1 BUFFER PTR
IWD2= 1 / INPUT 2 BUFFER PTR
DUMPSW= 2 / = 0 IF COMPARE MODE, = 1 IF DUMP MODE
DUMP2S= 3 / = 1 IF FILE 2 IS LONGER THAN FILE 1
RELBLK= 4 / RELATIVE BLOCK NUMBER
RELBK2= 5 / RELATIVE BLOCK NUMBER (FILE 2), IF /I
INH1= 6 / INPUT HANDLER 1 ENTRY
XR10= 10
XR11= 11
XR12= 12
XR13= 13
XR14= 14
INH2= 20 / INPUT HANDLER 2 ENTRY
SLASHD= 21 / = 400 IF /D, = 0 OTHERWISE
SLASHI= 22 / = 10 IF /I, = 0 OTHERWISE
OUTH= 23 / OUTPUT HANDLER ENTRY
OCNT= 24 / OUTPUT BUFFER TRIPLET COUNTER
TMP= 25
IBLEN= 26 / INPUT BUFFER LENGTH IN BLKS
EBCNT= 27 / EMPTY BUFFER CTR
LPBLK= 30 / LINES PER BLOCK (100 OR 40)
NGRPS= 31 / # GROUPS PER LINE COUNTER
SEGSIZ= 32 / SEGMENT SIZE = # CHARS IN NGRPS
PGPTR1= 33 / PAGE TABLE POINTER FILE 1
PGPTR2= 34 / PAGE TABLE POINTER FILE 2
ANYOUT= 35 / = 0 IF NOTHING OUTPUT, OTHERWISE = 1
/ 00000-01777 (COMMAND DECODER)
/ 01200- (CD LINE BUFFER)
IBUF1= 2000 / 02000-03777 (INPUT BUFFER, FILE 1)
IBUF2= 4000 / 04000-05777 (INPUT BUFFER, FILE 2)
/ 06000-06177 (UNUSED)
OHAND= 6201 / 06200-06577 (OUTPUT HANDLER PAGES)
IHAND1= 6601 / 06600-07177 (INPUT 1 HANDLER PAGES)
IHAND2= 7201 / 07200-07577 (INPUT 2 HANDLER PAGES)
/ 10000-11777 (USR & SCRATCH STORAGE)
LBUF1= 1400 / 11400-11577 (LINE BUFFER 1)
LBUF2= 1600 / 11600-11777 (LINE BUFFER 2)
/ 12000-15377 (PROGRAM)
OBUF= 5400 / 15400-16377 (OUTPUT BUFFER)
PGTAB1= 6400 / 16400-16777 (/I PAGE TABLE 1)
PGTAB2= 7000 / 17000-17377 (/I PAGE TABLE 2)
/ 17400-17577 (PROGRAM)
USR= 200
M1C= STA
M2C= STA CLL RAL
M3C= STA CLL RTL
P1C= CLA IAC
P2C= STL CLA RTL
P2000C= STL CLA RTR
FIELD 1
*2000
OCSTA, TAD (6403 / PROPER JSW VALUE
CDF 0
DCA I (7746 / DON'T TRUST USER
CDF 10 / BACK TO THIS FIELD
JMS I (7700 / CALL USR
P10, 10 / USRIN
STAR1, JMS I (USR / CALL USR
5 / DECODE
5200 / SPECIAL MODE
TAD I A7605
SNA CLA
JMP ALT / NO INPUT FILE, CHECK FOR ALT MODE
TAD I (7617
SZA CLA / A 3RD INPUT SPECIFIED?
JMS ERROR1 / YES-BAD NEWS
JMS PAGSET / SET PAGE SIZE PARAMS (USE /T AS SWITCH)
/ ALSO INIT OUTPUT BUFFER PARAMS
TAD I (7643
AND P10 / MASK FOR /I
DCA SLASHI / 0=NOT SET, 10=SET
JMS DEFALT / GO SET FILE DEFAULTS
TAD I (7643
AND (400 / MASK FOR /D
DCA SLASHD / 0=NOT SET, 400=SET
/ INITIALIZE THE SEARCH/COMPARE MASK
TAD I (7646 / GET LOW 12 BITS OF "="
SNA / USE AS IS IF NON-ZERO
PCMA, CMA / OTHERWISE USE ALL 1'S
DCA MASK / SET UP THE MASK
TAD I (7646
DCA DMASK / ALSO SET UP THE DUMP AND SEARCH MASK
TAD PCMA
DCA CHP1
TAD (DMASK&177!200 / "AND DMASK"
DCA CHP3
TAD (4410
DCA OFUNWD / OUTPUT FUNCTION WORD IN WRITE
P2C
DCA WBLN / OUTPUT BUFFER LENGTH
TAD (OHAND
DCA OHANA / RESET FETCH HANDLER WORD
TAD I (7600 / GET OUTPUT DEVICE NUMBER
JMS I (USR
1 / FETCH
OHANA, OHAND / BECOMES ENTRY POINT
JMS ERROR3 / FETCH FAILED
TAD OHANA
DCA OUTH / OUTPUT HANDLER ENTRY ADDRES ON PAGE 0
TAD (7601
DCA STBLK / RESET NAME PTR
TAD I (7600 / REGET DEVICE NUMBER
JMS I (USR
3 / ENTER
STBLK, 7601 / NAME POINTER (BECOMES START BLOCK)
MLEN, 0 / BECOMES -LENGTH OF FILE
JMS ERROR3 / ENTER FAILED
TAD STBLK
DCA OBLK / CURRENT OUTPUT BLOCK #
DCA FULLSW / CLEAR OUTPUT FILE FULL SWITCH
M1C
DCA EBCNT / FORCE READ TO START
DCA ANYOUT
DCA RELBLK
DCA DUMPSW
DCA DUMP2S
JMS FLGET / OPEN INPUT 1
IHAND1
INH1
A7605, 7605
BLEFT1
INBLK1
EBLK1
DCA ISTB1
TAD I (7612 / GET 2ND INPUT DEVICE NUMBER
SZA CLA / SPECIFIED?
JMP TWOIN / YES
/ ONLY ONE INPUT FILE WAS SPECIFIED
ISZ DUMPSW / SET DUMP SWITCH
TAD NGRPS
CLL RAL / TWICE AS MANY IF DUMP MODE
DCA NGRPS
TAD P10
DCA IBLEN / DOUBLE LENGTH OF INPUT BUFFER
P2000C
DCA IFNWD1 / NEW FUNCTION WORD FOR READ (20 PGS, NOT 10)
TAD LPBLK
STL RAR / NEG DIV BY 2
DCA LPBLK / HALF AS MANY LINES PER BLOCK
TAD I (7644 / CHECK FOR /S
AND (40
SNA CLA
JMP DOIT
ISZ CHP1 / /S CHANGES THE CMA TO A CIA
TAD (DMASK&177!1200 / "TAD DMASK"
DCA CHP3 / ALSO CHANGES THE AND TO A TAD
JMP DOIT
PAGE
/ SECOND INPUT SPECIFIED
TWOIN, TAD (1000
DCA IFNWD1
TAD (4
DCA IBLEN / INPUT BUFFER LENGTH (4 BLOCKS)
JMS FLGET / OPEN INPUT 2
IHAND2
INH2
A7612, 7612
BLEFT2
INBLK2
EBLK2
DCA ISTB2
DOIT, TAD SLASHI / /I SWITCH
SNA CLA / SET?
JMP DOLOOP-1 / NO-INITIALIZATION FINISHED
JMS CCBZER / ZERO THE PAGE TABLES
JMS READ1 / FILL 1ST BUFFER
JMS MOVEBL / MOVE A BLOCK
IBUF1-1 / FROM HERE
OBUF-1 / TO HERE
JMS CCBDEC / DECODE FILE 1 CCB
CCBG1-1 / POINT TO FILE 1 PARAMETER TABLE
TAD DUMPSW / ONLY ONE FILE SWITCH
SZA CLA / SET?
JMP DOLI / YES-ONLY ONE FILE
JMS READ2
JMS MOVEBL
IBUF2-1
OBUF+400-1
JMS CCBDEC / DECODE 2ND CCB
CCBG2-1 / POINT TO FILE 2 PARAMETER TABLE
DOLI, JMS TITLE / PRINT RUN TITLE
TAD I (7643
AND (1000 / MASK FOR /C
SZA CLA / SET?
JMS CCBOUT / YES-PRINT CCB(S)
TAD (PGTAB1
DCA PGPTR1 / PAGE TABLE POINTER (FILE 1)
TAD (PGTAB2
DCA PGPTR2 / PAGE TABLE POINTER (FILE 2)
TAD (-200
DCA PGCTR / 400 PAGES IN MAX MACHINE
DOLIL, JMS SETSW / SET DUMPSW & DUMP2S ACCORDING TO PGPTRS
JMS READIN / SETUP BUFFER PTR(S) IF PAGES USED
JMS SETSW / CALL AGAIN TO SAVE A WORD
JMS DOUT / SEND A "PAGE"
ISZ PGPTR1 / BUMP FOR 2ND PAGE OF PAIR
ISZ PGPTR2
JMS SETSW / CHECK SWITCHES AGAIN
JMS DOUT / IT IS USED, OUTPUT A "CORE PAGE"
ISZ PGPTR1 / BUMP PTRS AGAIN
ISZ PGPTR2
ISZ PGCTR / SCANNED ALL PAGES?
JMP DOLIL / NO
JMP FINISH / YES
PGCTR, 0 / PAGE TABLE PAIR COUNTER
BLEFT1, 0 / BLOCKS LEFT IN INPUT 1
BLEFT2, 0 / BLOCKS LEFT IN INPUT 2
JMS TITLE / PRINT RUN TITLE
DOLOOP, JMS READIN / COPE WITH BUFFER FILLING
JMS DOUT / OUTPUT THE BLOCK
ISZ RELBLK / BUMP RELATIVE BLK #
ISZ BLEFT2 / BUMP INPUT 2 LENGTH CTR
JMP DO3 / NOT EMPTY YET
TAD DUMP2S / 2ND FILE EMPTY, CHECK IF DUMPING
SZA CLA / 2ND DUMP MODE?
JMP FINISH / YES-THRU
ISZ DUMPSW / NO-GO TO 1ST DUMP MODE
DO3, ISZ BLEFT1 / BUMP INPUT 1 LENGTH CTR
JMP DOLOOP / GO BACK & DO MORE
ISZ DUMP2S / SET 2ND DUMP SWITCH
TAD DUMPSW / 1ST FILE EMPTY
SNA CLA / DUMP MODE ALREADY?
JMP DOLOOP / NO-KEEP GOING
/ YES-FINISH OUTPUT & CLOSE
FINISH, TAD SLASHD / GET /D SWITCH
SNA CLA / SET?
JMP FINI / NO-NORMAL
TAD ANYOUT / YES-SHORTENED OUTPUT
SZA CLA / ANY DIFFERENCES?
TAD (MESNC-MESND/ "DIFFERENT"
TAD (MESND-1 / "SAME"
JMP FINC
FINI, TAD ANYOUT / NOT 0 IF ANYTHING OUTPUT
SZA CLA / ANYTHING?
JMP DONE / YES-DONE
TAD I A7612 / 2ND INPUT DEVICE #
SNA CLA
TAD (MESNA-MESNB/ "NO OUTPUT"
TAD (MESNB-1 / "NO DIFFERENCES"
FINC, JMS PUTSTR
JMS CRLF
JMP DONE
PAGE
IF1, ZBLOCK 12 / INPUT FILE NAMES
IF2= IF1+5 / FOR .SV DEFAULT EMULATION
DONE, TAD (232 / "^Z (EOF)
JMS PACK / TO OUTPUT FILE BUFFER
TAD OCNT / BUFFER CHAR COUNTER
TAD (1400 / RESET VALUE IS -1400
SNA / AT START?
JMP DONE2 / YES-GO CLOSE NOW
TAD (-600 / NO-WRITE LAST BUFFER
SMA SZA CLA
IAC
IAC
DCA WBLN
TAD WBLN
CLL RTR;RTR;RTR
TAD (4010
DCA OFUNWD / NEW FUNCTION WORD FOR CALL TO OUTPUT HANDLER
DONE1, JMS PACK / KEEP PACKING 0'S UNTIL BUFFER IS DUMPED
TAD OCNT
TAD (1400 / RESET VALUE IS -1400
SZA CLA / DUMPED BUFFER YET?
JMP DONE1 / NO-FILL WITH 0'S
DONE2, TAD STBLK
CIA
TAD OBLK
DCA NOUT / # BLOCKS IN OUTPUT FILE
DCA 7 / FORCE USR TO REREAD DIRECTORY
TAD I (7600 / GET OUTPUT DEVICE #
JMS I (USR
4 / CLOSE
7601 / NAME PTR
NOUT, 0 / # BLKS IN OUTPUT
JMS ERROR8 / CLOSE FAILED!!
ALT, TAD I (7642 / GET ALT MODE BIT
SMA CLA / ALT MODE IS BIT 0
JMP STAR1 / NOT SET, CALL CD AGAIN
GIVEUP, CDF CIF 0
JMP I (7600 / RETURN TO OS/8
/ SET IMAGE FILE SWITCHES
/ RETURN TO CALL+1 IF EITHER SWITCH SET
SETSW, 0000
DCA DUMPSW / CLEAR SWITCHES FOR CHECK
DCA DUMP2S
TAD I PGPTR1 / CHECK FOR FILE 1 PAGE
SNA CLA / USED?
ISZ DUMP2S / NO-BUMP 2 ONLY SWITCH
TAD I PGPTR2 / CHECK FOR FILE 2 PAGE
SNA CLA / USED?
ISZ DUMPSW / NO-BUMP 1 ONLY SWITCH
M2C
TAD DUMPSW
TAD DUMP2S
SNA CLA / EITHER PAGE SWITCH SET?
ISZ SETSW / NEITHER PAGE USED, SKIP CALL+1
JMP I SETSW
/ INITIALIZE INPUT BUFFER PARAMETERS
IINIT, 0000
TAD (IBUF1
DCA IWD1 / INPUT 1 WORD PTR
TAD (IBUF2
DCA IWD2 / INPUT 2 WORD PTR
TAD SLASHI
SNA CLA
JMP .+3
M1C
JMP .+3
TAD IBLEN
CIA
DCA EBCNT / INPUT BUFFER BLOCK COUNTER
JMP I IINIT
/ CHECK DUMPSW
/ GO TO ADDR THAT IS ARG1 IF IT IS SET
DCHK, 0000
TAD I DCHK / GET SET ADDRESS
DCA TMP / SAVE IT
ISZ DCHK / POINT TO OK RETURN
TAD DUMPSW / GET SWITCH
SZA CLA / CLEAR?
JMP I TMP / NO-GO TO ARG ADDR
JMP I DCHK / YES-RETURN
/ MOVE A BLOCK FROM FIELD 0 TO FIELD 1
/ ARGS ARE SOURCE & DESTINATION ADDRESSES-1
MOVEBL, 0000
TAD I MOVEBL
DCA XR10
ISZ MOVEBL
TAD I MOVEBL
DCA XR11
ISZ MOVEBL
TAD (-400
DCA TMP
CDF 0
TAD I XR10
CDF 10
DCA I XR11
ISZ TMP
JMP .-5
JMP I MOVEBL
PAGE
/ THIS ROUTINE DECIDES WHAT TO SEND OUT
/ & PUTS IT IN THE LINE BUFFER(S)
COMPAR, 0000
CDF 0
TAD DUMPSW
SZA CLA
JMP CDMP1 / ONLY FILE 1
TAD DUMP2S
SZA CLA
JMP CDMP2 / ONLY FILE 2 LEFT
TAD I IWD1
AND MASK
DCA TMP
TAD I IWD2
AND MASK
CIA
TAD TMP
SZA CLA
JMP COMB / DIDN'T MATCH, DUMP THEM
COMC, CDF 10 / MATCHED, PACK 4 BLANKS
JMS BLOUT
JMS BLOUT
JMS BLOUT
JMS BLOUT
COMA, ISZ IWD1
ISZ IWD2
JMP I COMPAR
CDMP1, TAD I IWD1 / IN DUMP, MASK BITS MUST BE ON IN DATA
JMS CHMSK / COMPARE VALUE TO MASK VALUE
TAD I IWD1 / REGET WORD & SEND IT OUT
CDF 10
JMS OCTOUT
LPACK1
JMP COMN
CDMP2, TAD I IWD2
JMS CHMSK / CHECK AGAINST MASK
TAD I IWD2
CDF 10
JMP COME
COMB, TAD I IWD2
DCA TMP
TAD I IWD1
CDF 10
JMS OCTOUT
LPACK1
TAD TMP
COME, JMS OCTOUT
LPACK2
COMN, ISZ NONBL / NOT 0 IF NON-BLANK OUTPUT ON THIS LINE
JMP COMA
MASK, 0
DMASK, 0
/ IN SEARCH ("/S" SPECIFIED), THE "CMA" IS CHANGED
/ TO "CIA", THE "AND" IS CHANGED TO A "TAD", AND
/ THE WORD MUST BE EQUAL TO THE MASK TO MATCH.
CHMSK, 0000
CHP1, CMA / CIA IF /S
CHP3, AND DMASK / TAD IF /S
SZA CLA / REQUIRED BITS ON?
JMP COMC / NO-OUTPUT BLANKS
JMP I CHMSK / RETURN TO PRINT IT
IFNDEF GERMAN <
MESB, TEXT "RELATIVE BLOCK "
MESL, TEXT " ( ABSOLUTE BLOCK "
MESR, TEXT " )"
MESC1, TEXT "S.A.= "
MESC2, TEXT "JSW= "
MESC3, TEXT "CORE="
MESNA, TEXT "NO OUTPUT"
MESNB, TEXT "NO DIFFERENCES"
MESNC, TEXT "DIFFERENT"
MESND, TEXT "SAME"
TXFL, TEXT "FILES "
>
IFDEF GERMAN <
MESB, TEXT \RELATIVES BLOCK \
MESL, TEXT \ ( ABSOLUTES BLOCK \
MESR, TEXT \ )\
MESC1, TEXT \START=\
MESC2, TEXT \JSW = \
MESC3, TEXT \SPEICHER:\
MESNA, TEXT \KEIN AUS:-GERAET\
MESNB, TEXT \KEIN UNTERSCHIED\
MESNC, TEXT \VERSCHIEDEN\
MESND, TEXT \IDENTISCH\
TXFL, TEXT \DATEIEN \
>
PAGE
/ PUT OUT LPBLK LINES
/ INITIALIZATION ALREADY COMPLETE
DOUT, 0000
TAD LPBLK
DCA LNCNT / # OF LINES COUNTER
/ OUTPUT TO THE LINE BUFFER
DOUL, TAD (LBUF1-1
DCA XR13 / LINE BUFFER PTR
TAD XR13
DCA MAX1
TAD (LBUF2-1
DCA XR14 / 2ND LINE BUFFER PTR
TAD XR14
DCA MAX2
TAD NGRPS
DCA BUNCH
TAD IWD1
AND (377 / STRIP TO OFFSET
DCA LINWD / SAVE IN CASE ANYTHING ON THIS LINE
DCA NONBL / CLEAR BLANK LINE SWITCH
LIN5, TAD (-4
DCA GROUP / 4 WORDS PER GROUP
JMS BLOUT / EXTRA BLANK BETWEEN GROUPS
LIN6, JMS BLOUT / BLANK BETWEEN NUMBERS
JMS COMPAR
ISZ GROUP / GROUP DONE?
JMP LIN6 / NO
ISZ BUNCH / ALL GROUPS DONE?
JMP LIN5 / NO
/ IF CURRENT LINE IS NON-BLANK (NONBL NOT 0),
/ PACK CURRENT LINE BUFFER INTO OUTPUT BUFFER
TAD NONBL
SNA CLA
JMP CR5 / BLANK LINE (JUST RESET BUFFER PARAMS)
TAD SLASHD / /D SWITCH
SZA CLA / DIFFERENCES ONLY?
JMP CR9 / YES-SETUP FINISH
TAD HOUT / HEADER OUTPUT SWITCH
SNA CLA / ALREADY OUTPUT FOR THIS BLOCK?
JMS HEADER / NO-SEND NOW
TAD MAX1
CMA
TAD (LBUF1-1
DCA CHCNT / # CHARS CTR
TAD (LBUF1-1
DCA XR13 / BUFFER 1 PTR
/ SETS UP LINE LABEL IN LINWD IF /I
/ PACKS FIELD DIGIT IF /I
/ PACKS SPACE IF NOT /I
TAD SLASHI / /I SWITCH
SZA CLA / CLEAR?
JMP .+3 / NO-GO DO REAL WORK
JMS PBL / YES-PACK A BLANK
JMP CR0
TAD PGPTR1 / PAGE TABLE POINTER
TAD (-PGTAB1 / -TABLE BASE ADDR
RTR;RTR;RAR
DCA TMP
TAD TMP
RAR
AND (7400
TAD LINWD
DCA LINWD / NOW AN ADDRESS, NOT JUST OFFSET
TAD TMP
JMS PDIG / PACK FIELD DIGIT
CR0, TAD LINWD / LABEL NUMBER (OFFSET OR ADDRESS)
JMS OCTOUT / = WORD OR ADDR OFFSET
APACK, PACK
JMS PBL / EXTRA BLANK BETWEEN LABEL & VALUES
JMP CR1E / IN CASE NO CHARS FOR FILE 1
CR1, TAD I XR13
JMS I APACK / SEND OUT EACH CHAR
CR1E, ISZ CHCNT
JMP CR1
TAD DUMPSW
SZA CLA / DUMP MODE?
JMP CR4 / YES-ONLY ONE OUTPUT SECTION
TAD SEGSIZ
TAD (-LBUF1-1
TAD XR13
JMS PMBL / # BLANKS TO START 2ND FILE
TAD MAX2
CMA
TAD (LBUF2-1
DCA CHCNT
TAD (LBUF2-1
DCA XR14
JMP CR2E / IN CASE NONE
CR2, TAD I XR14
JMS I APACK
CR2E, ISZ CHCNT
JMP CR2
CR4, JMS CRLF
CR5, ISZ LNCNT
JMP DOUL
JMP I DOUT
CR9, ISZ ANYOUT / NONZERO FOR DIFFERENCE
JMP FINISH / ALL THRU BECAUSE /D ONLY CHECKS FOR 1ST DIFF
NONBL, 0 / NON-BLANK LINE SW
CHCNT, 0
BUNCH, 0
GROUP, 0
LINWD, 0
LNCNT, 0
/ PUT A CHAR INTO THE LINE BUFFER 1
LPACK1, 0000
DCA I XR13
TAD XR13
DCA MAX1
JMP I LPACK1
MAX1, 0
/ PUT ONE IN BUF 2
LPACK2, 0000
DCA I XR14
TAD XR14
DCA MAX2
JMP I LPACK2
MAX2, 0
PAGE
/ READ FILE 1 INTO BUFFER
READ1, 0000
TAD IFNWD1
DCA IFNSV1 / SAVE FUNCTION WORD
TAD EBLK1 / -(LAST BLOCK+1)
TAD INBLK1 / ADD CURRENT BLOCK
STL / (FOR 13 BIT ARITH)
TAD IBLEN / ADD BUFFER LENGTH
SNA SZL / OK?
JMP RD11 / YES-GO READ IT
JMS ROR6 / NO-ADJUST FUNCTION WORD
CIA
TAD IFNSV1 / SUBTRACT SHORTAGE
DCA IFNWD1
RD11, CLA
CIF 0
JMS I INH1 / CALL HANDLER
IFNWD1, 1000 / FUNCTION (INPUT, 10 (OR 20) PAGES, DF=0)
IBUF1
INBLK1, 0
JMS ERROR5 / INPUT #1 ERROR
TAD IFNSV1
DCA IFNWD1 / RESTORE FUNCTION WORD
JMP I READ1
EBLK1, 0
/ READ FILE 2 INTO BUFFER
READ2, 0000
TAD IFNWD2
DCA IFNSV2 / SAVE FUNCTION WORD
TAD EBLK2 / -(LAST BLOCK+1)
TAD INBLK2 / ADD CURRENT BLOCK
STL / (FOR 13 BIT ARITH)
TAD IBLEN / ADD BUFFER LENGTH
SNA SZL / OK?
JMP RD21 / YES-GO READ IT
JMS ROR6 / NO-ADJUST FUNCTION WORD
CIA
TAD IFNSV2 / SUBTRACT SHORTAGE
DCA IFNWD2
RD21, CLA
CIF 0
JMS I INH2
IFNWD2, 1000
IBUF2
INBLK2, 0
JMS ERROR6 / INPUT #2 ERROR
TAD IFNSV2
DCA IFNWD2 / RESTORE FUNCTION WORD
JMP I READ2
IFNSV1= READ2
IFNSV2= READ1
EBLK2, 0
/ COPE WITH DIFFERENT TYPES OF BUFFER FILLING
READIN, 0000
DCA HOUT / HEADER NOT OUT SWITCH
ISZ EBCNT / INPUT BUFFER EMPTY?
JMP I READIN / NO
JMS CTRLC / CHECK FOR ^C STRUCK
JMS IINIT / SETUP INPUT POINTERS & COUNTER
TAD SLASHI / /I SWITCH
SZA CLA / WHICH KIND IF FILE?
JMP READII / /I (.SV)
TAD DUMP2S / 2ND ONLY SWITCH
SNA CLA / SET?
JMS READ1 / NO-READ 1ST FILE
TAD IBLEN / EITHER 4 OR 10
TAD INBLK1
DCA INBLK1 / BUMP FOR NEXT TIME
TAD DUMPSW / 1ST ONLY SWITCH
SNA CLA / SET?
JMS READ2 / NO-READ 2ND FILE
TAD IBLEN
TAD INBLK2
DCA INBLK2 / BUMP FOR NEXT TIME
JMP I READIN
/ /I SECTION
READII, TAD I PGPTR1 / GET FILE 1 RELATIVE PAGE
CLL RAR / CHANGE PAGE TO BLOCK OFFSET
DCA RELBLK / SAVE FILE 1 RELATIVE BLOCK #
TAD RELBLK
SNA / FILE ONE NEEDED?
JMP READI2 / NO-DO FILE 2
TAD ISTB1
DCA TMP / ABSOLUTE BLOCK # IN FILE 1
TAD INBLK1 / 1ST BLOCK IN BUFFER 1 NOW
JMS READIC / CALC WORD OFFSET FOR DESIRED BLOCK
JMP NEED1 / RETURN TO CALL+1 IF NEED TO READ BLOCK
TAD IWD1
DCA IWD1 / BUMP WORD POINTER
JMP READI2 / TRY 2ND FILE NOW
NEED1, CLA CLL / NEED TO READ FILE 1
TAD TMP / DESIRED BLOCK
DCA INBLK1 / WILL BE 1ST BLOCK IN BUFFER
JMS READ1
READI2, TAD I PGPTR2 / GET FILE 2 RELATIVE PAGE
CLL RAR / CHANGE PAGE TO BLOCK
DCA RELBK2 / SAVE FILE 2 RELATIVE BLOCK #
TAD RELBK2
SNA / NEEDED?
JMP I READIN / NO-THRU
TAD ISTB2
DCA TMP
TAD INBLK2
JMS READIC
JMP NEED2
TAD IWD2
DCA IWD2
JMP I READIN
NEED2, CLA CLL
TAD TMP
DCA INBLK2
JMS READ2
JMP I READIN
ISTB1, 0
ISTB2, 0
READIC, 0000
TAD IBLEN / ONE PAST END
CIA
TAD TMP / COMPARE TO DESIRED BLOCK
SMA
JMP I READIC / PAST END OF BUFFER. NEED TO READ FILE
TAD IBLEN
SPA
JMP I READIC / BEFORE START OF BUFFER. N.T.R.F.
JMS ROR6
RAL / (AC) IS WORD OFFSET FOR DESIRED BLOCK
ISZ READIC / SKIP N.T.R.F. RETURN
JMP I READIC
PAGE
/ PRINTS THE BLOCK HEADER INFORMATION
HEADER, 0000
JMS FCHK / CHECK FOR /F
JMS PUTSTR
MESB-1 / "RELATIVE BLOCK "
TAD SLASHI / /I SWITCH
SZA CLA / SET?
JMP HE1 / YES
TAD RELBLK / NO-JUST SEND RELBLK
JMS OCTOUT
PACK
JMP HE3 / GO DO ABSOLUTE PART
HE1, TAD RELBLK
DCA .+4
TAD RELBK2
DCA .+3
JMS COMHED / RELATIVE BLOCKS AS NEEDED
0
0
HE3, JMS PUTSTR
MESL-1 / " ( ABSOLUTE BLOCK "
TAD SLASHI / /I SWITCH
SZA CLA / SET?
JMP HE4 / YES
TAD RELBLK / NO
SKP
HE4, TAD RELBK2 / 2ND RELATIVE BLOCK
TAD ISTB2 / + 2ND START BLOCK
DCA HA2 / IS 2ND ABSOLUTE BLOCK
TAD RELBLK / 1ST RELATIVE BLOCK
TAD ISTB1 / + 1ST START BLOCK
DCA HA1 / IS 1ST ABSOLUTE BLOCK
JMS COMHED / SEND THE BLOCK NUMBER(S) OUT
HA1, 0
HA2, 0
JMS PUTSTR
MESR-1 / " )"
JMS CRLF
JMS PUTSTR / 2ND LINE OF HEADER
HMES-1 / " ADDR"
TAD DUMP2S
SZA CLA
JMP HE2
JMS HEAD2 / SEND IT OUT
TAD DUMPSW
SZA CLA / DUMP MODE?
JMP HE9 / YES-FINISHED
HE8, TAD (-2
DCA TMP
JMS PBL / SEND BLANKS UNTIL LINED UP WITH 2ND PART
ISZ TMP
JMP .-2
JMS HEAD2 / NOW SEND REST OF LABEL
HE9, JMS CRLF / END OF LINE
ISZ HOUT / NOT 0, HEADER OUTPUT
P1C / NOT 0
DCA ANYOUT / = 1 IF ANYTHING OUTPUT
JMP I HEADER
HE2, TAD SEGSIZ / =-25 OR -52
JMP HE8
HOUT, 0 / HEADER OUTPUT SWITCH
/ ROUTINE TO LABEL THE COLUMNS
HEAD2, 0000
TAD NGRPS / -# GROUPS PER LINE
DCA HGP / GROUPS PER LINE
DCA OFFV / OFFSET VALUE
HL5, TAD (-4
DCA HWD / 4 WORDS PER GROUP
JMS PBL / EXTRA BLANK BETWEEN GROUPS
HL6, M3C
JMS PMBL / 3 LEADING BLANKS
TAD OFFV / GET VALUE (2 DIGIT NUMBER)
CLL RTR;RAR / ROTATE 1ST DIGIT TO BITS 9-11
AND (7 / STRIP TO DIGIT
SNA / NOT 0?
JMP HL6B / NO-DON'T PRINT IT
JMS PDIG / PACK ASCII DIGIT
HL7, TAD OFFV / NOW 2ND DIGIT
JMS PDIG / PRINT THE DIGIT IN OUTPUT FILE
ISZ OFFV / BUMP FOR NEXT ONE
ISZ HWD / WORDS DONE?
JMP HL6 / NO
ISZ HGP / GROUPS DONE?
JMP HL5 / NO
JMP I HEAD2 / YES
HL6B, JMS PBL / PRINT BLANK INSTEAD OF LEADING 0
JMP HL7
HWD, 0
HGP, 0
OFFV, 0
IFNDEF GERMAN < HMES, TEXT " ADDR " >
IFDEF GERMAN < HMES, TEXT \ ZELLE\ >
/ COMMON HEADER INFO OUTPUT
/ JMS COMHED
/ ARG1= # IF NOT DUMP2S
/ ARG2= # IF NOT DUMPSW
/ #S SEPARATED BY " AND " IF BOTH OUTPUT
COMHED, 0000
TAD DUMP2S / FILE 2 ONLY SWITCH
SZA CLA / SET?
JMP CH1B / YES
TAD I COMHED / NO-OUTPUT 1ST #
JMS OCTOUT
PACK
TAD DUMPSW / FILE 1 ONLY SWITCH
SZA CLA / SET?
JMP CH1 / YES-THRU
JMS PUTSTR / NO-SEND SEPARATOR MESSAGE
MESS-1 / " AND "
CH1B, ISZ COMHED / POINT TO 2ND ARG
TAD I COMHED / OUTPUT 2ND #
JMS OCTOUT
PACK
CH1C, ISZ COMHED / POINT TO RETURN
JMP I COMHED
CH1, ISZ COMHED / POINT TO 2ND ARG
JMP CH1C / RETURN
IFNDEF GERMAN < MESS, TEXT " AND " >
IFDEF GERMAN < MESS, TEXT \ UND \ >
PAGE
/ PACK ONE ASCII DIGIT (OCTAL) IN OUTPUT BUFFER
PDIG, 0000
AND (7
TAD (260
JMS PACK
JMP I PDIG
/ SEND A BLANK TO THE OUTPUT ROUTINE
PBL, 0000
TAD (240
JMS PACK
JMP I PBL
/ PRINT MULTIPLE BLANKS IN OUTPUT BUFFER
/ CAN BE CALLED TWO WAYS LIKE PUTSTR
PMBL, 0000
SZA / METHOD SELECT
JMP .+3 / # BLANKS IN AC
TAD I PMBL / # BLANKS IN ARG1
ISZ PMBL / POINT TO RETURN
DCA PCNT / BLANK COUNT
JMS PBL / SEND A BLANK
ISZ PCNT / THRU?
JMP .-2 / NO-DO ANOTHER
JMP I PMBL
PCNT= PDIG
/ PACK CR,LF TO OUTPUT BUFFER
/ INSERT FORM FEED AFTER PROPER NUMBER OF LINES
CRLF, 0000
TAD (215 / "CR
JMS PACK
TAD (212 / "LF
JMS PACK
ISZ LINES / PAGE FULL?
JMP I CRLF / NO-RETURN
TAD (214 / YES-OUTPUT FORM FEED
JMS PACK
TAD NLNES
DCA LINES / RESET COUNTER
JMP I CRLF
LINES, -100 / LINES PER PAGE COUNTER
NLNES, -100 / LINES PER PAGE RESET VALUE
/ PUT 6 BIT TEXT TO OUTPUT ROUTINE
/ TWO CALLING METHODS
/ 1) TEXT ADDR-1 IN AC; RETURN TO CALL+1
/ 2) TEXT ADDR-1 IN ARG1; AC=0!; RETURN TO CALL+2
PUTSTR, 0000
SZA / METHOD 1?
JMP .+3 / YES-ARG IS IN AC
TAD I PUTSTR / NO-ARG IS IN CALL+1
ISZ PUTSTR / BUMP MODE 2 RETURN PTR
DCA PUTADR / SAVE TEXT PTR
PUT1, ISZ PUTADR / BUMP PTR TO NEXT WORD
TAD I PUTADR / GET NEXT PAIR OF CHARS
RTR;RTR;RTR / ROTATE 1ST HALF TO RIGHT 6 BITS
JMS TTO6 / TRANSLATE & OUTPUT
TAD I PUTADR / REGET WORD FOR RIGHT HALF
JMS TTO6 / TRANSLATE & SEND IT OUT ALSO
JMP PUT1 / KEEP GOING (RETURN IS THRU TTO6)
PUTADR= PDIG / STRING PTR FOR PUTSTR
/ TRANSLATE & OUTPUT 6 BIT ASCII
/ CHAR IS IN RIGHT HALF OF AC
/ LEFT HALF IS GARBAGE
/ (THIS IS PART OF PUTSTR!)
TTO6, 0000
AND (77 / STRIP OFF GARBAGE
SNA / 6 BIT 00 IS TERMINATOR
JMP I PUTSTR / EOT-RETURN
TAD (240
AND (77
TAD (240
JMS PACK / SEND 8 BIT ASCII
JMP I TTO6 / AC=0
/ PACK 8 BIT BYTES INTO OUTPUT BUFFER
/ USES OS/8 TEXT FORMAT
PACK, 0000 / OS/8 OUTPUT PACKING ROUTINE
JMP I PSW
PSW, PA1
ISZ OCNT
JMP I PACK
JMS WRITE
JMP I PACK
PA1, DCA I OWD / 1ST OF TRIP
JMS PSW
DCA PSAV / 2ND OF TRIP
JMS PSW
CLL RTL;RTL / 3RD OF TRIP
DCA PSW
TAD PSW
AND (7400
TAD I OWD
DCA I OWD / PACK 1ST HALF OF PAIR
ISZ OWD
TAD PSW
CLL RTL;RTL
AND (7400
TAD PSAV
DCA I OWD / PACK 2ND HALF
ISZ OWD
JMS PSW
JMP PA1
PSAV, 0
OWD, 0 / OUTPUT BUFFER PTR
/ OUTPUT AC AS 4 OCTAL DIGITS
/ ARG1 IS THE ADDRESS OF THE OUTPUT ROUTINE
OCTOUT, 0000
DCA OCTMP / SAVE VALUE
TAD I OCTOUT / GET OUTPUT ROUTINE PTR
DCA WPAK
TAD (-4
DCA DIGCNT / DIGIT CTR
OCL, TAD OCTMP
RTL;RAL
DCA OCTMP
TAD OCTMP
RAL
AND (7 / STRIP TO DIGIT
TAD (260 / MAKE ASCII
JMS I WPAK / GO TO OUTPUT ROUTINE
ISZ DIGCNT / DONE?
JMP OCL / NO-DO NEXT DIGIT
ISZ OCTOUT / YES-POINT TO RETN
JMP I OCTOUT
WPAK= PBL / POINTS TO OUTPUT ROUTINE
OCTMP= PMBL
DIGCNT= PDIG
/ PLACE A BLANK IN BOTH LINE BUFFERS
BLOUT, 0000
TAD (240
DCA I XR13
TAD (240
DCA I XR14
JMP I BLOUT
/ ROTATE AC RIGHT 6 BITS
/ SAVES SPACE THIS WAY
/ WOULD BE FASTER "IN LINE"
ROR6, 0000
CLL RTR;RTR;RTR
JMP I ROR6
PAGE
/ PRINT CORE ADDRESS RANGE
COROUT, 0000
DCA CORBL / LEADING BLANK COUNT
TAD I COROUT
DCA LIM / TABLE LIMIT
ISZ COROUT
TAD I COROUT / CURRENT PTR VALUE
DCA XR10
TAD I XR10 / SCAN UNTIL NON-ZERO
SNA CLA / NOW?
JMP .-2 / NO-KEEP LOOKING
TAD XR10 / COMPARE POINTER
TAD LIM / TO LIMIT VALUE
SMA SZA / PAST END?
JMP PGEOT / YES-ABORT
TAD (377 / CHANGE TO PAGE OFFSET
DCA CORL
TAD CORBL / REGET LEADING BLANK COUNT
SZA / ANY?
JMS PMBL / YES-GO PRINT THEM
DCA CORBL / RESET IF PRINTED
STA / AC=-1 FOR 1ST OF PAIR
JMS PAGOUT / PRINT 1ST PAGE ADDRESS
CORL, 0
TAD ("-
JMS PACK / PRINT SEPARATOR
TAD I XR10 / SCAN UNTIL ZERO
SZA CLA / NOW?
JMP .-2 / NO-KEEP LOOKING
STA / AC=-1
TAD XR10 / COMPARE PTR
TAD LIM / TO LIMIT
SMA / PAST END?
CLA / YES-FORCE BACK
TAD (377 / CHANGE TO OFFSET
DCA CORH
JMS PAGOUT / AC=0 FOR 2ND OF PAIR
CORH, 0
TAD LIM
TAD (377
CIA
TAD CORH
DCA I COROUT / UPDATE CURRENT POINTER
ISZ COROUT
PGEOT, ISZ COROUT
P7600, 7600 / CLA
JMP I COROUT
LIM= PGPTR2 / TWO NON-CONFLICTING USES FOR THE SAME LOCATION
CORBL, 0 / LEADING BLANK COUNT
/ DUMP CCB(S)
CCBOUT, 0000
JMS CRLF
JMS SAOUT / PRINT 5 DIGIT START ADDRESS
SF1, 0
SA1, 0
JMS DCHK / CHECK DUMP SWITCH
CO2 / GO HERE IF SET
TAD DELTAC
JMS PMBL / SPACE OVER TO 2ND START
JMS SAOUT / PRINT S.A.
SF2, 0
SA2, 0
CO2, JMS CRLF / NEW LINE
JMS JSWOUT / PRINT JSW
JSW1, 0
JMS DCHK / ONE ONLY CHECK AGAIN
CO4
TAD DELTAC
JMS PMBL
JMS JSWOUT
JSW2, 0
CO4, JMS CRLF
JMS PUTSTR
MESC3-1 / "CORE="
JMS DCHK
CO6
TAD (-6
TAD DELTAC
JMS PMBL
JMS PUTSTR
MESC3-1 / "CORE="
TAD (PGTAB1-1
DCA PGP1
TAD (PGTAB2-1
DCA PGP2
CO6, JMS CRLF
M2C
TAD DUMPSW
TAD DUMP2S
SNA CLA / BOTH SET NOW?
JMP I CCBOUT / YES-BYE
DCA DUMPSW / CLEAR FILE SWITCHES
DCA DUMP2S
TAD (-6 / INDENT ADDRESSES
JMS COROUT / PRINT FILE ONE PAGE RANGE
-PGTAB1-377 / TABLE LIMIT VALUE
PGP1, PGTAB1-1 / CURRENT POINTER VALUE (FILE 1)
ISZ DUMP2S / FILE ONE TABLE EMPTIED
TAD DUMP2S
SZA CLA / SET NOW?
TAD (-13 / YES-EXTRA BLANKS INSTEAD OF ADDRESSES
TAD DELTAC
TAD CORBL / ADD IN UNUSED PREVIOUS BLANKS
JMS COROUT / PRINT FILE TWO PAGE RANGE
-PGTAB2-377 / TABLE LIMIT VALUE
PGP2, PGTAB2-1 / CURRENT POINTER VALUE (FILE 2)
ISZ DUMPSW / FILE TWO TABLE EMPTIED
JMP CO6 / KEEP GOING
DELTAC, -52 / CCB DELTA FROM FILE1 TO FILE 2
PAGE
/ WRITE THE OUTPUT BUFFER
WRITE, 0000
JMS CTRLC
TAD FULLSW
SZA CLA / IS FILE FULL?
JMS ERROR2 / YES
CLA STL / 13 BIT ARITH
TAD WBLN / BUFFER LENGTH IN BLOCKS
TAD MLEN / -BLOCKS LEFT
SNA / EXACT FIT?
ISZ FULLSW / YES-SET SWITCH FOR NEXT CALL
DCA MLEN
SZA SNL / WON'T FIT?
JMS ERROR2 / YES-NO MORE ROOM
CIF 0
JMS I OUTH
OFUNWD, 4410 / FUNCT. (OUTPUT,4 PAGES,FIELD 1)
OBUF / BUFFER ADDRESS
OBLK, 0
JMS ERROR7 / OUTPUT ERROR
TAD WBLN
TAD OBLK
DCA OBLK / BUMP FOR NEXT TIME
JMS OINIT / RESET BUFFER POINTERS
JMS CTRLC / SAFE
JMP I WRITE
WBLN, 2 / BUFFER LENGTH IN BLOCKS (SHORTEN FOR LAST WRITE)
FULLSW, 0 / SET TO NONZERO IF LAST WRITE FILLED OUTPUT FILE
/ INITIALIZE OUTPUT BUFFER PARAMETERS
OINIT, 0000
TAD (OBUF
DCA OWD / OUTPUT POINTER
TAD (-1400
DCA OCNT / OUTPUT CHAR COUNTER
JMP I OINIT
/ OPEN INPUT FILE
FLGET, 0000
TAD I FLGET / GET HANDLER WORD (ARG1)
DCA FLHAND / BECOMES ARG TO FETCH
ISZ FLGET
TAD I FLGET / GET ENTRY WORD ADDRESS (ARG2)
DCA FDEVNT
ISZ FLGET
TAD I FLGET / GET FILE WORDS ADDR (ARG3)
DCA FDEVWD / POINTS TO DEVICE WORD
ISZ FLGET
TAD I FLGET / (ARG4)
DCA FLENPT / POINTS TO LENGTH WORD
ISZ FLGET
TAD I FLGET / (ARG5)
DCA FSTBWD / POINTS TO START BLOCK WORD
ISZ FLGET
TAD I FLGET / (ARG6)
DCA FEBWD / POINT TO END BLOCK WORD
ISZ FLGET / POINT TO RETN
TAD I FDEVWD / GET DEVICE #
JMS I (USR
1 / FETCH HANDLER
FLHAND, 0 / BECOMES ENTRY ADDR
JMS ERROR4 / FETCH FAILED
TAD FLHAND
DCA I FDEVNT / PUT ENTRY ADDR IN PG 0 WORD
TAD FDEVWD
IAC
DCA FLSTB / POINTS TO NAME WORDS
TAD I FLSTB // GET THE 1ST FILENAME WORD
SZA CLA // IS A FILENAME SPECIFIED?
JMP .+3 // YES, USE IT
TAD (7606) // NO, USE 1ST INPUT FILENAME
DCA FLSTB // SET UP POINTER TO IT
TAD I FDEVWD / GET DEVICE #
JMS I (USR
2 / LOOKUP
FLSTB, 0 / POINTS TO NAME. BECOMES ST BLK
FLEN, 0 / BECOMES -FILE LENGTH
JMS FLGER / LOOKUP ERROR
TAD FLEN
DCA I FLENPT / SAVE FILE LENGTH
TAD FLSTB
DCA I FSTBWD / SAVE FILE START BLOCK
TAD FLEN
CIA
TAD FLSTB
CIA
DCA I FEBWD / -(LAST BLOCK+1)
TAD FLSTB / RETURN WITH START BLOCK IN AC
JMP I FLGET
/ LOOKUP ERROR, TRY AGAIN WITHOUT DEFAULT EXTENSION
FLGER, 0000
F7600, 7600 / (AC) MAY NOT BE 0
TAD FDEVWD / FILE PTR
TAD (-7605 / 1ST FILE IS AT 7605
SNA CLA / WHICH ONE IS THIS?
TAD (IF1-IF2 / 1ST
TAD (IF2+1 / 2ND
DCA FLSTB2 / POINT TO PROPER NAME
TAD I FDEVWD / DO ANOTHER LOOKUP
JMS I (USR
2
FLSTB2, 0
0
JMS ERROR4 / REAL ERROR THIS TIME
TAD FLSTB2 / COPY RESULTS TO OTHER CALL
DCA FLSTB
TAD FLSTB2+1
DCA FLEN
JMP I FLGER
FDEVNT, 0 / POINT TO DEVICE ENTRY ADDR WORD
FDEVWD, 0 / POINT TO DEVICE WORD
FLENPT, 0 / POINT TO LENGTH WORD
FSTBWD, 0 / POINT TO START BLOCK WORD
FEBWD, 0 / POINT TO END BLOCK WORD
PAGE
/ SET INPUT AND OUTPUT FILE DEFAULTS HERE
DEFALT, 0000
/ INQUIRE ABOUT TTY: FOR DEFAULT AND /H INFORMATION
DCA .+4
JMS I (USR
12 / INQUIRE
5524 / TTY: ENCODED
TTDVNO, 0 / BECOMES DEVICE #
0 / BECOMES ENTRY ADDR (IGNORED)
D7600, 7600 / ERROR (IGNORE HERE, FETCH WILL FIND IT)
TAD I D7600 / OUTPUT DEVICE #
SNA / SPECIFIED?
TAD TTDVNO / NO-DEFAULT TO TTY:
DCA I D7600 / IN EITHER CASE, PUT IT IN PROPER PLACE
/ DEFAULT OUTPUT EXTENSION TO ".LS"
TAD I (7601 / 1ST WORD OF OUTPUT FILE NAME
SNA CLA / SPECIFIED?
JMP DS1 / NO-DON'T CHANGE EXTENSION
TAD I (7604 / YES-CHECK FOR SPECIFIED EXTENSION
SNA / SPECIFIED?
TAD (1423 / NO-FORCE ".LS"
DCA I (7604 / & PUT BACK
DS1, TAD SLASHI / /I SWITCH
SNA CLA / SET?
JMP I DEFALT / NO-DON'T APPLY DEFAULT INPUT EXTENSIONS
/ COPY INPUT FILE SPECS TO SAVE AREA
/ IN CASE "DEFAULT" EMULATION REQUIRED
TAD (7604 / INPUT AREA-1
DCA XR10
TAD (IF1-1 / SAVE AREA-1
DCA XR11
TAD (-12 / 12 WORDS IN TWO SPECS
DCA TMP
TAD I XR10 / COPY
DCA I XR11
ISZ TMP
JMP .-3
/ NOW SET INPUT DEFAULTS IF REQUIRED (/I & NO EXTENSION)
TAD I (7606 / YES-FORCE ".SV" IF NONE
SNA CLA / NAME THERE?
JMP DS3 / NO-NO EXTENSION
TAD I (7611 / YES-GET EXTENSION
SNA / THERE?
TAD (2326 / NO-FORCE ".SV"
DCA I (7611
DS3, TAD I (7613 / SAME STUFF FOR INPUT 2
SNA CLA
JMP DS3B / NO NAME
TAD I (7616 / GET EXTENSION
SNA
TAD (2326 / .SV IF NONE
DCA I (7616
DS3B, TAD LPBLK
STL RAR
DCA LPBLK / HALF AS MANY LINES PER "CORE PAGE"
JMP I DEFALT
/ TITLE:
/ PRINT RUN TITLE FROM CD LINE BUFFER
TITLE, 0000
TAD I (7642 / GET ALT MODE BIT
SZA CLA / SET?
JMS CRLF / YES-PRINT CRLF TO FORCE TITLE TO LEFT MARGIN
TAD I D7600 / GET OUTPUT DEVICE #
CIA
TAD TTDVNO / COMPARED TO TTY:
SNA CLA / SAME?
JMP HCHK / YES-ONLY PRINT HEADER IF /H
/ NO-PRINT HEADER
TITL0, TAD (1177
DCA XR10 / CD LINE BUFFER PTR
TITL, CDF 0 / BUFFER FIELD
TAD I XR10 / GET NEXT CHAR
CDF 10 / THIS FIELD
SNA / EOL?
JMP TITE / YES
JMS PACK / NO-PACK AC INTO BUFFER
JMP TITL
TITE, TAD SLASHD / GET /D SWTCH
SZA CLA / SET?
JMP TITD / YES
JMS CRLF / NO-END LINE
JMP I TITLE
TITD, TAD XR10
TAD (-1257 / CTR TO COL 60
SMA / PAST 60?
M1C / YES-PRINT ONE BLANK
JMS PMBL / SPACE OVER TO COLUMN 60
JMS PUTSTR
TXFL-1 / "FILES "
JMP I TITLE
HCHK, TAD (20 / MASK FOR /H
AND I (7643 / 1ST OPTION WORD
SZA CLA / SET?
JMP TITL0 / YES-GO PRINT HEADER
TAD (1247 / NO-JUST INDENT RESULT LINE
DCA XR10
JMP TITE
/ FCHK:
/ CHECK FOR /F
/ IF PRESENT, OUTPUT A FORM FEED
/ (ALSO RESET CRLF LINE COUNT)
/ ALSO PUT A COUPLE OF CRLFS
FCHK, 0000
TAD (100 / MASK FOR /F
AND I (7643 / 1ST OPTION WORD
SZA CLA / SET?
JMP F5 / YES
FE, JMS CRLF / SKIP A COUPLE OF LINES
JMS CRLF
JMP I FCHK
F5, TAD (214 / FF
JMS PACK / TO OUTPUT BUFFER
TAD NLNES
DCA LINES / RESET CTR IN CRLF
JMP FE
PAGE
/ THIS ROUTINE TOTALLY DECODES THE CCB OF A FILE
/ IT HAS 6 ARGUMENTS. ALL ARE ADDRESSES
/ ARG1= ADDR OF BUFFER CONTAINING CCB
/ ARG2= ADDR OF PAGE TABLE (400 WORDS)
/ ARG3= ADDR OF S.F. SAVE WORD
/ ARG4= ADDR OF S.A. SAVE WORD
/ ARG5= ADDR OF JSW SAVE WORD
/ ARG6= ADDR OF WORD CONTAINING MINUS THE FILE LENGTH
/ THESE ARGS ARE POINTED TO BY ONE ARG TO CCBDEC
CCBDEC, 0000
TAD I CCBDEC / GET ARG PTR
DCA XR11 / SAVE ARG POINTER
ISZ CCBDEC / POINT TO RETURN
TAD I XR11 / GET ARG 1
DCA XR10
TAD I XR11 / GET ARG 2
DCA PGBAS
TAD I XR11 / GET S.F. SAVE ADDRESS
DCA PI / SAVE IN POINTER
TAD I XR10 / GET 1ST CCB WORD
DCA NSEGS / LOCAL SAVE
TAD NSEGS
SMA
JMS ERROR9 / COUNTER MUST BE NEGATIVE
TAD (40
SPA CLA
JMS ERROR9 / TOO MANY
TAD I XR10 / GET 2ND CCB WORD
DCA I PI / START FIELD
TAD I PI
AND (7707 / MASK OFF THE FIELD BITS
TAD (-6203 / -(CDF CIF
SZA CLA / PROPER INSTRUCTION?
JMS ERROR9 / NO
TAD I XR11 / GET S.A. SAVE ADDRESS
DCA PI / SAVE IN POINTER
TAD I XR10 / GET 3RD CCB WORD
DCA I PI / START ADDRESS
TAD I XR11 / GET JSW SAVE ADDRESS
DCA PI / SAVE IN POINTER
TAD I XR10 / GET 4TH CCB WRD
DCA I PI / JSW
TAD I PI
AND (74 / STRIP TO BITS 6-9 (OS8 V3D)
SZA CLA / ALL CLEAR?
JMS ERROR9 / NO-
P2C
DCA CBL / FILE PAGES 0 & 1 ARE CCB
CCL1, TAD I XR10 / GET 1ST OF DOUBLE-WORD
DCA TMP
TAD TMP
AND (377
SZA CLA
JMS ERROR9 / ADDR MUST BE MULTIPLE OF 400
TAD TMP
CLL RTL;RTL
DCA PI / LINK IS STILL IMPORTANT
TAD I XR10 / GET 2ND HALF
DCA TMP
TAD TMP
AND (70
TAD PI
RTL
TAD PGBAS
DCA XR13 / PAGE TABLE ADDR FOR THESE PAGES
TAD TMP
AND (4007
SZA CLA
JMS ERROR9 / UNUSED BITS MUST BE 0
TAD TMP
AND (3700
SNA
STL RAR / 0 MEANS 40 PAGES
CLL RTR;RTR;RTR
CIA
DCA PCTR / # PAGES COUNTER FOR THIS GROUP
TAD CBL
DCA I XR13 / PUT FILE PAGE # IN CORE PAGE WORD
ISZ CBL / BUMP CURRENT PAGE
ISZ PCTR / THRU WITH THIS GROUP?
JMP .-4 / NO
ISZ CBL / YES-ROUND UP TO NEXT WHOLE BLOCK
CLL STA RAL / AC=7776
AND CBL
DCA CBL / DOUBLE WORDS ALWAYS START ON BLOCK BOUNDARY
ISZ NSEGS / THRU WITH DOUBLE WORDS?
JMP CCL1 / NO
TAD I XR11
DCA PI
TAD CBL
CLL RAR
TAD I PI
SMA SZA CLA
JMS ERROR9 / OFF END OF FILE
JMP I CCBDEC
NSEGS, 0
PGBAS, 0
PI, 0
PCTR= PI / SAME LOCATION. SHOULDN'T CONFLICT
CBL, 0
CCBG1, OBUF-1
PGTAB1-1
SF1
SA1
JSW1
BLEFT1
CCBG2, OBUF+400-1
PGTAB2-1
SF2
SA2
JSW2
BLEFT2
/ ROUTINE TO ZERO THE PAGE TABLES BEFORE CCB DECODE
CCBZER, 0000
TAD CCBG1+1 / PAGE TABLE ADDRESS (FILE 1)
DCA XR11
TAD CCBG2+1 / PAGE TABLE ADDRESS (FILE 2)
DCA XR12
TAD (-400
DCA PCTR / 32K WOULD BE 256 PAGES
DCA I XR11
DCA I XR12
ISZ PCTR
JMP .-3
JMP I CCBZER
PAGE
/ PRINT 5 DIGIT PAGE ADDRESS
PAGOUT, 0000
DCA PGSW / AC=0 OR -1
TAD I PAGOUT / GET PAGE VALUE
CLL RTR;RTR;RTR
DCA TMP / SAVE 12 BIT ADDRESS
TAD TMP
RAL
JMS PDIG / PRINT FIELD DIGIT
TAD TMP
AND P7600 / CLEAR NON PAGE BITS
ISZ PGSW / END PAGE?
TAD (177 / YES-SET LOW BITS
JMS OCTOUT / PRINT 4 DIGITS
PACK
ISZ PAGOUT
JMP I PAGOUT
PGSW= PGPTR1 / 2ND USE FOR PGPTR1. SHOULDN'T CONFLICT
/ PRINT START ADDRESS
SAOUT, 0000
JMS PUTSTR
MESC1-1 / "S.A.= "
TAD I SAOUT / START "CDF CIF" IS ARG1
RTR;RAR / MOVE FIELD TO BITS 9-11
JMS PDIG / PACK FIELD DIGIT
ISZ SAOUT
TAD I SAOUT / START ADDRESS IS ARG2
JMS OCTOUT / PRINT LOW 4 DIGITS
PACK
ISZ SAOUT / POINT TO RETURN
JMP I SAOUT
/ PRINT JSW
JSWOUT, 0000
JMS PUTSTR
MESC2-1 / "JSW= "
TAD I JSWOUT / JSW IS ARG1
JMS OCTOUT / PACK 4 DIGITS
PACK
ISZ JSWOUT
JMP I JSWOUT
/ INITIALIZE PAGE ORGANIZATION
/ USED TO SET GROUPS PER LINE & LINES PER BLOCK
/ /T REDUCES THE PAGE SIZE FOR TTY OPERATION
PAGSET, 0000
JMS OINIT / INIT OUTPUT BUFFER PARAMS
TAD I (7644 / 2ND OPTION WORD
AND (20 / MASK FOR /T
SZA CLA / /T?
JMP PAGS5 / YES-SMALL PAGES
TAD (-52
DCA DELTAC / CCB OUTPUT DELTA IF /C/I
M2C / NO-"NORMAL" SIZE PAGES
DCA NGRPS / 2 GROUPS PER LINE
TAD (-40
DCA LPBLK / 40 LINES PER BLOCK
TAD (-52
DCA SEGSIZ / 52 CHARS PER SEGMENT
TAD (-100 / 100 LINES PER PAGE ON OUTPUT
JMP PAGS9
PAGS5, TAD (-25
DCA DELTAC
M1C
DCA NGRPS / 1 GROUP PER LINE
TAD (-100
DCA LPBLK / 100 LINES PER BLOCK
TAD (-25
DCA SEGSIZ / 25 CHARS PER SEGMENT
TAD (-70 / 70 LINES PER PAGE ON OUTPUT
PAGS9, DCA LINES
TAD LINES
DCA NLNES
JMP I PAGSET
/ CHECK FOR ^C ON KBD
CTRLC, 0000
CLA CLL / SAFE
KSF / KEY STRUCK?
JMP I CTRLC / NO
KRS / YES-READ
AND (177 / STRIP PARITY BIT
TAD (-3 / COMPARE TO 7 BIT ^C
SNA CLA / =^C?
JMP GIVEUP / YES-RETURN TO OS/8
KCC / NO-CLEAR KBD FLAG
JMP I CTRLC / & RETURN TO CALLER
ERROR9, 0
ERROR8, ISZ ERROR
ERROR7, ISZ ERROR
ERROR6, ISZ ERROR
ERROR5, ISZ ERROR
ERROR4, ISZ ERROR
ERROR3, ISZ ERROR
ERROR2, ISZ ERROR
ERROR1, ISZ ERROR
JMS I (USR
7 / ERROR
ERROR, 1 / ERROR NUMBER
PAGE
FIELD 1
*OCSTA
$$$