.
.         TABLE OF CONTENTS EDITOR  (A COMMAND PROCESS)
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          AXR$
          DEFUNCT$
          FANG
.
          PURE      CODE
.
TOCP*     R$DIT     .                   ENTER RDIT$ MODE
          P         PRINTER             LOCK THE PRINTER
          LR,U      R13                 CLEAR HEADING BEING GENERATED FLAG
          LA        A8,CDOPTS,X8        LOAD COMMAND OPTIONS
          TOP,U     A8,OPTION('N')      SUMMARY TOC ONLY ?
          TEP,U     A8,OPTION('S')      SHORT HEADING ?
          J         NOHDG               YES.  DON'T GENERATE HEADING
          TEP       A8,(OPTION('H'))    SUPPRESS HEADING ?
          J         NOHDG               YES.  SUPPRESS IT
          TEP,U     A8,OPTION('L')      LONG HEADING DESIRED ?
          J         GENHDG              YES.  GENERATE IT
          JDEM      NOHDG               ...OTHERWISE HEADING FOR BATCH ONLY
GENHDG    LR,U      R13,1               SET HEADING BEING GENERATED
          if        prtcng
          e$fd1     ('G,,1,')           edit control flags for heading
          else
          e$fd1     ('H,,1,')           edit control flags for heading
          endf
          E$CHAR    '['                 EDIT LEFT BRACKET
          LX        X5,CDIMG,X8         LOAD LINK TO IMAGE BUFFER
          LMJ       X6,ESNV             EDIT STATEMENT NUMBER
          E$SKIP    -1                  BACK UP OVER LAST CHARACTER
          U$LOOK    .                   LOAD THE CHARACTER
          JE        A0,'.',TOVDT        REDUNDANT DOT ?
          E$SKIP    1                   NO.  PRESERVE LAST CHARACTER OF NUMBER
TOVDT     E$CHAR    ']'                 EDIT RIGHT BRACKET
          if        prtcng=0
          E$COL     0                   TAB TO START OF IMAGE
FXSN      U$CHAR    .                   LOAD A CHARACTER
          JE        A0,' ',FNHDG        DONE IF IT'S A SPACE
          JNE       A0,'.',FXSN         SCAN ON IF NOT A PERIOD
          E$SKIP    -1                  BACK UP OVER PERIOD IN IMAGE
          E$CHAR    '-'                 REPLACE IT WITH AN INNOCUOUS DASH
          J         FXSN                KEEP ON SCANNING
          endf
FNHDG     E$COL     60                  TAB TO CENTRE OF PAGE
          LX        X5,CDBPC,X8         LOAD LINK TO PARAMETER
          LX        X5,ELFDT,X5         LOAD LINK TO FDT
          LMJ       X6,EFILE            EDIT FILE NAME
          if        prtcng=0
          E$FD3     (' .L,0')           EJECT AFTER HEADING
          endf
          LA,H2     A0,,X1              LOAD IMAGE ADDRESS
          LXI,U     A0,22               LOAD IMAGE LENGTH
          PRTCN$    .                   SUBMIT CONTROL IMAGE
          if        prtcng
          prtcn$    ('l,0 . '),1        eject to a new page
          endf
          E$DITX    .                   TERMINATE EDIT MODE
          E$DIT     .                   RE-ENTER EDIT MODE TO CLEAR IMAGE
          J         TBEGIN              BEGIN THE TOC
NOHDG     .
          E$CHAR    '['                 EDIT OPEN BRACKET
          LX        X5,CDIMG,X8         LOAD IMAGE BUFFER ADDRESS
          LMJ       X6,ESNV             EDIT STATEMENT NUMBER
          E$SKIP    -1                  BACK UP OVER LAST CHARACTER
          U$LOOK    .                   PEEK AT NEXT CHARACTER
          TNE,U     A0,'.'              IS IT A DOT ?
          J         TOVDOT              YES.  OVERLAY IT WITH ']'
          E$SKIP    1                   NO.  PRESERVE VITAL INFORMATION
TOVDOT    E$CHAR    ']'                 EDIT CLOSING BRACKET
          E$SKIP    2                   SKIP TWO SPACES
          LX        X5,CDBPC,X8         LOAD LINK TO PARAMETER
          LX        X5,ELFDT,X5         GET FDT ADDRESS
          LMJ       X6,EFILE            EDIT FILE NAME
          R$PRT     1                   PRINT THE HEADER LINE
