TITLE 'TELEFILE ASSEMBLY PROGRAM - APEND'
PCC 0
SPACE 6
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
* %%%%% MODULE NAME: APEND %%%%%
* %%%%% LAST UPDATED: MAR 07, 1984 %%%%%
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SPACE 2
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
DGENDP CSECT 1
DEF DGEND
DEF DGENDD
DEF DGENDP
*
REF BO%FLAG
REF CLRLSTBF
REF DEDIT
REF GO%FLAG
REF HWX1SIZE
REF LO%FLAG
REF LSTBF
REF NS%FLAG
REF PGLINES
REF POSITIONX1
REF READX1
REF ROOTRTN
REF SD%FLAG
REF SEGMENT# AP OVERLAY SEGMENT
REF UPDT%ERROR
REF WRITEDO
REF WRITELO
REF X1BUF
*
REF AEDIT
REF BEDIT
REF BEDIT4
REF CTCHRS
REF GENERATE3
REF GETCSADD
REF TYPE
REF XEDIT
*
SYSTEM AP%IL
SYSTEM AP%DG
*
* H E A D
*
HEAD CNAME
PROC
LF DATA S:NUMC(AF)
TEXT AF
PEND
*
* MISCELLANEOUS EQUATES
*
CLOSEFLD EQU X'4000' SYMBOL NUMBER CLOSE FIELD
SDINTSYMCD EQU X'12' LOADER CODE FOR INT. SYM TYPE
PAGE
DGENDD EQU XAPDATA
*
* STORAGE
*
BYTEOFFSET EQU ADV%RTN BYTE OFFSET FOR CONTROL SECTION SUM
COLSIZE EQU ENDADDR COLUMN SIZE FOR SUMMARIES
CSSUBXIT EQU BASE RETURN ADDRESS FOR CSSUB
CURPP EQU BNDEXIT CURRENT PRINT POSITION
DOFLAG EQU BLDPLTXIT WRITE ON 'DO' FLAG
GETSYMRTN EQU ENTEXIT RETURN ADDRESS FOR GETSYM
HEADADDR EQU EXPR%DEF HEADING ADDRESS
MAXPP EQU FND MAX PRINT POSITION FOR SUMMARIES
MOVESYMRTN EQU DOSKIPXIT RETURN ADDRESS FOR MOVESYM
NEXTCS EQU FREELIST NEXT CONTROL SECTION FOR CSSUM
NXT%ITEMRTN EQU GOTOARG RETURN ADDRESS FOR NXT%ITEM
NEXTPP EQU LABELLOC NEXT PRINT POSITION FOR SUMMARIES
NUMEXT EQU DEFLOCXIT NUMBER OF EXTERNAL SYMBOLS
NUMUND EQU DESTIN NUMBER OF UNDEFINED SYMBOLS
SDEDITXIT EQU CSSUBXIT RETURN ADDRESS FROM SDEDIT
SETPPRTN EQU ECTHW RETURN ADDRESS FOR SETPP
SKIPSYMRTN EQU DPIFLAG RETURN ADDRESS FOR SKIPSYM
STARTPP EQU LAST START PRINT POSITION FOR SUMMARIES
SYMCTRTN EQU LFND RETURN ADDRESS FOR SYMCT
SYMSIZE EQU LFSUMSZ SYMBOL SIZE FOR SUMMARIES
TMPPP EQU LINEORG SCRATCH IN 'SDEDIT'
WRITERTN EQU LITSRCHXIT
*
USECT DGENDP
*
BOUND 8
*
RNG%SUM%EXCL ; SYMBOLS EXCLUDED FROM SUMMARY
DATA S:IVAL#,%%#
CNTLHEAD HEAD ' CONTROL SECTION SUMMARY: '
SYMHEAD HEAD ' * SYMBOL VALUES'
EXTHEAD HEAD ' * EXTERNAL SYMBOLS'
UNDHEAD HEAD ' * UNDEFINED SYMBOLS'
ERRHEAD HEAD ' * ERROR SEVERITY LEVEL:'
LINEHEAD HEAD ' * LAST ERROR LINE: '
NUMHEAD HEAD ' * NUMBER OF ERROR LINES:'
NERRHEAD HEAD ' * NO ERROR LINES'
UPDTHEAD HEAD ' * NUMBER OF UPDATE ERRORS:'
CSERRHEAD HEAD ' CONTROL SECTION SIZE ERRORS: '
*
* EXTERNAL TYPES FOR EXTERNAL SUMMARY
*
EXTNAME RES 0
TEXT 'DEF '
TEXT 'REF '
TEXT 'SREF'
PAGE
*
* D G E N D
*
DGEND RES 0
STW,IORL ROOTRTN SAVE RETURN LINK TO ROOT
MTW,+1 SEGMENT# BUMP OVERLAY # (NOW IT'S 4)
LI,XT 0
STW,XT DOFLAG INDICATE NO WRITE ON 'DO'
STW,XT TEXTCT SET NUMBER OF RECORDS READ TO 0
STW,XT NUMEXT SET NUMBER OF EXTERNALS TO ZERO
STW,XT NUMUND SET NUMBER OF UNDEFINES TO ZERO
STH,XT 1STDEF CLEAR 1ST DEF FLAG
BAL,RL CLRLSTBF CLEAR LIST BUFFER
LI,XT 1
STB,XT CSSUBXIT
MTW,0 UPDT%ERROR IF THERE ARE ANY + CARD ERRORS,
BEZ CSSUM UPDATE MAX SEVERITY TO 5
LI,XT 5
CB,XT MAXSEV
BLE CSSUM SEVERITY FOR THIS ERROR NOT MAX
STB,XT MAXSEV UPDATE MAXIMUM SEVERITY
*
* C S S U M
*
CSSUM RES 0
MTW,0 LO%FLAG WAS LO SPECIFIED
BEZ SYMSUM NO, SKIP SECTION SUMMARY
*
BAL,RL WRITE WRITE A BLANK LINE
LI,XT CNTLHEAD ADDRESS OF HEADING
BAL,RL CSSUB CONTROL SECTION SUMMARY
*
* S Y M S U M
*
SYMSUM RES 0
LW,XT LO%FLAG
STW,XT TEMPO SAVE IN CASE 'SD' SPECIFIED
BEZ SYMSUM2 BRIF NOT PRINTING SUMMARY
*
LW,XT NS%FLAG NO SUMMARIES FLAG ON
BNEZ SYMSUM2 BRIF NOT PRINTING SUMMARY
*
STW,XT PGLINES NO, FORCE TOP OF PAGE
B SYMSUM3 'SD' WILL BE TESTED ON THE FLY
*
SYMSUM2 RES 0
LW,XT SD%FLAG
BEZ UNDSUM BRIF NO REASON TO CYCLE THRU SYMS
*
LI,XT 0 MUST CYCLE, BUT KILL PRINT TEMP'LY
STW,XT LO%FLAG
SYMSUM3 RES 0
LI,XT SYMHEAD SET SYMBOL VALUE HEADING
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
BAL,RL WRITE WRITE HEADING
LI,LBX 10 STARTING PRINT POSITION
LI,XT 25 COLUMN SIZE
LI,XT1 85 MAXIMUM PRINT POSITION
BAL,RL SETUP%PP SET UP PRINT POSITIONS
BAL,RL READSYM READ FIRST RECORD
SYMSUM5 RES 0
BAL,RL GETSYM GET NEXT SYMBOL
B SYMSUM20 NO MORE SYMBOLS
LV,XT1 EXTFLD
AW,XT SYMT BUILD POINTER TO SYMBOL VALUE
STW,XT ARG SAVE
LW,XT 0,XT GET VALUE
BLZ SYMSUM10 IT IS NOT A POINTER
AND,XT L(LPTRFLD) POINTER, CLEAN OFFSET
BEZ SYMSKIP OFFSET = 0, SYMBOL = COMMAND
AW,XT SYMT BUILD POINTER TO SYMBOL VALUE
STW,XT ARG SAVE
LW,XT 0,XT GET VALUE
SYMSUM10 RES 0
LI,XS '/'
CS,XT L(DEFEXT)
BG SYMSUM15 ITS A REF OR SREF
BL SYMSUM12 ITS NOT A DEF
MTW,1 NUMEXT COUNT EXTERNAL SYMBOLS
LI,XS '-' DEF SYMBOL
SYMSUM12 RES 0
CV,XT DEFFLD IS SYMBOL UNDEFINED
BANZ SYMSUM13 NO
CV,XT SPAFLD IS SYMBOL REFERENCED
BE SYMSKIP NO
MTW,1 NUMUND YES, COUNT UNDEFINED SYMBOL
B SYMSKIP
SYMSUM13 RES 0
BAL,RL SYMCT GET NUMBER OF CHARACTERS IN
STW,XT SYMSIZE SYMBOL AND SAVE IT
BAL,RL GETVSIZE GET NUMBER OF CHARACTERS IN VALUE
AW,XT SYMSIZE TOTAL # OF CHARS FOR THIS FIELD
LW,LBX CURPP SET CURRENT PRINT POSITION
BAL,RL TESTOV OUTPUT LINE IF FIELD EXCEEDS BUFFER
BAL,RL MOVESYM MOVE SYMBOL TO LIST BUFFER
CALL SDEDIT BUILD SYMBOL DICTIONARY IN ROM
BAL,RL EDITVAL OUTPUT SYMBOL VALUE
BAL,RL SETPP SET NEXT PRINT POSITION
B SYMSUM5
SYMSUM15 RES 0
MTW,1 NUMEXT COUNT EXTERNAL SYMBOLS
SYMSKIP RES 0
BAL,RL SKIPSYM SKIP SYMBOL
B SYMSUM5 CONTINUE
SYMSUM20 RES 0
BAL,RL WRITEC WRITE A LINE IF THERE IS ONE
LW,XT TEMPO DONE WITH 'SD' TRICKERY - RESET
STW,XT LO%FLAG
*
* E X T S U M
*
EXTSUM RES 0
LI,XT EXTHEAD SET EXTERNAL HEADING
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
MTW,0 NUMEXT ARE THERE ANY EXTERNALS
BNEZ EXTSUM3 YES
BAL,RL PUT%NO% NO, PUT 'NO' IN HEADING
BAL,RL WRITE WRITE HEADING
B UNDSUM GO DO UNDEFINED SUMMARY
EXTSUM3 RES 0
BAL,RL WRITE WRITE HEADING
LCW,IOSIZE TEXTCT GET NUM OF RECORDS IN SYMBOL TABLE
AWM,IOSIZE TEXTCT CLEAR NUM OF RECORDS
BAL,IORL POSITIONX1 BACKSPACE TO START OF TABLE
LI,LBX 10 STARTING PRINT POSITION
LI,XT 15 COLUMN SIZE
LI,XT1 90 MAXIMUM PRINT POSITION
BAL,RL SETUP%PP SET UP PRINT POSITIONS
BAL,RL READSYM READ FIRST RECORD
LI,XS '-'
EXTSUM5 RES 0
BAL,RL GETSYM GET NEXT SYMBOL
B EXTSUM20
STW,XT ARG SAVE SYMBOL NUMBER
LV,XT1 EXTFLD
LW,XT *SYMT,XT GET SYMBOL VALUE
BLZ EXTSUM10 IT IS NOT A POINTER
AND,XT L(LPTRFLD) POINTER CLEAN OFFSET
BEZ EXTSKIP OFFSET = 0, SYMBOL = COMMAND
LW,XT *SYMT,XT GET SYMBOL VALUE
EXTSUM10 RES 0
CS,XT =DEFEXT IS IT AN EXTERNAL
BL EXTSKIP NO
AND,XT1 XT GET EXT VALUE
SHIFT,XT1 EXTLOB,29 FORM BYTE POINTER TO EXTERNAL NAME
STW,XT1 SYMSIZE AND SAVE IT
BAL,RL SYMCT GET NUMBER OF CHARACTERS IN
AI,XT 4 FIELD AND OUTPUT A LINE IF
BAL,RL TESTOV FIELD EXCEEDS LIST BUFFER
BAL,RL MOVESYM MOVE SYMBOL TO LIST BUFFER
LW,XT ARG IF THIS SYMBOL
CW,XT 1STDEF IS THE
BNE EXTSUM12 FIRST DEF,
AI,LBX -1 CHANGE
LI,XT '*' THE '-'
STB,XT LSTBF,LBX TO
AI,LBX 1 AN '*'
EXTSUM12 RES 0
LW,XT1 SYMSIZE
LI,XT 4
EXTSUM15 RES 0
LB,RL EXTNAME-1,XT1 MOVE EXTERNAL TYPE
STB,RL LSTBF,LBX TO THE LIST BUFFER
AI,XT1 1
AI,LBX 1
BDR,XT EXTSUM15
BAL,RL SETPP SET NEXT PRINT POSITION
B EXTSUM5
EXTSKIP RES 0
BAL,RL SKIPSYM SKIP SYMBOL
B EXTSUM5 CONTINUE
EXTSUM20 RES 0
BAL,RL WRITEC WRITE A LINE IF THERE IS ONE
*
* U N D S U M
*
UNDSUM RES 0
MTW,1 DOFLAG SET TO WRITE ON 'DO'
LI,XT UNDHEAD NO
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
MTW,0 SD%FLAG 'SD' SPECIFIED?
BNEZ UNDSUM05 YES, SYMBOL TABLE WAS READ
*
MTW,0 NS%FLAG NO SUMMARIES
BNEZ UNDSUM15 YES, MUST READ SYMBOL TABLE
MTW,0 LO%FLAG WAS 'LO' SPECIFIED
BEZ UNDSUM15 NO, MUST READ SYMBOL TABLE
*
UNDSUM05 RES 0
MTW,0 NUMUND NO, ARE THERE ANY UNDEFINES
BNEZ UNDSUM10 YES
BAL,RL PUT%NO% MOVE 'NO' TO HEADING
BAL,RL WRITE WRITE HEADING
B ERRORSUM GO DO ERROR SUMMARIES
UNDSUM10 RES 0
LCW,IOSIZE TEXTCT NUMBER OF RECORDS READ
AWM,IOSIZE TEXTCT CLEAR NUM OF RECORDS
BAL,IORL POSITIONX1 BACKSPACE TO START OF TABLE
UNDSUM15 RES 0
LI,LBX 10 STARTING PRINT POSITION
LI,XT 15 COLUMN SIZE
LI,XT1 90 MAXIMUM PRINT POSITION
BAL,RL SETUP%PP SET UP PRINT POSITIONS
LI,LBX 106 FORCE OUT HEADING BEFORE 1ST SYMBOL
BAL,RL READSYM READ FIRST RECORD
LI,XS ' '
UNDSUM20 RES 0
BAL,RL GETSYM GET NEXT SYMBOL
B UNDSUM25 FINISHED
LW,XT *SYMT,XT GET SYMBOL VALUE
BLZ UNDSUM22 ITS NOT A POINTER
AND,XT L(LPTRFLD) POINTER, CLEAN OFFSET
BEZ UNDSKIP OFFSET = 0,SKIP
LW,XT *SYMT,XT GET SYMBOL VALUE
UNDSUM22 RES 0
CV,XT SPAFLD IS THIS SYMBOL UNREFERENCED
BE UNDSKIP YES
CV,XT DEFFLD IS SYMBOL UNDEFINED
BANZ UNDSKIP NO
MTW,1 NUMUND COUNT NUMBER OF UNDEFINES
BAL,RL SYMCT OUTPUT LIST BUFFER IF THIS FIELD
BAL,RL TESTOV WILL NOT FIT IN BUFFER
BAL,RL MOVESYM MOVE SYMBOL TO LIST BUFFER
BAL,RL SETPP SET NEXT PRINT POSITION
B UNDSUM20
UNDSKIP RES 0
BAL,RL SKIPSYM SKIP SYMBOL
B UNDSUM20 CONTINUE
UNDSUM25 RES 0
MTW,0 NUMUND BRANCH IF THERE WERE ANY
BNEZ UNDSUM30 UNDEFINED SYMBOLS
BAL,RL PUT%NO% PUT 'NO' IN HEADING
UNDSUM30 RES 0
BAL,RL WRITEC WRITE A LINE IF THERE IS ONE
*
* E R R O R S U M
*
ERRORSUM RES 0
MTW,0 SOCW%FLG
IF,EZ DON'T BOTHER W/ SEVERITY IF SOCW
LB,XT MAXSEV GET ERROR SEVERITY
AI,XT X'0E00' END MODULE LOAD ITEM CODE
STW,XT HEADADDR
LI,NBYTES 2 NUMBER OF BYTES TO OUTPUT
LI,XT1 BA(HEADADDR)+2 ADDRESS OF 1ST BYTE TO OUTPUT
BAL,RL BEDIT OUTPUT MODULE END AND SEVERITY
FI
LI,NBYTES 0
LI,XT1 BA(L(0))
BAL,RL BEDITEND TERMINATE LAST BO RECORD
LI,XT ERRHEAD
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
LW,XT MAXSEV GET ERROR SEVERITY
SLS,XT -8
OR,XT L(X'40F04040') CONVERT TO EBCDIC
CW,XT L(X'40F94040') IS SEVERITY LEVEL > 9
BLE %+2 NO
SW,XT L(X'390000') YES, CONVERT INTO A-F
STW,XT LSTBF+7 STORE IN LIST BUFFER
BAL,RL WRITE WRITE HEADING
MTW,0 NERRS ANY ERRORS
BEZ ERRORS20 NO
LI,XT LINEHEAD
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
LW,XT1 MAJERRLN GET MAJOR ERROR LINE NUMBER
AND,XT1 L(MAJERRFLD) SCRUB POSSIBLE SYSLEVEL *D-END
BAL,RL CTCHRS COUNT NUMBER OF CHARACTERS
AW,LBX XT
STW,LBX XS
AI,LBX -1
BAL,RL DEDIT EDIT TO LO BUFFER
LW,XT1 SUBERRLN IS THERE A SUB ERROR LINE
BEZ ERRORS10 NO
LW,LBX XS YES
LI,XS '.' STORE A '.'
STB,XS LSTBF,LBX IN THE LIST BUFFER
BAL,RL CTCHRS COUNT CHARS IN SUB LINE
AW,LBX XT CALCULATE START OF MINOR LINE NUMBER
STW,LBX XS *D-END
AI,XS +1 *D-END
BAL,RL DEDIT EDIT TO LO BUFFER
ERRORS10 RES 0
LB,XT MAJERRLN SEE IF LAST ERROR WAS *D-END
IF,NZ WITHIN SYSTEM. *D-END
AI,XT 'A'-1 'TWAS *D-END
STB,XT LSTBF,XS *D-END
FI *D-END
BAL,RL WRITE WRITE HEADING
LI,XT NUMHEAD
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
LW,XT1 NERRS GET NUMBER OF ERROR LINES
BAL,RL CTCHRS COUNT CHARS
AW,LBX XT
BAL,RL DEDIT EDIT NUMBER OF ERRORS
BAL,RL WRITE WRITE HEADING
B ERROR30
ERRORS20 RES 0
MTB,0 MAXSEV DON'T OUTPUT 'NO ERROR' HEADING
BNEZ ERROR30 IF SEVERITY IS NON-ZERO
LI,XT NERRHEAD
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
BAL,RL WRITE WRITE 'NO ERROR' HEADING
ERROR30 RES 0
LW,XT1 UPDT%ERROR IF THERE ARE NO UPDATE ERRORS,
BEZ ERROR40 CHECK CONTROL SECTIONS
LI,XT UPDTHEAD
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
BAL,RL CTCHRS COUNT CHARS
AW,LBX XT POSITION FOR RIGHT MOST DIGIT
BAL,RL DEDIT EDIT NUMBER OF UPDATE ERRORS
BAL,RL WRITE WRITE HEADING
ERROR40 RES 0
MTB,0 CSSUBXIT IF THERE ARE NO CONTROL SECTION
BEZ *ROOTRTN SIZE ERRORS, RETURN TO THE ROOT
LI,XT CSERRHEAD ADDRESS OF HEADING
MTB,1 XT INDICATE PROCESSING CS ERRORS
BAL,RL CSSUB CONTROL SECTION ERROR SUMMARY
B *ROOTRTN RETURN TO THE ROOT
PAGE
*
* HERE TO FORCE OUT LAST BO RECORD
BEDITEND RES 0
LW,XT BO%FLAG EXIT IF NO OUTPUT IS SPECIFIED
AW,XT GO%FLAG FOR BOTH 'BO' AND 'GO'
EXIT,EQ RL
*
MTW,0 SOCW%FLG
IF,EZ DON'T CLOBBER DATA UNDER SOCW
LI,XT X'1C' SET RECORD TYPE BYTE TO LAST RECORD,
STB,XT BOBUF MODE= BINARY, & FORMAT= OBJECT
FI
LW,XT BOCT
BEDIT9 RES 0
STB,NBYTES BOBUF,XT STORE ZEROS IN
AI,XT 1 THE UNUSED
CW,XT BOMAX PORTION OF
BL BEDIT9 THE BO BUFFER
LW,XT BOCT PICK UP THE BO COUNT
B BEDIT4 FORCE THE LAST RECORD OUT
PAGE
*
* C S S U B
* THIS SUBROUTINE PRODUCES THE CONTROL SECTION SUMMARY.
*
* INPUT: REGISTER XT CONTAINS THE ADDRESS OF THE HEADING
* TO BE PRINTED, AND A FLAG IN BYTE 0; 0 PRODUCES
* A CONTROL SECTION SUMMARY, 1 PRODUCES A CONTROL
* SECTION ERROR SUMMARY.
*
* OUTPUT: BYTE 0 OF CSSUBXIT CONTAINS A FLAG WHICH IS SET
* IF CSSUB IS PRODUCING A CONTROL SECTION SUMMARY;
* 0 IF NO CONTROL SECTIONS HAVE SIZE INCONSISTENCIES,
* 1 IF ANY HAVE SIZE ERRORS.
*
CSSUB RES 0
STW,RL CSSUBXIT SAVE RETURN ADDRESS
BAL,RL MOVEHD MOVE HEADING TO LIST BUFFER
LI,XT 20 COLUMN SIZE
LI,XT1 60
AW,XT1 LBX MAXIMUM PRINT POSITION
BAL,RL SETUP%PP SET UP PRINT POSITIONS
LI,XT 0
STW,XT NEXTCS BEGIN WITH CONTROL SECTION ONE
CSSUB1 RES 0
MTW,1 NEXTCS INCREMENT CONTROL SECTION NUMBER
LW,XS NEXTCS GET NEXT CONTROL SECTION NUMBER
CW,XS MAXCSECT
BG CSSUB5 BRANCH IF DONE
*
* (LBX IS XT2...IS A ROSE IS A ROSE...)
XW,XS XT2 INPUT REGISTER FOR 'GETCSADD'
BAL,RL GETCSADD GET ADDRESS OF CONTROL SECTION
XW,XS XT2
LW,XT MAXDD,XS GET MAXDD FOR GEN PASS
LV,XT1 MAXDDFLD MASK FOR MAXDD FIELD
CS,XT MAXDD+1,XS BRANCH IF CONTROL SECTION SIZE
BE CSSUB2 IS THE SAME FOR BOTH PASSES
BG CSSUB6 MORE IN GEN PASS IS AN ERROR
LW,XT1 NEXTCS
CW,XT1 LITCS ERROR IF THIS IS NOT THE
BNE CSSUB6 LITERAL CONTROL SECTION
MTW,0 NLITS NOT AN ERROR IF GEN PASS NEEDS
BNE CSSUB2 LESS SPACE FOR LITERALS
CSSUB6 RES 0
MTB,0 HEADADDR
BNEZ CSSUB3 PROCESSING CS ERRORS
MTB,1 CSSUBXIT INDICATE CONTROL SECTION ERROR
LI,XT 7 SEVERITY FOR THIS ERROR IS 7
CB,XT MAXSEV
BLE CSSUB2 SEVERITY FOR THIS ERROR IS NOT MAX
STB,XT MAXSEV UPDATE MAXIMUM SEVERITY
CSSUB2 RES 0
MTB,0 HEADADDR
BNEZ CSSUB1 PROCESSING CS ERRORS
LW,XT MAXDD+1,XS GET MAXDD FOR DEF PASS
CSSUB3 RES 0
STW,XT BYTEOFFSET SAVE CONTROL SECTION SIZE
LW,XT1 NEXTCS GET CONTROL SECTION NUMBER
STB,XT1 XT1 LEFT ADJUST
LI,NBYTES 2
BAL,RL XEDIT EDIT CONTROL SECTION NUMBER
AI,LBX 1
LW,XT1 BYTEOFFSET GET CONTROL SECTION SIZE
LI,XT 0
AND,XT1 =MAXDDFLD CLEAN CONTROL SECTION SIZE
SCD,XT -2 CONVERT TO WORD SIZE
STW,XT BYTEOFFSET SAVE BYTE OFFSET
SLS,XT1 12 LEFT ADJUST
LI,NBYTES 5
BAL,RL XEDIT EDIT CONTROL SECTION SIZE
AI,LBX 1
LW,XT1 BYTEOFFSET
BEZ CSSUB4 DON'T PRINT A ZERO OFFSET
SLS,XT1 -2
LI,NBYTES 1
BAL,RL XEDIT EDIT BYTE OFFSET
AI,LBX -1
CSSUB4 RES 0
AI,LBX 2
LI,XT1 'P' MOVE
STB,XT1 LSTBF,LBX 'PT'
AI,LBX 1 TO
LI,XT1 'T' LIST
STB,XT1 LSTBF,LBX BUFFER
AI,LBX 2
LW,XT1 PT,XS GET PROTECTION TYPE
AND,XT1 =PTFLD CLEAN IT
SHIFT,XT1 PTLOB,3 LEFT ADJUST
LI,NBYTES 1
BAL,RL XEDIT EDIT PROTECTION TYPE
BAL,RL SETPP SET NEXT PRINT POSITION
B CSSUB1
CSSUB5 RES 0
BAL,RL WRITEC WRITE A LINE IF THERE IS ONE
B *CSSUBXIT EXIT
PAGE
*
* E D I T V A L
* EDIT A VALUE ITEM INTO THE LIST BUFFER.
*
* INPUT: ARG POINTS TO THE VALUE ITEM
* DD%TYPE CONTAINS ITEM'S TYPE
* LBX CONTAINS LIST BUFFER INDEX
*
* OUTPUT: THE VALUE IS EDITED INTO THE LIST BUFFER AS:
* A) AN 8 DIGIT VALUE ITEM IF AN SP BINARY INTEGER
* B) AN ADDRESS IF IT'S A NON-EXTERNAL
* C) FX,FS,FL,EXT,D,DPI,OR LFR AS APPROPRIATE
*
EDITVAL RES 0
STW,RL EDITDXIT SAVE EXIT ADDRESS
LW,XT DD%TYPE GET ITEM'S TYPE
SHIFT,XT ETLOB,31 RIGHT ADJUST TYPE
LB,XT EDITVTBL,XT
LI,XS 1
LW,XT3 ARG ADDRESS OF ARGUMENT
LW,XT1 0,XT3 GET ITEM
B EDITVJMP,XT BRANCH ON ITEM'S TYPE
*
EJ COM,8 AF-EDITVJMP
EDITVTBL RES 0
EJ EDITV10 UNDEFINED
EJ EDITV2 SPECIAL ADDRESS
EJ EDITV10 SPECIAL EXTERNAL
EJ EDITV3 SIMPLE ADDRESS
EJ EDITV5 SUM
EJ EDITV10 EXTERNAL
EJ EDITV10 LOCAL FORWARD
EJ EDITV10 LOCAL FORWARD AND HOLD
EJ EDITV10 ONE WORD ADDRESS
EJ EDITV8 SPECIAL INTEGER
EJ EDITV9 BLANK
EJ EDITV6 INTEGER
EJ EDITV10 PACKED DECIMAL
EJ EDITV10 TEXT
EJ EDITV10 FX
EJ EDITV10 FS
EJ EDITV10 FL
EJ EDITV10 DPI
EJ EDITV10 LIST
EJ EDITV10 FUNCTION
BOUND 4
*
EDITVJMP RES 0
* HERE FOR SPECIAL ADDRESS
EDITV2 RES 0
LV,XT ADDFLD MASK FOR ADD FIELD
AND,XT XT1 ADD FIELD AT INTRINSIC RESOLUTION
LV,RL CSFLD MASK FOR CS FIELD
AND,RL XT1
SHIFT,RL CSLOB,7 LEFT ADJUST CONTROL SECTION #
B EDITV4
* HER FOR SIMPLE ADDRESS
EDITV3 RES 0
LW,XT 1,XT3 GET OFFSET AND CONTROL SECTION
LV,RL FCSFLD MASK FOR FCS FIELD
AND,RL XT
SHIFT,RL FCSLOB,7 LEFT ADJUST CONTROL SECTION #
EDITV4 RES 0
SHIFT,XT1 ARLOB,31 RIGHT ADJUST AR FIELD
AND,XT1 =3
SCS,XT 0,XT1 SHIFT OFFSET TO BYTE RESOLUTION
STW,XT TX1 AND SAVE IN TEMP
LW,XT1 RL LOAD LEFT ADJUSTED CONTROL SECTION #
LI,NBYTES 2
BAL,RL XEDIT OUTPUT CONTROL SECTION AS 2 DIGITS
AI,LBX 1 LEAVE A BLANK COLUMN IN LSTBF
LW,XT1 TX1
SLS,XT1 10 LEFT ADJUST WORD OFFSET FOR XEDIT
LI,NBYTES 5
BAL,RL XEDIT OUTPUT WORD OFFSET AS 5 DIGITS
AI,LBX 1 LEAVE A BLANK COLUMN IN LSTBF
LW,XT1 TX1
AND,XT1 =3
BEZ *EDITDXIT EXIT IF NO BYTE OFFSET
BAL,RL DEDIT OUTPUT BYTE OFFSET IF NON-ZERO
AI,LBX 3 AND LEAVE A BLANK FOLLOWING IT
B *EDITDXIT EXIT
* HERE FOR SUM
EDITV5 RES 0
AI,LBX 9 SKIP OVER 9 BYTES
LI,XT1 'S'
STB,XT1 LSTBF,LBX OUTPUT A SUM INDICATOR
AI,LBX -9 BACK UP 9 BYTES
LI,XS 3
* HERE FOR INTEGER
EDITV6 RES 0
LW,XT1 1,XT3 LOAD WORD FOLLOWING CONTROL WORD
EDITV7 RES 0
LI,NBYTES 8
BAL,RL XEDIT OUTPUT 8 HEX DIGITS
AW,LBX XS LEAVE A BLANK AFTER LAST CHAR
B *EDITDXIT EXIT
* HERE FOR SPECIAL INTEGER
EDITV8 RES 0
BFNZ,XT1,1 CCFLD,EDITV10 BRANCH IF SPECIAL INTEGER TEXT
LV,XT VALFLD MASK FOR VAL FIELD
AND,XT1 XT
B EDITV7
* HERE FOR BLANK ITEM
EDITV9 RES 0
LI,XT1 0 OUTPUT A ZERO
B EDITV7
* HERE FOR UNDEFINED, SPECIAL EXTERNAL, EXTERNAL, LOCAL FORWARD,
* LOCAL FORWARD & HOLD, ONE WORD ADDRESS, PACKED DECIMAL,
* TEXT, FX, FS, FL, DPI, LIST, AND FUNCTION
EDITV10 RES 0
LW,XT DD%TYPE
SHIFT,XT ETLOB,31 RIGHT ADJUST ITEM'S TYPE
LB,XT1 EDITVMSGTBL,XT
AI,XT1 BA(EDITVMSG) BYTE ADDRESS OF TEXT MESSAGE
LI,NBYTES 4
BAL,RL AEDIT OUTPUT A 4 CHARACTER MESSAGE
B *EDITDXIT EXIT
*
EM COM,8 BA(AF)-BA(EDITVMSG)
EDITVMSGTBL RES 0
EM UNDMSG UNDEFINED
EM UNDMSG SPECIAL ADDRESS
EM EXTMSG SPECIAL EXTERNAL
EM UNDMSG SIMPLE ADDRESS
EM UNDMSG SUM
EM EXTMSG EXTERNAL
EM LFRMSG LOCAL FORWARD
EM LFRMSG LOCAL FORWARD AND HOLD
EM UNDMSG ONE WORD ADDRESS
EM TEXTMSG SPECIAL INTEGER (TEXT)
EM UNDMSG BLANK
EM UNDMSG INTEGER
EM DMSG PACKED DECIMAL
EM TEXTMSG TEXT
EM FXMSG FX
EM FSMSG FS
EM FLMSG FL
EM DPIMSG DPI
EM LISTMSG LIST
EM FUNCMSG FUNCTION
BOUND 4
*
EDITVMSG RES 0
UNDMSG TEXT 'UND '
EXTMSG TEXT 'EXT '
LFRMSG TEXT 'LFR '
DMSG TEXT 'D '
TEXTMSG TEXT 'TEXT'
FXMSG TEXT 'FX '
FSMSG TEXT 'FS '
FLMSG TEXT 'FL '
DPIMSG TEXT 'DPI '
LISTMSG TEXT 'LIST'
FUNCMSG TEXT 'FUNC'
PAGE
*
* G E T S Y M
*
GETSYM RES 0
STW,RL GETSYMRTN SAVE RETURN LINK
GETSYM5 RES 0
BAL,RL NXT%ITEM GET NEXT SYMBOL
CV,XT X'8000' FINISHED
BANZ *GETSYMRTN YES
CV,XT CLOSEFLD IS THIS SYMBOL CLOSED
IF,AZ DOIF SYMBOL NOT CLOSED
AND,XT L(VFLD) CLEAN SYMBOL NUMBER
CLM,XT RNG%SUM%EXCL
IF,OL DOIF NOT S:IVAL, %, %%
STW,XT SD%TYPE SAVE SYMBOL NO. FOR SD PROCESSING
MTW,+1 GETSYMRTN INCREMENT RETURN ADDRESS
B *GETSYMRTN
FI
FI
*
* HERE TO BYPASS THIS SYMBOL
*
BAL,RL SKIPSYM SKIP SYMBOL
B GETSYM5
PAGE
*
* G E T V S I Z E
*
GETVSIZE RES 0
STW,RL EDITDXIT SAVE RETURN ADDRESS
LW,XT1 *ARG GET CONTROL WORD OF ITEM
BAL,RL TYPE DETERMINE TYPE OF ITEM
SHIFT,XT2 ETLOB,31
LB,XT VSIZETBL,XT2 GET NUMBER OF CHARACTERS FOR VALUE
B *EDITDXIT
*
VSIZETBL RES 0
DATA,1 4 UNDEFINED
DATA,1 10 SPECIAL ADDRESS
DATA,1 4 SPECIAL EXTERNAL
DATA,1 10 SIMPLE ADDRESS
DATA,1 10 SUM
DATA,1 4 EXTERNAL
DATA,1 4 LOCAL FORWARD
DATA,1 4 LOCAL FORWARD AND HOLD
DATA,1 4 ONE WORD ADDRESS
DATA,1 8 SPECIAL INTEGER
DATA,1 8 BLANK
DATA,1 8 INTEGER
DATA,1 4 PACKED DECIMAL
DATA,1 4 TEXT
DATA,1 4 FX
DATA,1 4 FS
DATA,1 4 FL
DATA,1 4 DPI
DATA,1 4 LIST
DATA,1 4 FUNCTION
BOUND 4
PAGE
*
* M O V E H D
*
MOVEHD RES 0
STW,XT HEADADDR SAVE ADDRESS OF HEADING
LW,XT 0,XT GET SIZE (IN BYTES) OF HEADING
AI,XT 3 CONVERT NUMBER OF BYTES
SLS,XT -2 TO NUMBER OF WORDS
MOVEHD1 RES 0
LW,LBX *HEADADDR,XT MOVE
STW,LBX LSTBF-1,XT HEADING TO
BDR,XT MOVEHD1 LIST BUFFER
LW,LBX *HEADADDR GET NEXT POSITION IN LIST BUFFER
EXIT RL
PAGE
*
* M O V E S Y M
*
MOVESYM RES 0
STW,RL MOVESYMRTN SAVE RETURN
BAL,RL NXT%ITEM GET CHAR COUNT AND FIRST CHAR
STW,XT XT1
SLS,XT1 -8 RIGHT ADJUST CHARACTER COUNT
MOVESYM1 RES 0
STB,XT LSTBF,LBX STORE 2ND CHARACTER IN LIST BUFFER
AI,LBX 1 INCREMENT LIST BUFFER INDEX
BDR,XT1 MOVESYM3 DECREMENT CHARACTER COUNT
MOVESYM2 RES 0
STB,XS LSTBF,LBX STORE SEPERATOR
AI,LBX 1 INCREMENT LIST BUFFER INDEX
B *MOVESYMRTN RETURN
MOVESYM3 RES 0
BAL,RL NXT%ITEM GET NEXT 2 CHARACTERS
SCS,XT -8
STB,XT LSTBF,LBX STORE 1ST CHARACTER IN LIST BUFFER
AI,LBX 1 INCREMENT LIST BUFFER INDEX
SCS,XT 8
BDR,XT1 MOVESYM1 DECREMENT CHARACTER COUNT
B MOVESYM2
PAGE
*
* N X T % I T E M
*
NXT%ITEM RES 0
STW,RL NXT%ITEMRTN SAVE RETURN ADDRESS
CI,XW HWX1SIZE
BL NXT%ITM5 BRANCH IF NOT END OF RECORD
BAL,RL READSYM READ NEXT RECORD
NXT%ITM5 RES 0
LH,XT X1BUF,XW GET NEXT ITEM
AND,XT =X'FFFF' CLEAN IT
AI,XW 1 INCREMENT INDEX
B *NXT%ITEMRTN RETURN
PAGE
*
* P U T % N O %
*
PUT%NO% RES 0
LI,XT 'NO' STORE 'NO' IN CHARACTER POSITIONS
STH,XT LSTBF+1 5 AND 6 OF THE LIST BUFFER
EXIT RL RETURN
PAGE
*
* R E A D S Y M
*
READSYM RES 0
MTW,1 TEXTCT BUMP RECORD COUNT
BAL,IORL READX1 READ NEXT RECORD
LI,XW 0 INITIALIZE X1BUF INDEX
EXIT RL RETURN
PAGE
*
* S D E D I T
* IF THE 'SD' OPTION IS IN EFFECT, EDIT TYPE INFORMATION
* INTO THE BINARY FILE FOR THE CURRENT GLOBAL SYMBOL.
*
SDEDIT RES 0
MTW,0 SD%FLAG
EXIT,EQ RL
*
MTW,0 SOCW%FLG
EXIT,NZ NO SD CODES UNDER SOCW CONTROL
*
* THIS TEST IS NOT TOO CLEAN, BUT IS SIMPLY ONE
* WAY OF SAYING, 'IF THE SYMBOL IS DEF'ED - SKIP
* IT HERE; IT WAS OUTPUT AT THE END OF THE DEF PASS
* IN 'DGINT'. (COULD JUST AS WELL TEST 'EXT' FIELD
* BY GOING THRU 'ARG')
*
CI,XS '-' DEF SYMBOL?
EXIT,EQ RL RETURN IF IT IS
*
* CONFORMING WITH META-SYMBOL AS CLOSELY AS POSSIBLE,
* THERE ARE CURRENTLY ONLY NINE VALUE TYPES THAT WILL
* GO OUT IN THE SYMBOL DICTIONARY. SCREEN THEM HERE ---
*
LW,XT1 *ARG GET CONTROL WORD OF VALUE
LW,XT DD%TYPE SET BY CALL TO 'GETVSIZE'
SHIFT,XT ETLOB,31
LB,XT SDJ%TBL,XT
B SDJ%BASE,XT
*
SDJ%TBL RES 0
BYTE,SDJ%BASE SDRET UNDEFINED GLOBAL
BYTE SDSYM SPECIAL ADDRESS
BYTE SDSYM SPECIAL EXTERNAL
BYTE SDSYM ADDRESS
BYTE SDSUM SUM
BYTE SDSYM EXTERNAL
BYTE SDSYM LOCAL FORWARD
BYTE SDSYM LOCAL FORWARD AND HOLD
BYTE SDRET ONE WORD ADDRESS
BYTE SDINT SPECIAL INTEGER
BYTE SDRET BLANK FIELD
BYTE SDINT INTEGER
BYTE SDRET DECIMAL
BYTE SDRET TEXT
BYTE SDRET FX
BYTE SDRET FS
BYTE SDRET FL
BYTE SDRET DPI
BYTE SDRET LIST
BYTE SDRET FUNCTION
*
SDJ%BASE RES 0
*
SDRET RES 0
EXIT RL DOES NOT GO IN DICTIONARY
*
SDINT RES 0
LI,XT1 4 'CONSTANT' RESOLUTION
B SDCOM
*
SDSUM RES 0
AND,XT1 L(LENGTHFLD) CHECK SIZE OF 'SUM'
CI,XT1 3 ONLY 3-WORD SUM WILL USE NORMAL
BNE SDINT 'ADDRESS' RESOLUTION.
*
LI,XT 2 GET SINGLE RELOCATABLE
LW,XT1 *ARG,XT ITEM IN 'SUM'.
SDSYM RES 0
AND,XT1 L(ARFLD)
SHIFT,XT1 ARLOB,31 XT1 IS RESOLUTION
SDCOM RES 0
STW,RL SDEDITXIT
STW,LBX TMPPP (LBX WILL GET CLOBBERED)
*
* DICTIONARY ITEM IS:
* X'12'
* TYPE & RESOLUTION BYTE
* TEXTC OF SYMBOL NAME
* DEFINING EXPRESSION
*
LW,XT SD%TYPE MISNOMER - IS SAVED SYMBOL NO.
LB,XT *SDTT,XT GET TYPE SAVED BY 'DEFINE'
AW,XT XT1 COMBINE TYPE & RESOLUTION
AV,XT SDINTSYMCD**8 MERGE IN LOADER CONTROL
STH,XT ACONVAL
LW,XT SYMSIZE
LI,XT1 2
STB,XT ACONVAL,XT1 COUNT BYTE OF TEXTC NAME
LI,NBYTES 3
LI,XT1 BA(ACONVAL)
CALL BEDIT EDIT 1ST THREE BYTES
LW,XT1 TMPPP
AI,XT1 -1 TO SEPARATOR
LI,XT '*'
STB,XT LSTBF,XT1 CHANGE SEPARATOR TO SD ID
SW,XT1 SYMSIZE BACK UP TO START OF NAME
AI,XT1 BA(LSTBF) FORM BYTE ADDRESS OF NAME
LW,NBYTES SYMSIZE SIZE OF NAME
CALL BEDIT EDIT OUT OF SUMMARY BUFFER
CALL GENERATE3 DEFINE SYMBOL
LW,LBX TMPPP RESTORE LISTING BUFFER INDEX
B *SDEDITXIT
PAGE
*
* S E T P P
*
SETPP RES 0
STW,RL SETPPRTN SAVE RETURN LINK
SETPP1 RES 0
CW,LBX NEXTPP BRANCH IF CURRENT INDEX IS AT OR
BGE SETPP7 BEYOND NEXT COLUMN START
LW,LBX NEXTPP SET OUTPUT INDEX TO NEXT COLUMN
SETPP3 RES 0
STW,LBX CURPP SAVE CURRENT PRINT POSITION
LW,XT1 CURPP CURRENT PRINT POSITION
AW,XT1 COLSIZE PLUS COLUMN SIZE
CW,XT1 MAXPP BECOMES NEXT COLUMN
BG *SETPPRTN START, UNLESS IT
STW,XT1 NEXTPP EXCEEDS MAXIMUM
B *SETPPRTN COLUMN START
SETPP7 RES 0
LW,XT1 NEXTPP
AW,XT1 COLSIZE
STW,XT1 NEXTPP SET NEXT COLUMN START
CW,XT1 MAXPP BRANCH IF NEXT COLUMN START DOES
BLE SETPP1 NOT EXCEED MAXIMUM COLUMN START
SETPP10 RES 0
BAL,RL WRITE WRITE A LINE
LW,LBX STARTPP SET CURRENT INDEX TO START POSITION
B SETPP3
PAGE
*
* S E T U P % P P
*
SETUP%PP RES 0
STW,LBX STARTPP SET START PRINT POSITION
STW,LBX CURPP SET CURRENT PRINT POSITION
STW,XT1 MAXPP SET MAXIMUM PRINT POSITION
STW,XT COLSIZE SET COLUMN SIZE
AW,XT STARTPP
STW,XT NEXTPP SET NEXT PRINT POSITION
EXIT RL RETURN
PAGE
*
* S K I P S Y M
*
SKIPSYM RES 0
STW,RL SKIPSYMRTN SAVE RETURN ADDRESS
BAL,RL NXT%ITEM GET NUMBER OF CHARS IN SYMBOL
STW,XT XT1
SLS,XT1 -9 CONVERT COUNT TO NUMBER OF HALFWORDS
CI,XT1 0
BE *SKIPSYMRTN
BAL,RL NXT%ITEM READ PAST
BDR,XT1 %-1 SYMBOL
B *SKIPSYMRTN
PAGE
*
* S Y M C T
*
SYMCT RES 0
STW,RL SYMCTRTN SAVE RETURN ADDRESS
BAL,RL NXT%ITEM GET NUMBER OF CHARACTERS IN SYMBOL
AI,XW -1 BACK UP INDEX
SLS,XT -8 RIGHT ADJUST CHARACTER COUNT
B *SYMCTRTN RETURN
PAGE
*
* T E S T O V
*
TESTOV RES 0
AW,XT LBX
CI,XT 106 RETURN IF INDEX IS LESS THAN
EXIT,L RL COLUMN 106
STW,RL SETPPRTN SAVE RETURN ADDRESS AND GO WRITE A
B SETPP10 LINE AND RESET PRINT POSITIONS
PAGE
*
* W R I T E C
*
WRITEC RES 0
CW,LBX STARTPP EXIT IF THERE IS
EXIT,EQ RL NO LINE TO PRINT
*
* W R I T E
*
WRITE RES 0
STW,RL WRITERTN SAVE RETURN ADDRESS
MTW,0 LO%FLAG LO SPECIFIED
BEZ WRITE20 NO, DONT WRITE
LI,IOADD LSTBF ADDRESS OF LIST BUFFER
LI,IOSIZE 132 NUMBER OF BYTES TO WRITE
BAL,IORL WRITELO WRITE RECORD
WRITE20 MTW,0 DOFLAG WRITE ON 'DO' ALSO
BEZ WRITE30 NO
LI,IOADD LSTBF YES
LI,IOSIZE 132
BAL,IORL WRITEDO
WRITE30 RES 0
BAL,RL CLRLSTBF CLEAR LIST BUFFER
B *WRITERTN RETURN
*
END