.
. 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