TBEGIN    LX        X9,CDBPC,X8         LOAD ELEMENT CLASS PARAMETER
          LA        A6,CDOPTS,X8        LOAD COMMAND OPTIONS
          AND       A6,(OPTION('D'))    DELETED ELEMENTS WANTED ?
          LMJ       X11,FILESCAN        PREPARE ELEMENT SELECT ITEM LIST
          J         BSRTOC              BSP ERROR.  PRINT MESSAGE AND QUIT
          JZ        A8,TOCEMT           NO ELEMENTS SELECTED.  ANALYSE WHY
          LA        A8,CDOPTS,X8        LOAD COMMAND OPTIONS
          TEP       A8,(OPTION('A'))    ALPHABETISE THE TOC ?
          LMJ       X11,FILESORT        YES.  SORT THE ELEMENT ITEMS
          TOP       A8,(OPTION('B'))    WAS THE 'B' OPTION SPECIFIED ?
          J         NOBKWD              NO.  DON'T DO REVERSE TOC
          LA,U      A0,CDELTQ,X8        YES.  LOAD ADDRESS OF ELEMENT QUEUE
.
.         REVERSE THE ELEMENT QUEUE FOR THE 'B' OPTION
.
RVENX     LA        A1,QFL,A0           LOAD LINK TO NEXT ELEMENT
          LA        A2,QHL,A0           LOAD LINK TO PREVIOUS ELEMENT
          SA        A1,QHL,A0           SET NEXT AS PREVIOUS ELEMENT
          SA        A2,QFL,A0           SET PREVIOUS AS NEXT
          LA        A0,A1               LINK TO NEXT ELEMENT
          TE,U      A1,CDELTQ,X8        ALL PACKETS PROCESSED ?
          J         RVENX               NO.  LOOP TO PROCESS THEM
NOBKWD    .
          LA        A0,A14              LOAD FTI ADDRESS
          LXI,U     A0,1                LOAD INCREMENT
          LR,U      R1,GTTYPE-1         LOAD LOOP COUNT
          SZ        0,*A0               CLEAR FTI TO USE IT FOR COUNT BY TYPE
          JGD       R1,$-1              LOOP FOR EACH KNOWN TYPE
          LA,U      A9                  CLEAR FIRST TIME FLAG
.
TOCLOOP   REMOVE    CDELTQ,X8           GET THE NEXT ELEMENT TO PROCESS
          TNE,U     A1,CDELTQ,X8        IS THIS THE END OF THE LIST ?
          J         ENDET               YES.  PRINT SUMMARY IF REQUIRED
          ANA,U     A1,EIFQ             BACK UP TO START OF BUFFER
          LX,U      X9,,A1              LOAD ELEMENT FIND ITEM ADDRESS
          LA        A10,EISEQ,X9        LOAD ELEMENT SEQUENCE NUMBER IN FILE
          JNZ       A9,NOTTFT           FIRST ELEMENT SELECTED ?
          JDEM      NOTTFT              SKIP IT IF DEMAND MODE
          TOP,U     A8,OPTION('S')      SHORT FORMAT ?
          TEP,U     A8,OPTION('N')      SUPER SHORT FORMAT ?
          J         NOTTFT              YES.  SKIP HEADING EDITOR
          HEADING   TOCHEAD,2 TO$NV,TO$TY,TO$DAT,TO$TI,TO$PL,;
                            TO$TL,TO$CL-1,TO$CM,TO$LOC,TO$FLG+4
NOTTFT    AA,U      A9,1                BUMP ELEMENTS SELECTED
          LMJ       X5,TOCLE            EDIT TOC LINE
          LA        A0,EITYP,X9         A0 = ELEMENT TYPE
          ANA,U     A0,TY$REL-1         SET RELOCATABLE TO TYPE 1
          TP        A0                  DID TYPE GO NEGATIVE ?
          LA,U      A0                  YES.  SET TYPE TO SYMBOLIC
          AA        A0,A14              COMPUTE TYPE ADDRESS IN FTI
          LA        A1,,A0              LOAD TYPE COUNT WORD
          AA,U      A1,1                INCREMENT TYPE COUNT
          SA        A1,,A0              UPDATE RUNNING TYPE COUNT
          BRELR     X9                  RELEASE ELEMENT FIND ITEM
          J         TOCLOOP             LOOP FOR EACH ELEMENT FOUND
