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