 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