.
ENDET     LA        A0,R7               LOAD TOTAL DELETED SPACE IN FILE
          MI,U      A0,100              MULTIPLY BY 100 TO COMPUTE PERCENT
          DI        A0,R6               A0 = PERCENT OF FILE DELETED SPACE
          SA        A0,R6               SET R6 TO PERCENT DELETED
          LA        A0,R7               LOAD DELETED SPACE TOTAL
          SSL       A0,6                COMPUTE TRACKS SAVED BY A PACK
          SA        A0,R7               SET TRACKS SAVED INTO R7
          TOP,U     A8,OPTION('N')      SUMMARY TOC DESIRED ?
          J         CHECKDEL            NO.  CHECK ABOUT DELETED MESSAGE
          LR,U      R5,GTTYPE-3-1       LOAD TYPE EDITING LOOP COUNTER
          LX        X7,A14              LOAD FTI ADDRESS
TOCSUL    TNZ       0,X7                ANY ELEMENTS OF THIS TYPE ?
          J         NONTHS              NO.  SKIP THIS TYPE IN SUMMARY
          E$DECV    0,X7                EDIT COUNT OF ELEMENTS THIS TYPE
          E$SKIP    1                   SKIP AFTER NUMBER
          LA,U      A0,,X7              LOAD TYPE TABLE ADDRESS
          ANA       A0,A14              COMPUTE INDEX TO TABLE
          TZ        A0                  SYMBOLIC TYPE ?
          AA,U      A0,TY$REL-2         NO.  BASE UP TO RELOCATABLE TYPE
          LA,H1     A0,TYPTAB+1,A0      LOAD CONCISE NAME FOR TYPE
          E$FD1     0,A0                EDIT IT
          E$FD3     (', ')              EDIT COMMA AND SPACE AFTER IT
NONTHS    AX,U      X7,1                INCREMENT TO NEXT TYPE
          JGD       R5,TOCSUL           LOOP FOR ALL KNOWN TYPES
          LA        A0,R6               LOAD PERCENT DELETED
          JZ        A0,PXDLT            NO DELETED SPACE ?
          TZ        R7                  WOULD A PACK SAVE ANY SPACE ?
          TLE,U     A0,THRESHD          ABOVE THRESHOLD TO COMPLAIN ?
          J         $+2                 NO.  TELL PERCENT DELETED IN SUMMARY
          J         PXDLT               REGULAR MESSAGE IS COMING OUT, DON'T
          E$DECV    .                   EDIT PRECENT DELETED
          E$FD4     ('% DEL, ')         LABEL THE NUMBER
PXDLT     E$SKIP    -2                  BACK UP TO LAST COMMA
          E$CHAR    '.'                 EDIT A PERIOD
          R$PRT     1                   PRINT THE SUMMARY LINE
CHECKDEL  LA        A0,R6               LOAD PERCENT DELETED
          TZ        R7                  ANY SPACE TO BE SAVED BY PACK ?
          TLE,U     A0,THRESHD          ABOVE THRESHOLD TO COMPLAIN ?
          J         TOCEND              NO.  SHUT UP
          E$MSG     DELYAP              YES.  EDIT THE MESSAGE
          E$DECV    R6                  EDIT PERCENT DELETED
          E$MSGR    .                   COPY REST OF MESSAGE
          R$PRT     1                   PRINT IT
TOCEND    TNZ       R13                 HEADING TURNED ON ?
          J         TOCEN1              NO.  SKIP HEADING TURN-OFF
          E$FD4     ('H,N .L,0')        TURN OFF HEADING AND EJECT
          LA,H2     A0,,X1              LOAD IMAGE ADDRESS
          LXI,U     A0,4                LOAD LENGTH
          PRTCN$    .                   TURN OFF HEADING
TOCEN1    R$DITX    .                   TERMINATE EDIT MODE
          V         PRINTER             UNLOCK THE PRINTER
          BRELA     .                   RELEASE ALL ALLOCATED BUFFERS
          COMPLETE  .                   TERMINATE THE COMMAND
