File: CORMAP.PA of Tape: Sources/Other/new-17
(Source file text)
/***********************************************************************
/
/ CORMAP ; OS/8 CORE MAP PROGRAM
/ A.WINDRAM 6 JAN 75
/
/ THIS PROGRAM IS AN ALTERNATIVE TO THE OS/8 SYSTEM PROGRAM BITMAP
/ IT OFFERS MORE CONCISE OUTPUT, AND ADDITIONAL FACILITIES
/
/ BOTH ABSOLUTE AND RELOCATABLE BINARY FILES CAN BE MAPPED
/
/ FILES ARE SPECIFIED IN GROUPS
/ FOR ABSOLUTE BINARY FILES, ALL INPUT FILES IN THE GROUP ARE ASSUMED
/ TO BE PART OF THE SAME PROGRAM, AND ARE ENTERED IN THE SAME MAP
/ FOR RELOCATABLE BINARY FILES, EACH SECTION IS MAPPED INDEPENDENTLY,
/ AND ITS ENTRY NAMES ARE LISTED
/
/ FILE SPECIFICATION IS BY COMMAND DECODER. A GROUP SPECIFICATION
/ ENDS ON THE FIRST LINE ON WHICH /C IS NOT SPECIFIED.
/ ONLY THE FIRST OUTPUT FILE ON ANY LINE IS RECOGNISED.
/ OUTPUT FOR A GROUP WILL GO TO THE LAST MENTIONED OUTPUT FILE FOR
/ THE GROUP, OR TO TTY: BY DEFAULT. IF TTY: IS NOT AVAILABLE, AND
/ THE OUTPUT FILE IS DEFAULTED, /C WILL BE ASSUMED FOR THE LAST LINE
/ AND A WARNING MESSAGE WILL BE PRINTED BEFORE CD IS RECALLED.
/ DEFAULT EXTENSION FOR INPUT FILES IS "BN", & FOR OUTPUT IS "MP"
/
/ OPTIONS AVAILABLE FALL INTO 3 CATEGORIES :-
/
/ 1) IMMEDIATE ACTION OPTIONS :-
/
/ /A ABANDON THIS GROUP AND START AGAIN
/
/ /C CONTINUE THIS GROUP ON TO ANOTHER COMMAND DECODER LINE
/
/ /O CANCEL ANY GLOBAL OPTIONS SPECIFIED ON PREVIOUS LINES
/ IN THIS GROUP
/
/
/ 2) GLOBAL OPTIONS ; APPLY TO ALL FILES IN THE GROUP :-
/
/ /F PRINT FREE AREAS INSTEAD OF LOADED AREAS
/ ( THIS FORCES /N ON FOR ALL FILES, AND /X OFF )
/
/ /K KEEP ANY CURRENT MAP AND ADD TO IT
/
/ /L PRINT LENGTH OF EACH AREA IN ADDITION TO START & END ADDRESSES
/
/ /R INPUT FILES ARE RELOCATABLE BINARY
/ ( THIS FORCES /N AND /0 ON FOR ALL FILES, AND /X OFF )
/
/ /X INHIBIT PRINTING OF SUMMARY MAP
/
/ =DG WHERE DG IS AN OCTAL DIGIT > 0. PRINT DG AREAS PER LINE
/ ( DEFAULT IS 4, OR 3 IF /L IS SPECIFIED )
/
/
/ 3) LOCAL OPTIONS ; APPLY TO FILES ON THE LINE ON WHICH THEY ARE GIVEN
/
/ /N INHIBIT PRINT OF DETAILS OF EACH BLOCK OF CODE
/ AS IT IS ENCOUNTERED
/
/ /S PROCESS ALL BINARY SECTIONS IN EACH FILE, NOT JUST THE FIRST
/ SECTION
/
/ /DG WHERE DG IS AN OCTAL DIGIT. FORCE LOADING INTO FIELD DG,
/ UNLESS THE FILE CONTAINS FIELD DEFINITIONS
/
/
/
/ A * APPEARING AFTER DETAILS OF A BLOCK OF CODE MEANS THAT THE BLOCK
/ OVERLAYS SOME AREA WHICH HAS ALREADY BEEN LOADED.
/ THIS INFORMATION DOES NOT APPEAR IF /N IS ON
/
/
/ CORE LAYOUT :-
/ 00000 - 04577 PROGRAM
/ 04600 - 05577 OUTPUT BUFFER ( 2 BLOCKS ) + 1-TIME CODE
/ 05600 - 06577 MINIMUM INPUT BUFFER ( 2 BLOCKS )
/ 06600 - 07577 REST OF INPUT BUFFER, & DEVICE HANDLERS
/ 10000 - 17577 CORE MAP OF AREAS LOADED
/
/
/ TO ASSEMBLE, LOAD & SAVE THE PROGRAM :-
/ .R PAL8
/ *CORMAP/L/P$
/
/ .SAVE SYS CORMAP
/
/***********************************************************************
/ SYMBOL DEFINITIONS
ZZZOB=4600 / OUTPUT BUFFER
ZZZOR=2 / 2 BLOCKS
ZZZIB=5600 / INPUT BUFFER
HPB=7400 / TOP HANDLER PAGE
BLHP=6600 / LOWEST PAGE FOR HANDLERS
FIELD 0
CURFLD=0
/ PAGE 0
*1
HLT
JMP .-1 / IN CASE OF CALL TO NON-EXISTENT HANDLER
ZERO, "0
TEMP, -5 / FOR BATCH
T1, 0
CTR, 0
*16
TTYFAK-1; TYPE+1 / AIX POINTERS (SET UP FOR BATCH)
NWDS, 0 / NO OF WORDS IN BLOCK
OFLOW, 0 / OVERFLOW FOR NWDS
IA, 0 / INITIAL ADDRESS OF BLOCK
FA, 0 / FINAL ADDRESS OF BLOCK
PTRA, 0
PTRB, 0 / POINTERS FOR CHAINING
PTRC, 0
NBP, 0
OVL, 0 / OVERLAY FLAG FOR CHAINING
HDCHN, 0 / HEAD OF CURRENT FIELD CHAIN
FREE, 0 / HEAD OF FREE CHAIN
DFF, 0 / DEFAULT FIELD
FLD, 0 / CURRENT FIELD (CHAR)
NPL, 0 / NO OF BLOCKS PER PRINT LINE (-)
FSW, 0 / /F SWITCH ( DON'T CHANGE THE ORDER OF
KSW, 0 / /K SWITCH THE F,K,L,R, & X SWITCHES,
LSW, 0 / /L SWITCH OR SPLIT THEM UP )
RSW, 0 / /R SWITCH
XSW, 0 / /X SWITCH
NSW, 0 / /N SWITCH
SSW, 0 / /S SWITCH
IPRINT, 0 / ALLOW PRINTING IF 0
SYMCTR, 0 / COUNTER FOR RELOCATABLE SYMBOLS
NBOLC, 0 / COUNTER FOR OBLOK
NFM, 0 / MESSAGE NO FOR OBLOK
CC, 0 / CHAIN ADDRESS FOR UNCHN
SNOF, 0 / "STORE NEW OPTIONS"
POPT, 0 / PREVIOUS OPTIONS
IFCTR, 0 / INPUT FILE LIST COUNTER
FSP, 0 / FILE LIST FREE-SPACE POINTER
IFTP, 0 / FILE LIST POINTER
PLOF, 0 / "PRINT LOCAL OPTIONS"
NCIF, 0 / NO OF CURRENT INPUT FILE
OFT, 0 / OUTPUT FILE DEVICE
OHNP, 0 / NO OF GOES TO GET OUTPUT HANDLER
OHPA=OOPNT1
FFHP, 0 / FIRST FREE HANDLER PAGE
NFHP, 0 / NEXT FREE HANDLER PAGE
NXIFA, 0 / ADDR OF NEXT INPUT FILE
TNXIF, 0 / TEMP ADDR OF NEXT INPUT FILE
IHNP, 0 / NO OF GOES TO FETCH INPUT HANDLER
DATE, 0 / DATE
FTIME, 0 / FIRST TIME IN NEW SECTION
SAV, 0
SAV2, 0 / CHAR STORES FOR CONSTRUCT ROUTINES
SAV3, 0
CKSUM, 0 / CHECKSUM
CMPR1, 0
TELTAL, -1 / #0 IF NO MAP YET
ICNTSV, 0
ICNBSV, 0 / FOR INPUT ROUTINES
EQLM, 0;0 / MESSAGE BOX
SAVE, 0
FSPFLG, 0
NOSTOR, 0 / STORE INFO IN MAP IF 0
CRALT, 0 / CD LINE ENDING
CONSTR, 0 / ADDR OF CONSTRUCT ITEM ROUTINE
APUTXT, PUTTXT / OUTPUT TEXT
APUTK, PUTK / OUTPUT CHAR
ACOUT, 0 / ADDR OF CHAR OUT ROUTINE
ATRTD, TRTDEC / OUTPUT DECIMAL NO
AUSRL, USRLOK / LOCK USR
AUSRD, USRRLS / DISMISS USR
EQL0=7560 / "=0"
ANL, NL
ANL2, NL2
ANL3, NL3
P200, 200
M200,
P7600, 7600
P7700, 7700
P7746, 7746
P6777, 6777
P1000, 1000
CHAIND, -1 / -1 IF CHAINED TO, 0 IF NOT
XMONL, JMS I AUSRD / DISMISS USR
JMP I P7600 / & BACK TO MONITOR
XMON, TAD I P7746 / GET JSW
AND P6777
TAD P1000
DCA I P7746 / NO RESTART
JMP I P7600
PAGE
START, DCA CHAIND / NOT A CHAINING CALL
JMP I DFDV+1 / 1-TIME CODE ; OVERWRITTEN
/ JMS I AUSRL / LOCK IN USR
DCA DFDV+1 / RESTORE "TTY"
CIF 10
JMS I P200
12 / ENQUIRE WHAT DEFAULT DEVICE IS
DFDV, 5524; STARTT / EQUIVALENT TO "DEVICE TTY"
0
DCA DFDV+1 / ZERO IF NOT AVAILABLE
/ NEW SET OF FILES
RSTRT, CDF CURFLD
DCA NOSTOR / ALLOW MAP STORAGE
TAD (TYPE
DCA ACOUT / MESSAGES TO CONSOLE
JMS CLPO / CLEAR GLOBAL OPTIONS
DCA OFT
DCA POPT
DCA IPRINT / ALLOW PRINTING
TAD (-NFT-1
DCA IFCTR / - NO OF 2-WORD BLOCKS
TAD (FIFL
DCA FSP / FREE-SPACE POINTER
DCA I FSP
DCA FSPFLG / WARNING MESSAGE FLAG
/ CALL COMMAND DECODER
CALLCD, TAD IFCTR
TAD (12
SPA CLA
JMP CLCD2 / NOT NEAR END
TAD FSPFLG
SZA CLA
JMP CLCD2 / MESSAGE SENT ALREADY
ISZ FSPFLG
TAD (SPMES
JMS I APUTXT
TAD IFCTR
CMA
TAD ZERO
JMS I APUTK
TAD (SPMES2
JMS I APUTXT / "ONLY N MORE INPUT FILES ALLOWED"
CLCD2, ISZ CHAIND
SKP
JMP CDCLLD / CD TABLES SET UP ALREADY
CIF 10
JMS I P200
5 / CALL COMMAND DECODER
216 / ASSUMED EXTENSION IS "BN"
CDCLLD, CDF 10 / KILL TENTATIVE FILES
TAD I (7642
DCA CRALT / CD LINE ENDING
TAD CRALT
SMA CLA
JMP .+5
CDF CURFLD
TAD ANL
JMS I APUTXT / SEND NEWLINE IF ALTMODE ENDING
CDF 10
CLL CML RAR / 4000
AND I (7643
SZA CLA
JMP RSTRT / RESTART IF /A
TAD I P7600
SNA
JMP NOTO / NO OUTPUT FILE
DCA OFT / STORE OUTPUT DEVICE
TAD P7600
DCA 17
TAD (OOPNCW
DCA 16
TAD (-4
DCA CTR
TAD I 17
CDF CURFLD
DCA I 16 / COPY REST OF OUTPUT FILENAME
CDF 10
ISZ CTR
JMP .-5
/ DECODE LOCAL OPTIONS
NOTO, CLA CLL CML RAR / 4000
DCA SSW
TAD (1774
AND I (7645 / GET OCTAL DIGITS
CLL RTL
SPA SNA / SKIP IF NOT CURRENT DIGIT
JMP .+4
RAL
ISZ SSW / ADD ONE TO CURRENT DIGIT
JMP .-4
CLA CLL CML RTR / 2000
AND I (7644
TAD SSW
DCA SSW / UPDATE TO INCLUDE /N
TAD (40
AND I (7644 / GET /S
CLL RTL
RTL
TAD SSW
DCA SSW / UPDATE OPTIONS
DCA SNOF / CLEAR "STORE NEW OPTIONS" FLAG
TAD SSW
CIA
TAD POPT / COMPARE WITH PREVIOUS OPTIONS
SNA CLA
JMP SAMOP / IF SAME AS LAST TIME
ISZ IFCTR
SKP
JMP IF65 / NO MORE ROOM
CMA
DCA SNOF / SET "STORE NEW OPTIONS"
SKP
SAMOP, CLL CMA RAL / 0 IF NEW OPTIONS ; -2 IF SAME
JMP PG2 / ACROSS TO NEXT PAGE
PAGE
IF65, CLA
CDF CURFLD
TAD (TOOMNY
JMS I APUTXT / "TOO MANY INPUT FILES"
JMP RSTRT
/ COPY LIST OF INPUT FILES
PG2, TAD FSP
DCA IFTP / START FOR INPUT FILES
TAD (7617-1
DCA 17
TAD IFTP
DCA 16
CNXIF, CDF 10 / NEXT INPUT FILE
TAD I 17
CDF CURFLD
SNA
JMP EIF / END OF INPUT FILES
ISZ IFCTR
SKP
JMP IF65 / TOO MANY INPUT FILES
DCA I 16
CDF 10
TAD I 17
CDF CURFLD
DCA I 16 / COPY START BLOCK
JMP CNXIF
/ END OF INPUT FILE LIST
EIF, TAD 16
CIA
TAD IFTP
SNA CLA
JMP CHEKPO / NO FILES ; CHECK GLOBAL OPTIONS
DCA I 16
DCA I 16 / TO ROUND OFF
ISZ SNOF
JMP .+5
TAD SSW
DCA I FSP / STORE NEW OPTIONS
TAD SSW
DCA POPT / PRESERVE PREVIOUS OPTIONS
TAD 16
DCA FSP / NEW FREE-SPACE POINTER
/ CHECK GLOBAL OPTIONS
CHEKPO, CDF 10
TAD (1000
AND I (7644
SZA CLA
JMS CLPO / CLEAR PERMANENT OPTIONS IF /O
TAD (100
AND I (7644
SNA CLA
JMP .+3
CMA
DCA RSW / RELOCATABLE FILES
IAC
AND I (7644
SNA CLA
JMP .+3
CMA
DCA XSW / INHIBIT SUMMARY
CLL CML RTL / 2
AND I (7643
SNA CLA
JMP .+3
CMA
DCA KSW / KEEP PREVIOUS MAP
TAD (100
AND I (7643
SNA CLA
JMP .+3
CMA
DCA FSW / PRINT FREE SPACE, NOT USED
IAC
AND I (7643
SNA CLA
JMP .+3
CMA
DCA LSW / PRINT BLOCK LENGTHS
TAD I (7646
SNA / SKIP IF =N OPTION
JMP .+3
AND (7
DCA NPL / NO OF BLOCKS PER LINE
TAD (1000
AND I (7643
CDF CURFLD
SZA CLA
JMP CALLCD / RECALL CD IF /C
TAD RSW
SNA CLA
JMP .+7 / IF ABSOLUTE BINARY FILES
DCA KSW
DCA XSW / ALLOW SUMMARY
IAC
DCA NSW
DCA DFF / ZERO DEFAULT FIELD
TAD (CNRBI-CNABI
TAD (CNABI
DCA CONSTR / ADDR OF CONSTRUCT ROUTINE
TAD I (FIFL / GET FIRST OPTION WORD
SNA
TAD KSW
SNA CLA
JMP ENDR2 / NO FILES & NO MAP ; CHECK CD ENDING
CLA IAC
DCA NCIF / NO OF CURRENT INPUT FILE
TAD OFT
SNA
TAD DFDV+1 / GET DEFAULT OUTPUT
SNA
JMP NODFO / NO DEFAULT OUTPUT
DCA OFT
JMP PAG3 / ACROSS TO NEXT PAGE
PAGE
PAG3, CLL CMA RAL / -2
DCA OHNP / - NO OF GOES
/ OPEN OUTPUT FILE ( HOPEFULLY )
FOH, TAD (HPB
DCA OHPA / HANDLER PAGE ADDRESS
JMS I (OOPEN / TRY OPEN
JMP AGN / FAILURE
JMP FOK / SUCCESS
AGN, TAD (-177 / INCREMENT HANDLER PAGE ADDRESS
ISZ OHNP
JMP FOH / TRY WITH 2 PAGES
TAD (WLOKM-NDFO / "WRITE-LOCKED/READ-ONLY OUTPUT ; RESPECIFY"
NODFO, TAD (NDFO / "SPECIFY OUTPUT"
JMS I APUTXT
JMP CALLCD
/ PRINT START MESSAGE & DATE
FOK, TAD (OCHAR
DCA ACOUT
CDF 10
TAD I (7666 / GET DATE
CDF CURFLD
DCA DATE
TAD (STARTM
JMS I APUTXT / "_CORMAP V4 "
TAD DATE
SNA
JMP NXBIT
AND (370 / GET DAY
CLL RTR
RAR
JMS I ATRTD / OUTPUT DECIMAL NO
TAD ("-
JMS I APUTK
TAD DATE
AND (7400
CLL RTL
RTL
RTL
TAD (MONTH-2
JMS I APUTXT / OUTPUT MONTH
TAD ("-
JMS I APUTK
TAD DATE
AND (7
DCA DATE
TAD I (7777
AND (600
CLL RTR
RTR
TAD DATE
TAD (106
JMS I ATRTD / & YEAR ( NOW 70 - 99 )
CLA CMA / EXTRA 2 SPACES
NXBIT, TAD (SP4OP+1
JMS I APUTXT / "OPTIONS "
DCA I APUTXT / FLAG
TAD (-5
DCA T1
TAD (FSW-1
DCA 17
OPPOP, TAD I 17 / CHECK NEXT PERMANENT OPTION
SNA CLA
JMP .+10
TAD 17
TAD (POPL-FSW
DCA EQLM / GET OPTION MESSAGE
TAD I EQLM
DCA EQLM
TAD (EQLM
JMS I APUTXT / PRINT OPTION
ISZ T1
JMP OPPOP
EQLOP, TAD NPL
SNA
JMP .+6
TAD (EQL0
DCA EQLM
TAD (EQLM
JMS I APUTXT
JMP .+6
TAD I APUTXT / ANY OPTIONS BEEN OUTPUT ?
SZA CLA
JMP .+3
TAD (NONE
JMS I APUTXT
TAD NPL
SZA
JMP .+3
TAD LSW
TAD (4
CIA
DCA NPL / - NO OF BLOCKS PER LINE
TAD (DHRTSA-1
DCA 16
TAD (7647
DCA 17
TAD (-16
DCA CTR
JMP CDHRT
PAGE
/ COPY DEVICE HANDLER RESIDENCY TABLE ( EXCEPT SYS )
CDHRT, CDF 10
TAD I 17
CDF CURFLD
DCA I 16
ISZ CTR
JMP CDHRT
CLL
TAD P200
TAD OHPA
SZL CLA
JMP .+5
TAD P7600
AND OHPA
TAD M200
SKP
TAD (HPB
DCA FFHP / FIRST FREE HANDLER PAGE
TAD (FIFL-1
DCA NXIFA / ADDR OF NEXT INPUT FILE
TAD NXIFA
DCA TNXIF / ADDR FOR HANDLER FETCH CODE
/ GET NEXT SET OF DEVICE HANDLERS
GMDH, TAD FFHP
DCA NFHP
NXIF, CLL CMA RAL / -2
DCA IHNP
TAD NFHP
DCA IHPA
TAD I TNXIF / GET NEXT TABLE ENTRY
SZA
JMP GOODF / GOOD FILE
ISZ TNXIF
TAD I TNXIF / GET OPTION WORD
ISZ TNXIF
SZA CLA
JMP .-7 / CARRY ON IF NOT END
JMP PROCES / IF NO MORE FILES
/ GOOD FILE ENTRY ; FETCH HANDLER
GOODF, CIF 10
JMS I P200
1
IHPA, 0 / PAGE ADDRESS
JMP RTRY / IF FETCH FAILED
ISZ TNXIF
ISZ TNXIF / ON TO NEXT FILE
TAD NFHP
TAD P200
CLL CIA
TAD IHPA
SZL CLA
JMP XX / SOMEWHERE ELSE ALREADY
TAD P7600
AND IHPA
TAD M200
DCA NFHP / UPDATE PAGE ADDRESS
TAD NFHP
CLL
TAD (-BLHP / NO MORE ROOM ?
SNL CLA / OK IF L=1
JMP PROCES / FINISH IF NO MORE SPACE
XX, JMP NXIF
/ RETRY WITH 2 PAGES
RTRY, CLA
TAD (-177
TAD IHPA
DCA IHPA / BACK-UP 1 PAGE
TAD IHPA
CLL
TAD (-BLHP
SNL CLA
JMP PROCES / OUT OF ROOM
ISZ IHNP
JMP NXIF+2
HLT CLA
/ PROCESS SOME FILES
PROCES, TAD NFHP / 200 LESS THAN LAST HANDLER PAGE
TAD (-ZZZIB+200 / SUBTRACT LOWER LIMIT
AND (7400 / GET BLOCKS*200
CLL RAR
DCA ICHRP1-1 / SET FUNCTION WORD
TAD ICHRP1-1
CIA
DCA ICNTSV / SET COUNTER
TAD ICHRP1-1
CLL RTL
RTL
RTL
DCA ICNBSV / NO OF BLOCKS
JMS I AUSRD / DISMISS USR
/ CHECK IF MAP TO BE INITIALISED
TAD TELTAL
SNA CLA
ISZ KSW
JMS PURGE
DCA KSW
JMP ONIF
/ SUBROUTINE TO SET UP LOCAL OPTIONS
SETOP, 0
DCA TEMP
TAD TEMP
CLL RTL
SPA CLA
IAC
DCA SSW / SET /S SWITCH
TAD RSW / /R SETS /N
TAD FSW / SO DOES /F
SNA / ACC HOLDS -2 OR -1 IF /F OR /R IS SET
TAD TEMP
CLL RAL
SPA CLA
IAC
DCA NSW / SET /N SWITCH
TAD RSW / /R SETS DEFAULT FIELD TO 0
SNA CLA
TAD (7
AND TEMP
DCA DFF / SET DEFAULT FIELD
CMA
DCA PLOF / "PRINT LOCAL OPTIONS"
JMP I SETOP
PAGE
/ OPEN NEXT INPUT FILE
ONIF, JMS I (IOPEN
JMP MOROPT / MORE OPTIONS
DCA IPRINT
TAD PLOF
TAD (FILE+1
JMS I APUTXT
TAD NCIF
JMS I ATRTD / OUTPUT FILE NO
ISZ PLOF / PRINT LOCAL OPTIONS ?
JMP EL
TAD (LOCOP
JMS I APUTXT
TAD DFF
TAD ZERO
JMS I APUTK
TAD NSW
SNA CLA
JMP .+3
TAD (SLN
JMS I APUTXT
TAD SSW
SNA CLA
JMP EL
TAD (SLS
JMS I APUTXT
EL, DCA PLOF / DON'T PRINT AGAIN UNTIL NEW OPTIONS
JMS I (ICHAR / GET CHAR 1 & CHECK FOR L-T
JMP NOTGF / NOT GOOD FILE UNLESS L-T AT START
TAD M200
SZA CLA
JMP NOTGF
EL2, IAC
DCA NFM / SET UP OBLOK MESSAGE
CMA
DCA NBOLC
CMA
DCA SYMCTR
TAD NSW
DCA IPRINT
DCA NWDS
DCA OFLOW
TAD DFF
DCA HDCHN
TAD P200
DCA IA
TAD HDCHN
TAD ZERO
DCA FLD
JMS I (ICHAR
JMP EOF / END OF FILE ?
TAD M200
SNA
JMP .-4 / IF STILL L-T
TAD P200 / RESTORE CODE
/ CONSTRUCT NEXT ITEM
NXITEM, JMS I CONSTR
JMP DATA
JMP ORIGIN
JMP CHKSUM
JMP FEELD
JMP ERROR
/ MORE OPTIONS ??
MOROPT, TAD I NXIFA
SNA
JMP ENDRUN
JMS SETOP / SET NEW OPTIONS
ISZ NXIFA
JMP ONIF
/ DATA WORD
DATA, ISZ NWDS
JMP NXITEM
ISZ OFLOW
JMP NXITEM
/ ORIGIN SETTING ; VALUE IN ACC
ORIGIN, JMS CALCHN / CHAIN OUTSTANDING BLOCK
DCA IA / SET INITIAL ADDRESS
JMP NXITEM
/ FIELD SETTING ; VALUE IN ACC
FEELD, JMS CALCHN
DCA HDCHN
TAD HDCHN
TAD ZERO
DCA FLD / CURRENT FIELD
JMP NXITEM
/ CHECKSUM ; DIFFERENCE IN ACC
CHKSUM, JMS CALCHN
SNA CLA
JMP NXSECT / GO DO NEXT SECTION
TAD (CKSERR
JMS I APUTXT / OUTPUT ERROR MESSAGE
/ DO NEXT SECTION
NXSECT, TAD RSW
SNA CLA
JMP .+3
JMS SUMMRY / PRINT SUMMARY IF RELOCATABLE FILE
JMS PURGE / & PURGE MAP
TAD SSW
SNA CLA
JMP EOF / CARRY ON WITH NEXT FILE
IAC / BLANK LINE BEFORE NEW TEXT
JMP EL2
PAGE
/ NEW FILE
EOF, SZA CLA
JMP BADF / BAD FILE
ISZ NCIF / NEW FILE
TAD NSW
TAD ANL2
JMS I APUTXT / OUTPUT NEWLINES IF DESIRABLE
TAD TNXIF
CIA
TAD NXIFA
SZA CLA
JMP ONIF / OPEN NEXT INPUT FILE
/ GET NEW HANDLERS ETC
JMS I AUSRL / LOCK IN USR AGAIN
TAD (7647
DCA 16
TAD (DHRTSA-1
DCA 17
TAD (-16
DCA CTR
TAD I 17
CDF 10
DCA I 16
CDF CURFLD
ISZ CTR
JMP .-5
JMP GMDH / NOW GET MORE HANDLERS
/ END OF THIS LOT OF FILES ; PRINT SUMMARY
ENDRUN, TAD RSW
SNA CLA / SKIP IF RELOCATABLE
JMS SUMMRY / PRINT SUMMARY
TAD ANL3
JMS I APUTXT
JMS I (OCLOS / CLOSE OUTPUT
JMP CLERR / CLOSE ERROR
ENDR2, TAD CRALT
SZA CLA
JMP XMONL / EXIT TO MONITOR
JMP RSTRT / IF CR ENDING
/ ERROR IN OUTPUT FILE
BADFO,
CLERR, ISZ TELTAL / SCRUB MAP
SNA CLA / SKIP IF USR IN ALREADY
JMS I AUSRL / RE-GET USR
TAD (TYPE
DCA ACOUT
DCA IPRINT
TAD (OFERR
JMS I APUTXT
JMP RSTRT
/ SUBROUTINE TO PURGE CORE MAP
PURGE, 0
TAD (-10
DCA CTR
CDF 10
DCA FREE
DCA I FREE / ZERO CHAIN-START LOCATIONS
ISZ FREE
ISZ CTR
JMP .-3
TAD FREE / 1ST 3-WORD BLOCK AT ADDR 10
PRG2, DCA NBP
CLL CLA
TAD NBP
TAD (-7573
SZL CLA
JMP PRG3 / NO MORE ROOM
TAD (3
TAD NBP
DCA I NBP / POINTER TO NEXT BLOCK
TAD I NBP
JMP PRG2
PRG3, DCA I NBP / LAST BLOCK HAS 0 POINTER
CDF CURFLD
CLA IAC
DCA TELTAL / NOTHING YET IN MAP
JMP I PURGE
/ SUBROUTINE TO PRINT CORE MAP
SUMMRY, 0
TAD XSW
SZA CLA
JMP I SUMMRY / SUMMARY INHIBITED
TAD TELTAL
SZA CLA
JMP I SUMMRY / NOTHING THERE
DCA IPRINT / ALLOW PRINT
TAD FSW
SZA CLA
TAD (AREAF-AREAS / "FREE AREAS"
TAD (AREAS
JMS I APUTXT / OUTPUT "AREAS LOADED"
CLA IAC
DCA NFM / GET "START END LENGTH" OUT AGAIN
TAD RSW
SNA CLA
TAD ("0-"
TAD ("
DCA FLD / SET FIELD DIGIT
DCA CC
TAD RSW
SNA / -1 IF SET
TAD (-10
DCA SYMCTR
DCA OVL / NO OVERLAY FLAGS
CDF 10
CLA CMA
DCA NBOLC / START NEW LINE
JMS UNCHN / PRINT NEXT FIELD
ISZ CC / INC FIELD NO
ISZ FLD
ISZ SYMCTR
JMP .-6
CDF CURFLD
TAD ANL3
JMS I APUTXT
JMP I SUMMRY
PAGE
/ CONSTRUCT NEXT ABSOLUTE BINARY ITEM
CNABI, 0
SNA / SKIP IF NEW SECTION
JMP .+4
DCA SAV
DCA CKSUM
CMA
DCA FTIME / FIRST-TIME-THROUGH FLAG
JMS I (ICHAR
JMP ERRORA / BAD !
DCA SAV2
TAD SAV
AND (307
TAD (-300
SNA CLA
JMP AFLD / FIELD SETTING
JMS I (ICHAR
JMP ERRORA / EQUALLY BAD !
DCA SAV3
TAD SAV3
TAD M200
SNA CLA / NOT LEADER-TRAILER
JMP ALT
TAD P7600
JMS ACON
SZL
JMP AORG / IF ORIGIN
CLA / DATA
ISZ FTIME
JMP AORG+1 / RETURN
JMP ABADF / FIRST ITEM IS DATA ; BAD
AFLD, TAD SAV
AND (70
CLL RTR
RAR / GET FIELD
DCA FTIME
TAD SAV2
DCA SAV / SHIFT UP LAST CHAR READ
TAD FTIME
ISZ CNABI
ISZ CNABI
ISZ CNABI
JMP I CNABI / RETURN WITH FIELD IN ACC
ISZ CNABI
AORG, ISZ CNABI
DCA FTIME
JMS UPDCKS / UPDATE CHECKSUM
TAD FTIME
JMP I CNABI / RETURN
ALT, TAD P7700 / CHECK FOR CHECKSUM
JMS ACON
CIA
TAD CKSUM
ISZ FTIME
JMP AORG-1 / IF NOT FIRST TIME
CLA
JMP ABADF /CHECKSUM AS FIRST ITEM
ERRORA, CLA
TAD (4
TAD CNABI
DCA CNABI
JMP I CNABI / ERROR EXIT
/ UTILITY SUBROUTINE
ACON, 0
AND SAV
SZA CLA
JMP ERRORA
TAD SAV2
AND P7700
SZA CLA
JMP ERRORA
TAD SAV
CLL RTL
RTL
RTL
TAD SAV2
JMP I ACON
/ UPDATE CHECKSUM
UPDCKS, 0
TAD CKSUM
TAD SAV
TAD SAV2
DCA CKSUM
TAD SAV3
DCA SAV
JMP I UPDCKS
/ MAP FULL
FATL, JMS PURGE
ISZ NOSTOR / DONT STORE ANY MORE
TAD (TYPE
DCA ACOUT
DCA IPRINT
TAD (MPFUL
JMS I APUTXT
TAD NSW
DCA IPRINT
TAD (OCHAR
DCA ACOUT
JMP OUT
PAGE
/ CONSTRUCT NEXT RELOCATABLE BINARY ITEM
CNRBI, 0
SNA
JMP .+4
DCA SAV / IF FIRST TIME
DCA CKSUM
CMA
CNR2, DCA FTIME
JMS I (ICHAR
JMS EXAM / SEE IF ^Z ; COULD BE LEGAL
DCA SAV2
JMS I (ICHAR
JMP RERR
DCA SAV3
TAD SAV
AND (17
CLL RTR
RTR
RAR
TAD SAV2
DCA T1 / DATA WORD
TAD SAV
AND (360
CLL RTR
RTR
TAD (JMP I TRANS
DCA .+1
HLT / SWITCH ON LOADER CODE
TRANS, RDAT;RDAT;RERR;RDEF;RORG;RDAT;RDAT;RERR
RCKS;RERR;RCOM;RERR;RERR;RERR;RERR;RSYM
/ SYMBOL DEFINITION OR REFERENCE
RDEF, DCA IPRINT / ALLOW PRINT FOR SYMBOL
ISZ SYMCTR
JMP .+10
TAD LSW
SZA CLA
TAD NPL
TAD NPL
TAD NPL
DCA SYMCTR
TAD (NL-SPACE2
TAD (SPACE2
JMS I APUTXT
IAC
RSYM, DCA T1 / PRINT SYMBOL FLAG
ISZ FTIME
SKP
JMP RBADF
JMS UPDCKS / UPDATE CHECKSUM
TAD (-6
DCA CTR
NXC, TAD SAV
TAD CKSUM
DCA CKSUM / UPDATE CHECKSUM
TAD T1
SNA CLA
JMP .+3
TAD SAV
JMS I APUTK / PRINT SYMBOL
JMS I (ICHAR
JMP RERR
DCA SAV
ISZ CTR
JMP NXC
TAD NSW
DCA IPRINT
JMP CNR2 / AFTER PASSING OVER SYMBOL
/ COMMON DEFINITION
RCOM, ISZ FTIME
JMP RBADF
JMS UPDCKS
JMP CNR2+1
/ DATA WORD
RDAT, DCA T1
ISZ FTIME
JMP XRBI
JMP RBADF
/ ORIGIN
RORG, ISZ FTIME
SKP
JMP RBADF
ISZ CNRBI
XRBI, JMS UPDCKS / UPDATE CHECKSUM
TAD T1
JMP I CNRBI
/ CHECKSUM
RCKS, ISZ FTIME
SKP
JMP RBADF
TAD SAV3
TAD M200
SZA CLA
JMP RERR / CHECKSUM NOT FOLLOWED BY L-T
TAD T1
CIA
TAD CKSUM
ISZ CNRBI
ISZ CNRBI
JMP I CNRBI
/ UNRECOGNISED CODE
/ ERROR
RERR, CLA
TAD (4
TAD CNRBI
DCA CNRBI
JMP I CNRBI
/ EXAMINE CHAR FOR ^Z
EXAM, 0
SZA CLA
JMP RERR
TAD (232
JMP I EXAM / RETURN ^Z
PAGE
/ SUBROUTINE UNCHN ; UNRAVEL CHAIN AND PRINT IT OUT
/ RECEIVES ADDRESS OF HEAD NODE OF CHAIN IN CC
/ ENTRY & EXIT WITH DF=10
UNCHN, 0
TAD CC
DCA PTRB
DCA PB / NOTHING YET PRINTED
TAD FSW
SZA CLA
JMP UNCF / PRINT FREE SPACE
TAD I PTRB
SNA
JMP I UNCHN
BACK, DCA PTRB
TAD I PTRB
DCA IA
ISZ PTRB
TAD I PTRB
DCA FA
JMS PB / PRINT BLOCK INFO
ISZ PTRB
TAD I PTRB
SZA
JMP BACK
JMP I UNCHN
/ PRINT FREE SPACE
UNCF, TAD RSW
SZA CLA
TAD (200
DCA IA
TAD I PTRB
SNA
JMP I UNCHN
BACKF, DCA PTRB
CLL CMA
TAD I PTRB
DCA FA
TAD IA
CIA
TAD FA
SNL CLA
JMS PB
ISZ PTRB
CLL
TAD I PTRB
IAC
DCA IA
ISZ PTRB
TAD I PTRB
SZA / SKIP IF END OF CHAIN
JMP BACKF
SZL
JMP UNCHNX / IF LAST LOADED ADDRESS WAS 7777
TAD IA
TAD (200
SNA CLA
JMP UNCHNX / IF LAST LOADED ADDRESS WAS 7577
TAD RSW
SZA CLA
JMP FLAR / FIND LAST ADDRESS FOR RELOCATABLE CODE
RAL / GET 1 IF TOP PAGE
TAD (7577
UNCNX2, AND (7600
TAD (177
DCA FA
JMS PB
UNCHNX, TAD PB / HAS ANYTHING BEEN OUTPUT ?
SZA CLA
JMP I UNCHN
CDF CURFLD
JMS OMESS / OUTPUT PRELIMINARY MESSAGE ( IF ANY )
TAD (NFSIF
JMS I APUTXT
TAD FLD
JMS I APUTK / "NO FREE SPACE IN FIELD N"
CDF 10
JMP I UNCHN
/ SUBROUTINE TO SET UP & PRINT BLOCK
PB, 0
TAD IA
CIA
TAD FA
CLL IAC
DCA NWDS
RAL
DCA OFLOW
CDF CURFLD
JMS OBLOK / PRINT DETAILS OF THIS BLOCK
CDF 10
JMP I PB
/ SUBROUTINE TO OUTPUT MESSAGE FOR OBLOK
OMESS, 0
TAD NPL
DCA NBOLC / SET COUNTER
TAD NFM
TAD (JMP I OBSW
DCA .+2
DCA NFM / CLEAR OUT MESSAGE
HLT / SWITCH ON MESSAGE NO
OBSW, OBEGN / JUST BEGINNING OF LINE
OTITL / "START END LENGTH" TITLE
OBLANK / BLANK LINE BEFORE START
OTITL, TAD (SEL
JMS I APUTXT / "START END"
TAD LSW
SNA CLA
JMP .+3
TAD (LNGTH
JMS I APUTXT / "LENGTH"
ISZ NBOLC
SKP
JMP OTITL2
TAD (SPACE4
JMS I APUTXT
IAC
JMP OTITL
OTITL2, TAD NPL
DCA NBOLC
OBLANK, TAD (NL2-NL
OBEGN, TAD ANL
JMS I APUTXT
JMP I OMESS
PAGE
/ SUBROUTINE TRTOCT ; RECEIVES WORD IN ACC
/ AND OUTPUTS IT AS 4 OCTAL DIGITS
TRTOCT, 0
CDF CURFLD
DCA SVA
TAD (-4
DCA PUTTXT
TAD SVA
CLL RTL
JMP TRTIN
AROUND, TAD SVA
CLL RAL
TAD SL
TRTIN, RTL
DCA SVA
RAL
DCA SL
TAD SVA
AND (7
TAD ZERO
JMS PUTK / DOESNT PRESERVE LINK
ISZ PUTTXT
JMP AROUND
JMP I TRTOCT
SVA, 0
SL, 0
/ SUBROUTINE PUTTXT ; OUTPUTS A TEXT STRING TERMINATED BY 6-BIT 0
/ START ADDRESS OF TEXT IS RECEIVED IN ACC
PUTTXT, 0 ; PTR=TRTOCT
DCA PTR
CDF CURFLD
DCA CTR / LEFT-RIGHT FLIP-FLOP
AGAIN, ISZ CTR
JMP .+4
TAD I PTR
ISZ PTR
JMP .+7
CLA CMA
DCA CTR
TAD I PTR
CLL RTR
RTR
RTR
AND (77
SNA
JMP I PUTTXT
TAD (-37
SNA
JMP CRLF / IF _
SPA
TAD (100
TAD (237
JMS PUTK
JMP AGAIN
CRLF, TAD (215
JMS PUTK
TAD (212
JMP CRLF-2
/ SUBROUTINE TYPE ; OUTPUTS 1 CHAR TO TTY
TYPE, 0
ISZ TYPE
TLS
CLA
TYPWT, TSF
JMP .-1
JMP I TYPE
/ SUBROUTINE PUTK ; OUTPUTS 1 CHAR TO OUTPUT DEVICE
/ UNLESS INHIBIT SWITCH IS ON, WHEN OUTPUT IS INHIBITED
PUTK, 0 ; TM2=TYPE
DCA TM2
TAD IPRINT
SZA CLA
JMP I PUTK
TAD TM2
JMS I ACOUT / IN SAME FIELD
JMP BADFO / BAD FILE
JMP I PUTK
/ HELP OUT UNCHN
FLAR, TAD IA
AND (177
SNA CLA
JMP UNCHNX / CODE ENDS AT END OF PAGE
TAD IA
JMP UNCNX2 / FREE SPACE ENDS ON THIS PAGE
PAGE
CALCHN, 0
DCA SAVE
JMS CHAIN
DCA NWDS
DCA OFLOW
TAD SAVE
JMP I CALCHN
/ SUBROUTINE CHAIN ; OUTPUT CODE BLOCK INFORMATION
/ & APPEND NEW BLOCK TO CURRENT CHAIN
CHAIN, 0
TAD NWDS
SNA
TAD OFLOW
SNA CLA
JMP I CHAIN / NO WORDS IN BLOCK
CLA CMA
DCA OVL / SET OVERLAY FLAG
CLA CMA
TAD IA
TAD NWDS
DCA FA
TAD NOSTOR
SZA CLA
JMP OUT / JUST OUTPUT INFO
DCA TELTAL
CLL CLA CMA
TAD IA
CIA / L=1 UNLESS IA=0 OR 1
DCA CMPR1
TAD HDCHN
CDF 10
NXTBLK, DCA PTRA
TAD I PTRA
DCA PTRB
TAD PTRB
SNA
JMP XIT / END OF CHAIN
IAC
DCA PTRC
TAD CMPR1
SPA SNA SZL / SKIP IF IA=0
TAD I PTRC
SNL
JMP EX2
CLA IAC / FA(CB)<IA-1
TAD PTRC
JMP NXTBLK
/ IF ACC=0, NO OVERLAY THIS SIDE
EX2, SNA CLA
DCA OVL / CLEAR OVERLAY FLAG
CLL CLA CMA
TAD I PTRB
CIA
SPA SNA SZL / SKIP IF IA(CB)=0 ( ACC=1 & L=0 )
TAD FA
SNL / SKIP IF FA<IA(CB)-1
JMP MERGE
CLA
XIT, DCA OVL / NEW BLOCK CAN'T OVERLAY
/ GET NEW BLOCK FROM FREE CHAIN & LINK INTO FIELD CHAIN
TAD FREE
SNA
JMP FATL / NO FREE BLOCKS LEFT ; FATAL ERROR
DCA NBP / NEW BLOCK POINTER
TAD I NBP
DCA FREE / UNCHAIN CURRENT BLOCK FROM FREE LIST
TAD NBP
DCA I PTRA / CHAIN ONTO FIELD CHAIN AT TOP
TAD IA
DCA I NBP
ISZ NBP
TAD FA
DCA I NBP
ISZ NBP
TAD PTRB
DCA I NBP / CHAIN ONTO FIELD CHAIN AT BOTTOM
JMP OUT
/ MERGE THIS BLOCK INTO ALREADY EXISTING ONES
/ NOTE THAT EXISTING BLOCKS MAY DISAPPEAR AS A RESULT
MERGE, SNA CLA
DCA OVL / NO OVERLAY THIS SIDE
/ FIX MIN OF IA & IA(CB) INTO IA(CB)
TAD IA
CLL CIA
TAD I PTRB
SZL
CLA
TAD IA
DCA I PTRB
/ FIX MAX OF FA & FA(CB) INTO FA(CB)
NXPMG, TAD FA
CLL CIA
TAD I PTRC
SNL
CLA
TAD FA
DCA I PTRC
/ NOW EXAMINE NEXT BLOCK FOR OVERLAY
CLA IAC
TAD PTRC
DCA PTRA
TAD I PTRA / EXAMINE NEXT POTENTIAL MERGE BLOCK
DCA PTRB
TAD PTRB
SNA CLA
JMP OUT
CLL CLA CMA
TAD I PTRB / MUST BE >0
CIA
TAD FA / ONLY FA CAN CHANGE STATUS QUO
SZL
JMP OUT-1 / NO OVERLAY
SZA CLA
CMA
TAD OVL
DCA OVL / ADJUST OVERLAY FLAG
/ CHAIN THIS BLOCK ONTO FREE LIST & EXTRACT CONTENTS
TAD FREE
DCA I PTRB
TAD PTRB
DCA FREE
ISZ PTRB
TAD I PTRB
DCA I PTRC
ISZ PTRB
TAD I PTRB
DCA I PTRA
JMP NXPMG
CLA
OUT, JMS OBLOK / PRINT INFORMATION
JMP I CHAIN
PAGE
/ BAD BINARY FILE
NOTGF,
ERROR,
BADF,
ABADF,
RBADF, CLA CMA
DCA T1
TAD (TYPE
DCA ACOUT
DCA IPRINT
BADF2, TAD (FILM
JMS I APUTXT / "FILE NN NOT VALID BINARY FILE"
TAD NCIF
JMS I ATRTD
TAD (FILM2
JMS I APUTXT
ISZ T1
JMP .+6
TAD (OCHAR
DCA ACOUT
TAD ANL
JMS I APUTXT
JMP BADF2
TAD RSW
SZA CLA
JMP .+5
ISZ IPRINT
CMA
DCA XSW / INHIBIT PRINT & SUMMARY
ISZ NOSTOR / & STORAGE
JMS PURGE
JMP EOF
/ SUBROUTINE TO PRINT BLOCK INFO
OBLOK, 0
ISZ NBOLC
JMP MIDDLE / MIDDLE OF LINE
JMS OMESS
JMP MIDDLE+2
MIDDLE, TAD (SPACE3
JMS I APUTXT
TAD FLD
JMS I APUTK
TAD IA
JMS I (TRTOCT
TAD (SEP
JMS I APUTXT
TAD FLD
JMS I APUTK
TAD FA
JMS I (TRTOCT
TAD LSW
SNA CLA
JMP TOVL
TAD ("
JMS I APUTK
TAD OFLOW
SNA
TAD (" -"0
TAD ZERO
JMS I APUTK
TAD NWDS
JMS I (TRTOCT
TOVL, TAD OVL
SZA CLA
TAD (STAR-SPACE2
TAD (SPACE2
JMS I APUTXT
JMP I OBLOK
/ TRANSLATE TO DECIMAL (0 TO 99)
TRTDEC, 0
DCA TEMP
DCA CTR
TAD TEMP
ISZ CTR
TAD (-12
SMA
JMP .-3
TAD (12+"0
DCA TEMP
CMA
TAD CTR
SNA
JMP .+3
TAD ZERO
JMS I APUTK
TAD TEMP
JMS I APUTK
JMP I TRTDEC
/ SUBROUTINE TO CLEAR PERMANENT OPTIONS
CLPO, 0
DCA NPL
DCA FSW
DCA KSW
DCA LSW
DCA RSW
DCA XSW
JMP I CLPO
PAGE
/ TEXT STRINGS
STARTM, TEXT "_CORMAP V4 "
MONTH, TEXT "JAN@FEB@MAR@APR@MAY@JUN@JUL@AUG@SEP@OCT@NOV@DEC"
SP7, TEXT " 7"
SP4OP, TEXT " OPTIONS "
POPL, TEXT "/F/K/L/R/X"
SLN, TEXT "/N"
SLS, TEXT "/S"
FILE, TEXT "_ _FILE "
LOCOP, TEXT " ; LOCAL OPTIONS /"
CKSERR, TEXT "CHECKSUM ERROR_"
NL3, TEXT "___"
NL2, TEXT "__"
NL=NL3+1
SPACE4, TEXT " "
SPACE3, TEXT " "
SPACE2=SPACE4+1
SEP, TEXT " - "
SEL, TEXT "__START END "
LNGTH, TEXT "LENGTH"
STAR, TEXT " *"
SPMES, TEXT "ONLY "
SPMES2, TEXT " MORE INPUT FILES ALLOWED_"
TOOMNY, TEXT "TOO MANY INPUT FILES_"
WLOKM, TEXT "WRITE-LOCKED/READ-ONLY OUTPUT ; RESPECIFY_"
NDFO, TEXT "SPECIFY OUTPUT_"
OFERR, TEXT "OUTPUT FILE ERROR_"
AREAS, TEXT "_AREAS LOADED"
AREAF, TEXT "_FREE AREAS"
FILM, TEXT "_FILE "
FILM2, TEXT " NOT VALID BINARY FILE_"
MPFUL, TEXT "MAP FULL_"
NFSIF, TEXT "NO FREE SPACE IN FIELD "
/ DEVICE HANDLER RESIDENCY TABLE SAVE AREA
DHRTSA, ZBLOCK 16
/ INPUT FILE LIST ( ROOM FOR 64 FILES & OPTIONS )
NONE, TEXT "NONE" / LEADING 0 FOR FILE LIST
FIFL, ZBLOCK LFT
*4000
LFT=.-FIFL / LENGTH OF INPUT FILE LIST
NFT=LFT-1%2 / NO OF 2-WORD BLOCKS IN FILE LIST
/ PS/8 I/O MACROS (8BAL) (DMK) (MUCH MODIFIED !!)
ZZZ=0 /FOR FILL-INS
ICHRP2=.
IOPEN, .-.
TAD I NXIFA / IN PAGE 0 OF THIS FIELD
ISZ NXIFA
SNA
JMP IOPNRT
AND (17
TAD (7647-1 / ADDR OF DEVICE HANDLER RESIDENCY TABLE
DCA IHNDAD
TAD I NXIFA
ISZ NXIFA
DCA IBLK / SET START BLOCK
CDF 10
TAD I IHNDAD / GET HANDLER ADDRESS
DCA IHNDAD / & STORE
TAD (ICHR2
DCA ICHRS1
TAD (CURFLD
TAD ICHRP1-1
DCA ICHRP1-1
ISZ IOPEN
CDF CURFLD
IOPNRT, JMP I IOPEN
IHNDAD, 0 / INPUT HANDLER ADDRESS
ICNT, 0
ICHAR, .-.
JMP I ICHRS1
ICHR2, CDF CURFLD
CIF 0
JMS I IHNDAD
ZZZ / SET BY HANDLER-FETCHER
ICHRP1, ZZZIB
IBLK, ZZZ
SMA
SKP CLA
JMP I ICHAR /RETURN ERROR
TAD ICNTSV / SET BY HANDLER-FETCHER
DCA ICNT
TAD ICHRP1
DCA ICHRP2
TAD IBLK
TAD ICNBSV / SET BY HANDLER-FETCHER
DCA IBLK
ICHR3, TAD I ICHRP2
JMS ICHRS1
TAD I ICHRP2
JMS ICHRS1
CMA CLL RTL
TAD ICHRP2
DCA ICHRP2
JMS ICHRS2
JMS ICHRS2
RAL
JMS ICHRS1
ISZ ICNT
JMP ICHR3
JMP ICHR2
ICHRT1=.
ICHRS1, .-.
ISZ ICHRP2
AND (377
TAD (-232 /^Z
SNA
JMP I ICHAR
TAD (232
ISZ ICHAR
JMP I ICHAR
ICHRS2, .-.
DCA ICHRT1
ISZ ICHRP2
TAD I ICHRP2
AND (7400
TAD ICHRT1
RTL
RTL
JMP I ICHRS2
/ LOCK IN USR
USRLOK, 0
TAD TELTAL / ANY FIELD 1 ?
SNA CLA
JMP .+5
CLL CMA RAL
AND I (7746 / GET JSW
IAC
DCA I (7746 / FIELD 1 NOT SAVED
CIF 10
JMS I P7700
10
JMP I USRLOK
/ DISMISS USR
USRRLS, 0
CIF 10
JMS I P200
11
CLL CMA RAL
AND I (7746
DCA I (7746 / SAVE FIELD 1
JMP I USRRLS
PAGE
OWRIT, .-.
TAD OCHRP1
CIA
TAD OCHRP2
TAD (177
AND P7600
CLL RAR
DCA OWRTT1
TAD OWRTT1
CLL RTR
RTR
RTR
SNA
JMP OWRIT1
IAC
RAR
TAD OLEN
DCA OLEN
CLL
TAD OLIM
TAD OLEN
SZL CLA
JMP I OWRIT
TAD OWRTT1
TAD (4000
DCA OWRTT1
CIF 0
JMS I OHNDAD
OCHRT1=.
OWRTT1, ZZZ
OCHRP1, ZZZOB
OBLK, ZZZ
JMP OWRTE1
TAD OBLK
TAD (ZZZOR
JMS OSETUP
OWRIT1, ISZ OWRIT
JMP I OWRIT
OWRTE1, CLA
JMP I OWRIT
OHNDAD, 0
OCLOS, .-.
CDF CURFLD
TAD (232
OCLO1, JMS OCHAR
JMP I OCLOS
TAD OCNT
AND (77
SZA CLA
JMP OCLO1
JMS OWRIT
JMP I OCLOS
JMS I AUSRL / LOCK IN USR
TAD OFT
CIF 10
JMS I P200 / USR IS LOCKED IN
4
OFLNM
OLEN, ZZZ
JMP OCLOE1
DCA OOPNI1
ISZ OCLOS
JMP I OCLOS
OCLOE1, STL RAR
JMP I OCLOS
OCNT, 0
OCHAR, .-.
AND (377
DCA OCHRT1
JMP I OCHRS1
OCHR1, ISZ OCHAR
OCHR2, JMS OCHRS1
JMS OCHRS2
JMS OCHRS2
CMA CLL RAL
TAD OCHRP2
DCA OCHRP2
JMS OCHRS3
JMS OCHRS3
ISZ OCNT
JMP OCHR1
CDF CURFLD
JMS OWRIT
JMP OCHRE1
JMP OCHR1
OCHRS1, .-.
JMP I OCHAR
OCHRS2, .-.
TAD OCHRT1
DCA I OCHRP2
ISZ OCHRP2
ISZ OCHAR
JMS OCHRS1
JMP I OCHRS2
OCHRS3, .-.
TAD OCHRT1
CLL RTL
RTL
DCA OCHRT1
TAD OCHRT1
AND (7400
TAD I OCHRP2
DCA I OCHRP2
ISZ OCHRP2
JMP I OCHRS3
OCHRP2, 0
PAGE
OCHRE1, CLA /ERROR FROM OCHR
DCA OOPNI1
JMP OCHR2
OOPEN, .-.
TAD OOPNI1 / GET "OPENED" FLAG
SZA CLA
JMP OOPNE1 /ONLY 1 OUTPUT FILE OPEN AT A TIME
TAD OOPNEX
SNA
TAD OODFX / IF NO SPECIFIC EXTENSION, IMPLY DEFAULT
DCA OOPNEX
TAD OFT
AND (17
SNA
JMP I OOPEN
CIF 10
JMS I P200 / USR IS LOCKED IN
1
OOPNT1, ZZZ
JMP OOPNE1
TAD OOPNT1
DCA OHNDAD
TAD (OFLNM
DCA OOPN1
TAD OFT
CIF 10
JMS I P200
3 /ENTER
OOPN1, OFLNM
OLIM, 0
JMP OOPNE1
ISZ OOPNI1
TAD OOPN1
JMS OSETUP
TAD (OCHR2+1
DCA OCHRS1
DCA OLEN
ISZ OOPEN
OOPNE1, JMP I OOPEN
OSETUP, .-.
DCA OBLK
TAD (-200^ZZZOR
DCA OCNT
TAD OCHRP1
DCA OCHRP2
JMP I OSETUP
OOPNCW, 0 / OPEN OUT CONTROL WORD
OFLNM, 0;0;0 / OUTPUT FILENAME
OOPNEX, 0 / OUTPUT EXTENSION
OODFX, 1520 / "MP" ( DEFAULT EXTENSION )
OOPNP1, 0
OOPNP2, 0
OOPNI1, 0
PAGE
/ ONE-TIME CODE TO TEST FOR BATCH, & DIVERT CONSOLE OUTPUT
STARTT, TAD .+2
DCA I ASP1 / DISCONNECT LINK TO HERE
JMS I AUSRL / LOCK IN USR
TAD I A7777
CLL RAL
SMA CLA
JMP I EX1TIM+1 / NO BATCH ; RETURN
TAD I A7777
AND Z70
TAD TTYFAK
DCA TTYFAK / CIF TO BATCH
TAD I 16
DCA I 17
ISZ TEMP / OVERWRITE TYPE ROUTINE
JMP .-3
EX1TIM, JMP I .+1
START+2
ASP1, START+1
A7777, 7777
Z70, 70
TTYFAK, RELOC TYPE+2
CIF
JMS I .+3
CLA
JMP I TYPE
7400 / LOG TO BATCH
RELOC
$$$$$$$$