.
.         BSP ERROR READING FTI OR ELEMENT TABLE
.
BSRTOC    DS        A0,R3               STORE BSP ERROR STATUS
          R$DITX    .                   TERMINATE EDITING MODE
          DL        A0,R3               RELOAD ERROR STATUS
          la        a2,a14              load the BSP FCT address
          LMJ       X11,BSPERP          PRINT BSP ERROR MESSAGE
          ZAP       .                   ERROR THE COMMAND
          R$DIT     .                   ENTER EDIT MODE AGAIN
          J         TOCEND              TERMINATE THE TOC COMMAND
.
.         NO ELEMENTS SELECTED...
.
TOCEMT    JZ        A10,FILEMT          BECAUSE NO ELEMENTS IN FILE ?
          TNE       A9,A10              BECAUSE ALL ELEMENTS WERE DELETED ?
          J         ALLDEL              YES.  EDIT MESSAGE FOR THAT
          E$MSG     NOSM                USER'S CLASS SELECTED NO ELEMENTS
TOCOPR    R$PRT     1                   PRINT THE IMAGE
          J         TOCEND              CLOSE THE PRINTING OUT
.
ALLDEL    E$MSG     ALLDEM              'ALL ELEMENTS DELETED.'
          J         TOCOPR              PRINT THE MESSAGE
.
FILEMT    E$MSG     EMTM                'FILE EMPTY.'
          J         TOCOPR              PRINT IT AND WIND UP
.
.
.         TOC LINE EDITOR
.
.         ENTER WITH X9 = ELEMENT TABLE ITEM   IN RDIT$ MODE
.         A10 = SEQUENCE NUMBER
.
TOCLE*    TEP,U     A8,OPTION('L')      'L' OPTION SPECIFIED ?
          J         BAFOT               YES.  EDIT BATCH FORMAT
          TEP,U     A8,OPTION('S')      'S' OPTION ON ?
          J         DEMTLE              YES.  EDIT DEMAND
          TEP,U     A8,OPTION('N')      SUPER SHORT SUMMARY FORMAT ?
          J         0,X5                YES.  DON'T EDIT ANYTHING
          JDEM      DEMTLE              EDIT SHORT FORMAT IF DEMAND
BAFOT     JNZ       A10,BAFO1           EDIT SEQUENCE IF NONZERO
          E$FD3     ('T: ')             TRANSFER.  EDIT TRANSFER FLAG
          J         BAFO2               EDIT REST OF TOC ENTRY
BAFO1     E$DECF    3,A10               EDIT THE SEQUENCE NUMBER
BAFO2     E$COL     TO$NV               TAB TO NAME COLUMN
          LMJ       X6,EDENA            EDIT NAME AND VERSION
          E$COL     TO$TY               TAB TO TYPE COLUMN
          la        a1,eityp,x9         load major element type
          tg,u      a1,maxxtp           known type ?
          la,u      a1,maxxtp           no.  call it 'funny type'
          sa        a1,a4               save major element type
          e$msg     typtab,a1,h2        edit the generic type
          la        a1,eipcod,x9        load processor code for element
          tne,u     a4,ty$omn           is this an Omnibus element ?
          te,u      a1,embstyp          yes.  is it EMBED ?
          j         bafonemb            no.  skip special fudge
          e$msg1    embmsg              edit EMBED into the line
          j         bafonst             skip into normal code
.
bafonemb  te,u      a4,ty$sym           is it symbolic ?
          tne,u     a4,ty$omn           ...or omnibus ?
          j         $+2                 yes.  go edit subtype, if any
          j         bafonst             no.  no subtype for this type
          tz        a1                  was it specified ?
          tg,h2     a1,sstyp$           yes.  within range of table ?
          j         bafonst             no.  skip editing it
          e$skip    1                   skip a space before subtype
          la        a1,eipcod,x9        load subtype for element
          e$fd1     sstyp$+1,a1         yes.  edit it
bafonst   E$COL     TO$DAT              TAB TO DATE COLUMN
          LA        A4,EITIME,X9        LOAD TIME OF ELEMENT ENTRY
          SSC       A4,18               CHANGE TO TDATE$ FORMAT
          E$DAY2    A4                  EDIT THE DATE DD MMM YY
          E$COL     TO$TI               TAB TO TIME COLUMN
          E$TIME    A4                  EDIT THE TIME
          LA        A0,EITYP,X9         LOAD THE TYPE
          JNE       A0,TY$REL,NOPREL    RELOCATABLE ?
          E$COL     TO$PL               YES.  TAB TO PREAMBLE LENGTH FIELD
          E$DECF    4,EIPREL,X9         EDIT PREAMBLE LENGTH
NOPREL    E$COL     TO$TL               TAB TO TEXT LENGTH COLUMN
          E$DECF    4,EITXTL,X9         EDIT TEXT LENGTH
          LA        A0,EITYP,X9         LOAD THE TYPE
          JNE       A0,TY$SYM,NOCYL     SYMBOLIC ELEMENT ?
          E$COL     TO$CL               YES.  TAB TO CYCLE LIMIT POSITION
          E$DECF    2,EICLIM,X9         EDIT CYCLE LIMIT
          E$COL     TO$CM               TAB TO OLDEST CYCLE COLUMN
          LA        A0,EILATC,X9        LOAD LATEST CYCLE PRESENT
          ANA       A0,EINOCY,X9        SUBTRACT CYCLES PRESENT
          E$DECF    3,1,A0,U            EDIT OLDEST CYCLE PRESENT
NOCYL     E$COL     TO$LOC              TAB TO TEXT LOCATION ADDRESS
          E$DECF    7,EITXTA,X9         EDIT TEXT ADDRESS
          E$COL     TO$FLG              TAB TO FLAGS FIELD
          TP        EIFLG,X9            DELETED ELEMENT ?
          J         EDELT               YES.  GO EDIT DELETED MESSAGE
          LA        A4,EIFLG,X9         GET FLAGS
          AND,U     A4,FL$QW++FL$TW     AND OFF SENSITIVITY CODES
          JZ        A5,NOQWB            ANY SENSITIVITY MARKING ?
          LA        A0,A5               LOAD SENSITIVITY CODE
          E$FD2     ESALEN-2,A0         EDIT SENSITIVITY
          E$SKIP    1                   SKIP AFTER THE FIELD
NOQWB     TOP,U     A4,FL$ERR           MARKED IN ERROR ?
          J         CHKASC              NO.  CHECK ASCII BIT
          E$FD2     ('(ERROR)')         EDIT ERROR INDICATOR
          E$SKIP    1                   SKIP AFTER FLAG
CHKASC    TOP,U     A4,FL$ASC           ASCII TEXT ?
          J         CHKAFC              CHECK AFCM MODE BITS
          E$FD3     ('ASCII ')          ASCII.  EDIT MESSAGE
CHKAFC    AND,U     A4,FL$AFCM++FL$AFNI AND OFF AFCM PSR SET BITS
          JZ        A5,ENOFLG           ANY AFCM BITS ON ?
          SSL       A5,4                CONVERT TO MESSAGE INDEX
          LA        A0,A5               LOAD AS INDEX TO TABLE
          E$FD4     AFCMODE-2,A0        EDIT COMPATIBILITY MODE
ENOFLG    R$PRT     1                   PRINT THE LINE
          J         0,X5                RETURN
.
EDELT     E$FD2     ('(DELETED)')       EDIT DELETED INDICATOR
          J         ENOFLG              FINISH UP
.
.         DEMAND FORMAT EDITOR
.
DEMTLE    JNZ       A10,DEMTL1          SKIP IF NORMAL TOC
          E$FD3     ('T: ')             EDIT TRANSFER INDICATOR
demtl1    la        a1,eityp,x9         load major element type
          tg,u      a1,maxxtp           out of range ?
          la,u      a1,maxxtp           yes.  call it '???'
          la        a2,eipcod,x9        load the processor code of element
          tne,u     a1,ty$omn           is it an Omnibus element ?
          te,u      a2,embstyp          yes.  is it EMBED ?
          j         demtlnem            no.  skip into normal code
          e$fd1     ('O-EMB')           yes.  label it as embed
          j         demtlte             skip into the normal code
.
demtlnem  te,u      a1,ty$sym           is it symbolic ?
          tne,u     a1,ty$omn           no.  is it omnibus ?
          j         $+2                 yes.  go check for subtype
          j         demtlns             no.  it doesn't have a subtype
          la        a2,eipcod,x9        yes.  load processor code
          tz        a2                  does it have a subtype ?
          tg,h2     a2,sstyp$           is it in range ?
          j         demtlns             no.  edit only major type
          te,u      a1,ty$omn           is major type omnibus ?
          j         demtlno             no.  skip special editing
          sa        a2,a4               save subtype
          e$fd1     ('O-')              indicate this is omnibus
          la        a2,a4               reload processor code
demtlno   la        a0,sstyp$+1,a2      load the subtype name
          dsl       a0,12               shift off lower two characters
          sa        a1,a4               save a bit
          e$fd3     .                   edit all of first four
          e$fd1     a4                  and rest if nonblank
          j         demtlte             continue with element name
.
demtlns   e$copy    4,typtab,a1,h1      edit name for major type
demtlte   E$SKIP    1                   SKIP A SPACE AFTER IT
          LMJ       X6,EDENA            EDIT NAME AND VERSION
          TN        EIFLG,X9            ELEMENT DELETED ?
          J         NODD                NO.  SKIP FLAG EDITING
          E$FD3     (' (D)')            EDIT DELETED INDICATOR
NODD      R$PRT     1                   PRINT THE LINE
          J         0,X5                RETURN
.
.         NAME AND VERSION EDITOR
.
EDENA*    E$FD2     EIEN,X9             EDIT THE ELEMENT NAME
          LA        A0,EIVER,X9         LOAD VERSION
          TNE       A0,R15              BLANK ?
          J         TLECY               YES.  CHECK CYCLE
          E$CHAR    '/'                 EDIT SLASH
          E$FD2     EIVER,X9            EDIT VERSION
TLECY     LA        A0,EITYP,X9         LOAD ELEMENT TYPE
          JNE       A0,TY$SYM,NOCED     DON'T EDIT IF SYMBOLIC
          TNZ       EILATC,X9           SKIP IF CYCLE ZERO, ALSO
          J         NOCED               SO OUTPUT IS PRETTY
          E$CHAR    '('                 EDIT LEFT PARENTHESIS
          E$DECV    EILATC,X9           EDIT THE CYCLE
          E$CHAR    ')'                 EDIT RIGHT PARENTHESIS
NOCED     J         0,X6                RETURN
.
          PURE      DATA
.
.         ELEMENT TYPE NAMES
.
TY(0)     'STRANGE TYPE, ZERO!'
TY(1)     'SYMBOLIC!'
TY(2)     'ASSEMBLER PROC!'
TY(3)     'COBOL PROC!'
TY(4)     'FORTRAN PROC!'
TY(5)     'RELOCATABLE!'
TY(6)     'ABSOLUTE!'
TY(7)     'OMNIBUS!'
.
.         DEMAND TYPE NAMES
.
DY(0)     '???'
DY(1)     'SYM'
DY(2)     'ASMP'
DY(3)     'COBP'
DY(4)     'FORP'
DY(5)     'REL'
DY(6)     'ABS'
DY(7)     'OMN'
.
TYPTAB    .
I         DO        TY , * DY(I-1),TY(I-1)
MAXXTP    EQU       $-TYPTAB
          *         DY(0),FUNNY
.
FUNNY     'FUNNY TYPE!'
embmsg    ' EMBED!'
.
.         SENSITIVITY CODES
.
ESALEN    'QUARTER'
          'THIRD  '
          'BOTH ? '
.
AFCMODE   'SETAFCM '                    SET INTERRUPT VALID ON F.P.
          'CLRAFCM '                    PROGRAM WILL RUN WITHOUT F.P. FAULT
          'INSAFCM '                    ROUTINE DOES NOT CARE
.
NOSM      'NO ELEMENTS SELECTED.!'
EMTM      'FILE EMPTY.!'
ALLDEM    'ALL ELEMENTS DELETED.!'
TOCHEAD   'SEQ!NAME/VERSION!TYPE!DATE!TIME!PRE!TEXT!MAX!OLD!TEXT ADR!FLAGS!'
DELYAP    'THIS FILE IS !% DELETED ELEMENTS.  PLEASE PACK IT.!'
          END