.TITLE LIST ;MULTI-COLUMN LISTER ; CHANGE THE VERSION NUMBER! .SBTTL DEFINITIONS .IDENT /V4.0/ ;MODIFIED BY CJD .ENABL LC ;TO OMIT FORM FEED ON FIRST .OPEN, REMOVE ";" IN NEXT LINE NOFF1=0 ; To use PIP's wildcard support, remove ";" in next line (requires you to ; build against PIPUTL.OLB from the RSX distribution kit). PIPWLD=0 ; MODIFICATIONS RECORD: ; ===================== ; V3.3 ; THIS VERSION TABS 8 COLUMNS AND ALLOWS LINE TRUNCATION BY "/TR" ; HEADER CAN BE OMITTED BY /NH SWITCH ; ; CJD 15-Nov-84 ; Omit 1st FF, as shown above. ; Change default page length to 64 lines, was 84. ; Make /SP the default, and allow /-SP. ; Delete redundant (and incorrect) .PARSE calls -- it's all done by OPEN$. ; Exit via JMP $EXST, with status (success, error if command failed) ; Remove redundant run-time FDB initialisations in OPEN$ etc., ; including unused KBIFBD, duplicating one in GCML block. ; Report error on illegal switch, instead of ignoring it and following ones. ; If terminal output, fetch default page size from driver. ; Default input and output filenames to LIST.LST, were DATA.TMP & DATA.LST. ; Use EIS divide instead of subroutine (code elsewhere assume EIS ; available anyway). Delete multiply routine never used. ; CJD 15-Aug-85 ; Merge with VR3.3 from [VAX84D.RCA.SPREAD.MISC], principally addition ; of /EH switch. ; Add /PN:n, defining first page number. ; Add /LN, prefixing each source line by its line (or sequence) no in the file. ; Add /LI:l:h, selecting source line range. ; Increase command line size to 160. bytes to get long /EH strings in. ; Put "PAGE" and "LIST PAUSE>" in mixed case. ; Change default column separator to '|' via definition of COLSEP. ; Make default filetypes GBLDEFable (in DEFINP and DEFOUT). ; Need to have CSI$ND's after EACH switch value table, otherwise ; /xx:a:b:c... can change other switches' values mysteriously. ; Change prompt to LIST>. ; Don't moan about a blank command line -- just reprompt. ; Get lines/page (LMAX) right, allowing for extra header (/EH) and/or ; LIST pause> prompt if terminal. ; Delete PDIBUF, LPBK, and other unused data areas. ; Separate PSECTs into CODE, RWDATA, and RODATA. ; Allocate page buffer, BLOCK, by EXTTSK, saving ~20 blocks of task file space). ; "Fix" the bug that the last page is sometimes junk. See start of PRINT ; for further comment. ; Strip end quotes from /EH and /FA switch values, used to enter LC chars ; or spaces etc.. ; Use Syslib routines for some number conversions etc. (Cures a bug in output ; of page numbers in range x00-x09.) ; Put time into header as well as date. ; Use a read-after-prompt to get "LIST pause>" reply, not GCML$, because ; GCML$ always returns EOF if LISTRS was started with a command line. ; Support wildcards using PIPUTL interface from TRUNC (Spring 81 RSX ; SIG tape [300,110]WLDCRD). Support > 1 file on line anyway. ; Remove embedded spaces from filename. ; Put file I/O error no in error message. ; Allow /LE:1, to do alternating lists (with /NP), as: line 1 |line 2 ; line 3 |line 4 ; Default output to TI: if no '=' in command line. ; If output to a terminal, attach so ^O will work. ; Add /EI = don't strip parity bit, for 8-bit ASCII (assumes terminators ; have bit 7 clear, still.) ; Add /TA = convert multiple spaces to tabs in output (default). ; Add /PI:h:t = set character pitch for header:text on LA printers. ; Correct possible sign extend on MOVB LINSIZ,reg -- OK to use MOV instead. ; ; CJD 17-Dec-85 V4.0 ; Recover sources from disk crash (could only find 8-Aug version). ; Minor efficiency recodings (mainly, use some SOB's where it appears safe). ; Don't output text CPI change if same as header. ; Add: /EV & /OD -- print even/odd pages only. ; /FT:text -- print page footing text (pitch is 3rd arg to /PI). ; /FP -- form feed starts a new page ; /GR:h:t:p -- set (ANSI terminal) graphic rendition ; /WS -- include right indent as /RI or /LN on wrapped lines ; Rename switch bits of SWITC2 S2.xx to avoid testing wrong word. ; Remove dummy conditionals from much testing by earlier developers. ; Load SPSAVE with intial SP (MAC manual says that .LIMIT does this, but ; THIS IS NOT TRUE -- 1st .LIMIT word is LOWEST allowed addr for SP!!!) ; Remove the DOS hangover requiring unused CR+LF at end of output buffers. ; Suppress a blank column if last col on last page page is exactly full ; Prevent output of blank page at EOF if last page was exactly full. ; Partially handle FORTRAN c-c ('1' format only). ; Correct handling of /FF (and /FP) when FF char is not at start of line. ; When /-FF/-FP (default) ignore FF's TOTALLY, don't treat them as EOL. ; Extend input buffer to allow space for max right shift & line number. SPACE=40 XCR=15 XLF=12 XFF=14 XHT=11 ESC=33 COLSEP='| ; Default column separator ;THE FOLLOWING TWO SYMBOLS ARE ONLY USED TO SET BUFFER SIZES. ;THEY REPRESENT THE MAXIMUM PAGE SIZE ;FOR WHICH THE PROGRAM WILL WORK WITHOUT ERROR. THE OUTPUT PAGE ;SIZE MAY BE LESS THAN OR EQUAL TO THE SIZE SPECIFIED. MAXWID=255. ;MAXIMUM # PRINTABLE CHARACTERS IN OUTPUT LINE ;I.E., NOT COUNTING TRAILING CR, LF MAXLIN=88. ;MAXIMUM # LINES ON A PAGE MAXLNO=4 ; Max lth of ASCII line number (9999), excluding trailing space MAXRTS=31. ; Max right shift (2**N-1) .MCALL CSI$,FSRSZ$,GCMLB$,GCMLD$;RSX11D MACROS .MCALL CSI$1,CSI$2,RCML$,GCML$,OPEN$R,OPEN$W,OFID$R,OPEN$ .MCALL CLOSE$,GET$,PUT$,QIOW$C,QIOW$,DIR$ .MCALL FDBDF$,FDAT$A,FDRC$A,FDOP$A;FDB MACROS .MCALL FDOF$L,FCSBT$,NMBLK$,FINIT$,FDAT$R,FDRC$R,FDOP$R .MCALL CSI$SW,CSI$ND,CSI$SV .MCALL GTIM$S,PRINT$ CSI$ .PSECT RWDATA,RW,D CSBLK: .BLKB C.SIZE .EVEN FSRSZ$ 3,,RWDATA ;3 FILES AT A TIME MAX ; FOLLOWING MEANS ASSIGN TI: TO 1 BY TKB CMD: GCMLB$ 1,LST,,1,,160. GCMLD$ ;DEFINE OFFSETS TO ERROR BYTES GCMLD$ ;DEFINE OFFSETS .MACRO WRITE LINK,BUFF,?LBL ; FAKE DOS-11 WRITE CALL WITH BUFFER HDR AND LINKBLOCK MOV BUFF,-(SP) ;STACK LINE BUFFER ADR MOV LINK,-(SP) ;STACK LINK BLOCK ADR BIT #SW.RL,SWITCH ;WANT CONSTANT LENGTH RECORDS? BEQ LBL ; NO JSR PC,COPYRL ; YES, PAD BUFFER LBL: JSR PC,RSXWRT ;WRITE VIA RSX CMP (SP)+,(SP)+ ;CLEAN STACK DECB ROLL ;COUNT LINE .ENDM .PAGE ;RSX11D WRITING SUBROUTINE, CALLED AS FOR A DOS WRITE. ;DECODES COMAND AND FIXES BUFFER HEADER A LA DOS. ;N.B.--TREATS A READ OF A ZERO LENGTH RECORD AS A FLAG ;THAT ENDFILE HAS BEEN SEEN, FOR LACK OF A BETTER WAY TO ;DO IT. .PSECT CODE,RO,I RSXWRT: MOV R0,-(SP) CLR -(SP) ;FIND SOME MORE WORK SPACE MOV 10(SP),R0 ;BUFFER HDR ADDR OF CALL MOV 4(R0),@SP ;SIZE OF BUFFER (NEEDED FOR OUTPUT) ADD #6,10(SP) ;POINT PAST HEADER TO DATA OR TO ;POINTER TO DATA DUMP=4 ;DOS DUMP MODE BIT BIT #DUMP,2(R0) ;IS IT DUMP MODE? BEQ 1$ ;NO, 10(SP) IS DATA ADDR MOV @10(SP),10(SP) ;YES, GET DATA ADDR NOW 1$: PUT$ 6(SP),10(SP),(SP),ERR1 ;WRITE THE DATA TST (SP)+ ;RESTORE STACK MOV (SP)+,R0 ;AND CALL R0 RTS PC ;(THO' NOT COND CODES) ; ;RSXRED--READ A BUFFER WITH FDB ON STACK INSTEAD OF DOS LINK ;OTHERWISE USES DOS BUFFER HEADER JUNK ; SETS CORRECT DOS BITS. RSXRED: MOV R0,-(SP); ;GET A REG TO USE MOV 6(SP),R0 ;CALL BUFFER HDR BICB #100,3(R0) ;CLEAR EOF INDICATOR MOV @R0,-(SP) ;ADDR OF MAX SIZE ADD #6,10(SP) ;POINTER DATA OR ADDR OF DATA ; FOLLOWS HDR BLK IN DUMP MODE. BUFFER ; FOLLOWS HDR DIRECTLY IF NOT.) BIT #DUMP,2(R0) ;TEST DUMP MODE BEQ 1$ ;NOT DUMP MODE; 10(SP) IS DATA ADDR MOV @10(SP),10(SP) ;DUMP MODE. GET DATA ADDR TO STACK 1$: MOV R0,-(SP) ;NEED R0 AFTER READ SO SAVE IT ;IN CASE GET$ SCREWS IT UP. 101$: GET$ 10(SP),12(SP),2(SP) INC LINENO ; Count this line BCC 3$ ;CHECK EOF CMPB #IE.EOF,F.ERR(R0) ;SEE IF EOF BNE 3$ ;IF NOT, IGNORE ERR 102$: MOV @SP,R0 ;ELSE RETRIEVE POINTER BISB #100,3(R0) ;AND SET THE END-OF-FILE BIT BR 399$ ; Don't check line no 3$: BIT #S2.LI,SWITC2 ; Selecting lines? BEQ 399$ ; No, use all of them CMPB F.RTYP(R0),#R.SEQ ; Yes, is this a sequenced file? BEQ 350$ ; Branch if so CMP LINENO,LOLINE ; No, compare count with low line no BLO 101$ ; Just get another line if less CMP LINENO,HILINE ; Compare with hi line no BLOS 399$ ; Use line unless hi passed CLR F.NRBD(R0) ; When set 0 bytes BR 102$ ; and look like EOF 350$: CMP F.SEQN(R0),LOLINE ; Sequenced file, see if too low BLO 101$ ; When get another line CMP F.SEQN(R0),HILINE ; Too hi, ditto BHI 101$ ; Else use it 399$: MOV (SP)+,R0 ;RESTORE BUFHDR POINTER MOV 6(SP),-(SP) ;FDB POINTER ADD #F.NRBD,@SP ;ADDR OF BYTE COUNT READ MOV @(SP)+,-(SP) ;GET # BYTES READ MOV @SP,4(R0) ;SAVE IN BUFFER HDER MOV (SP)+,(SP) ;GET ADDR OF END ADD 10(SP),(SP) ;OF DATA MOV R5,-(SP) ;USE R5 A SEC... MOV 10(SP),R5 ;FDB ADDR BITB #3,F.RATT(R5) ;SEE IF INTERNAL C.C. FILE (AS PIP DIRECTORY) BNE 20$ ;NO, SO OUR TERMINATORS OUGHT TO BE OK. ;IF INTERNAL CARRIAGE CONTROL HAS LEADING CRLF, MAKE IT NULLS. REST OF LST ;EXPECTS TRAILING TERMINATORS, NOT LEADING ONES... MOV 12(SP),R5 ;START OF DATA ADDRESS CMPB (R5),#XCR+1 ;TERMINATOR? BHIS 2$ ;NO CMPB @R5,#XHT ;TAB AND LOWER STAY OK BLOS 2$ CLRB @R5 ;YES, NULL IT. 2$: INC R5 CMPB (R5),#XCR+1 ;CHECK 2ND CHAR AS TERMINATOR TOO BHIS 11$ CMPB @R5,#XHT ;TEST BELOW AND ABOVE BLOS 11$ CLRB @R5 ;IF TERMINATOR MAKE IT NULL BR 11$ 20$: BITB #FD.FTN,F.RATT(R5) ; FORTRAN carriage-control file? BEQ 11$ ; No TST 4(R0) ; Yes, blank line read? BEQ 11$ ; Nothing to process if so CMPB @12(SP),#'1 ; No, FF reqd? BNE 110$ ; No MOVB #XFF,@12(SP) ; Yes, change '1' to FF BR 11$ ; For the present, ignore all other control chars, including 0,+,$ which we ; really ought to deal with somehow. 110$: CLRB @12(SP) ; Lose any other control char ;IF SKIPPING LETTERS ON INPUT, NULL OUT N CHARS AT START OF LINE. 11$: BIT #SW.SL,SWITCH ;SKIPPING CHARS ON INPUT? BEQ 21$ ;NO, NO ACTION MOV R5,-(SP) ;SAVE R4,R5 MOV R4,-(SP) MOV SKPLTR,R5 ;CHARS TO SKIP BGT 22$ CLR R5 ;DEFAULT TO 0 IF NEGATIVE 22$: CMP R5,4(R0) ;DON'T NULL MORE THAN WE READ BLO 23$ ;IF OK, BRANCH MOV 4(R0),R5 ;R5 HAS # TO NULL (FLUSHED ON OUTPUT) 23$: MOV 16(SP),R4 ;ADDR OF START OF DATA 24$: CLRB (R4)+ ;NULL A BYTE DEC R5 BGT 24$ ;DO ALL THAT WHICH WAS ASKED MOV (SP)+,R4 ;RESTORE R4,R5 MOV (SP)+,R5 ; 21$: BIT #S2.RI!S2.LN,SWITC2 ;RIGHT SHIFTING DATA, or numbering lines? BEQ 120$ ;IF EQ NO, SKIP MOV R5,-(SP) MOV R4,-(SP) MOV 16(SP),R4 ;ADDR OF START OF DATA ;R0 = BUFFER HEADER STILL. ;4(R0)= # CHARS READ IN MOV R1,-(SP) MOV R2,-(SP) ;NEED SOME MORE REGS MOV R3,-(SP) MOV RIVAL,R1 ;NO. TO SHIFT RIGHT BY BIC #^C,R1 ;MASK TO 0-MAXRTS SPACES BIT #S2.LN,SWITC2 ; Numbering lines? BEQ 111$ ; No ADD #MAXLNO+1,R1 ; Yes, add spaces for line no 111$: MOV R4,R5 ADD 4(R0),R5 ;R5 = ADDR OF END OF DATA + 1 MOV R5,R2 ;COPY TO R2 ADD R1,R5 ;POINT R5 PAST OLD END MOV 4(R0),R3 ;GET SIZE AGAIN ; DEC R3 BLE 118$ 119$: MOVB -(R2),-(R5) ;COPY STRING UP SOB R3,119$ ;FOR ALL WE GOT 118$: ADD R1,4(R0) ;ADD IN THE NEW SIZE SEEN ADD R1,14(SP) ;ADD SIZE ON STACK TOO 117$: MOVB #SPACE,(R4)+ ;FILL SPACES INTO FRONT OF RECORD SOB R1,117$ ; If line numbering required, insert a 5-digit line (or sequence) number in ; front of buffer. Space was made above. BIT #S2.LN,SWITC2 ; Do we need numbering? BEQ 114$ ; No, branch MOV R0,-(SP) ; Yes, save R0 MOV #BUF,R0 ; Load start of line pointer MOV LINENO,R1 ; Get line number CMPB DTIFDB+F.RTYP,#R.SEQ ; But if records are sequenced BNE 116$ MOV DTIFDB+F.SEQN,R1 ; Show sequence no instead 116$: MOV #MAXLNO*^B100000000000!10.,R2 ; used as conversion control flag BIT #S2.MS,SWITC2 ; Suppressing leading zeroes? BNE 115$ ; Yes BIS #^B11000000000,R2 ; No, set flag bits to keep them (as spaces) 115$: JSR PC,$CBTA ; Convert line no MOV (SP)+,R0 114$: MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R4 MOV (SP)+,R5 120$: MOV (SP)+,R5 ;RESTORE R5 ; ADD CODE TO PERMIT /MS COMPRESS SPACES SWITCH (NULL ALL BUT 1ST OF ; MULTIPLE SPACES BIT #S2.NS,SWITC2 ;NO SPACES READIN? BNE 334$ ;IF SO ENTER THIS CODE BIT #S2.MS,SWITC2 ;NULLING MULTIPLE SPACES? BEQ 30$ ;NO, BRANCH 334$: MOV R5,-(SP) MOV R4,-(SP) ;YES, SAVE A FEW REGS TO USE HERE MOV R2,-(SP) MOV R3,-(SP) MOV 4(R0),R3 ;GET # CHARS WE READ IN MOV 20(SP),R4 ;AND ADDRESS OF START OF LINE READ CLR R5 ;LAST CHARACTER READ STORAGE HERE... 32$: MOVB (R4)+,R2 ;GET A CHARACTER CMPB R2,#SPACE ;A SPACE? BNE 33$ ;NO BIT #S2.NS,SWITC2 ;NO SPACES AT ALL TO BE TREATED ON INPUT? BNE 335$ ;IF SO NULL ANYWAY REGARDLESS OF WHAT LAST WAS CMPB R5,#SPACE ;WAS LAST A SPACE? BNE 33$ ;NO, SAVE LAST AND GET NEXT CHARACTER ; LAST CHARACTER WAS A SPACE AND SO IS THIS ONE...NULL THIS ONE 335$: CLRB -1(R4) ;NULL SECOND AND LATER SPACES... 33$: MOV R2,R5 ;SAVE LAST CHARACTER SEEN DEC R3 ;COUNT DOWN TILL END BGT 32$ ;DONE WHEN NO MORE CHARS LEFT 31$: MOV (SP)+,R3 ;GET BACK REGS MOV (SP)+,R2 MOV (SP)+,R4 MOV (SP)+,R5 30$: MOVB #XCR,@0(SP) ;PUT IN CRLF INC @SP MOVB #XLF,@(SP)+ ADD #2,4(R0) ;ADJUST # BYTES READ COUNTER MOV (SP)+,R0 RTS PC .PAGE .PSECT RWDATA,RW,D FDOF$L ;LOCAL OFFSET DEFS FCSBT$ ;DEFINE BIT NAMES DTIFDB: FDBDF$ ;DATA INPUT FDB FDRC$A ,BUF,MAXWID ;DATA ADDR FDOP$A 3,CSBLK+C.DSDS,DTIFNB DTOFDB: FDBDF$ ;DATA OUTPUT FDB FDRC$A ,BUFA,MAXWID ;BUFFER FDAT$A R.VAR,,MAXWID ;FILE CHARACTERISTICS FDOP$A 4,CSBLK+C.DSDS,DTOFNB .MCALL NBOF$L .PSECT RODATA,RO,D NBOF$L ;LOCALLY DEFINED NAMEBLK OFSETS DTIFNB: .IF NDF PIPWLD NMBLK$ LIST,LST,,SY,0 ;DEFAULT FILENAME BLOCKS ...PC=. .=DTIFNB+N.FTYP .WORD DEFINP .=...PC .ENDC DTOFNB: NMBLK$ LIST,LST,,SY,0 ...PC=. .=DTOFNB+N.FTYP .WORD DEFOUT .=...PC TINAME: .ASCII "TI:" ; Default output if no '=' .EVEN .PSECT RWDATA,D,RW ATTDET: QIOW$ IO.ATT,4,4 ; Attach/detach output device .SBTTL COMMAND STRING PROCESSING .ENABL LSB .PSECT CODE,I,RO LIST: ;INIT & OPEN MOV SP,SPSAV ; Save SP for reset after abnormal exits FINIT$ .IF DF PIPWLD MOV #^RLIS,DN+F.FNAM ; Set up default input filename MOV #^RT ,DN+F.FNAM+2 ; (filetype done later) .ENDC TRY: ;PROMPT HERE AND GET COMMAND LINE MOV SPSAV,SP ;RESET SP (QUICK; DIRTY) ; FINIT$ MOV #S2.TA,SWITC2 ; Reset switches to defaults CLR SWITC3 BIC #^C,SWITCH ; Except for page size MOV #S8.EI,EIGHTB ; Default 7 bits ; ADD RUNTIME FDB INITIALISE ROUTINES FDAT$R #DTIFDB,#R.VAR,#FD.CR,#MAXWID,#-2,#-5 FDAT$R #DTOFDB,#R.VAR,#FD.CR,#MAXWID+4,#-2,#-5 FDRC$R #DTIFDB,,#BUF,#MAXWID+4 FDRC$R #DTOFDB,,#BUF,#MAXWID+4 .PAGE MOV #2,OSMSK ;OUTPUT SWITCH DEFAULTS TO /SP OSDEF==.-4 ; Can GBLPAT here MOV #1,SPCNT ;DEFAULT 1 SPOOLED COPY CLR CMAX ;TO 0 COL CLR ROLL0 CLR PADW CLR RIVAL CLRB HDCPI ; Unspecified pitches CLRB TECPI CLRB FTCPI MOVB #COLSEP,SEPCHR ;SEPARATOR CHARACTER IS INITIALLY COLSEP MOV #1,FIRSTP ; Default 1st page no to 1 CLR LOLINE ; Read all file by default MOV #65535.,HILINE .IF DF PIPWLD MOV #DEFINP,DN+N.FTYP ; Reset default filetype .IFF MOV #DEFINP,DTIFNB+N.FTYP ; Reset default filetype .ENDC ;LEAVE PAGE SIZES ALONE. 46$: GCML$ #CMD,#LISTPR,#LISTPL ;USE RSX FACILITY BCC 47$ RCML$ #CMD BR 475$ ;LEAVE WHEN SEE EOF 47$: TSTB CMD+G.ERR ;SEE IF ERROR ON READ BPL 48$ MOV #EX$ERR,EXSTAT 475$: JMP SCRAM ;EXIT TASK ON I/O ERR IN CMD 48$: .IF DF NOFF1 ;OMIT FF ON OUTPUT MOVB #1,OPENLP ;DEVICE OPEN .ENDC ;AS OPEN WILL DO IT ; ISSUE CSI COMMANDS AND OPEN FILES HERE. ;(LOSE IF FILES DON'T EXIST!) MOV #EHTXT,R0 MOV #41.,R1 441$: CLR FTTXT-EHTXT(R0) ; Zero footing buffer CLR (R0)+ ; Zero 2nd hdr buffer SOB R1,441$ MOV CMD+G.CMLD,R1 ; Check length of line BEQ 46$ ; Just ignore blank line CSI$1 #CSBLK,CMD+G.CMLD+2,R1 ;COMPRESS OUT SPACES, TABS, ETC. ; N.B. Some assumptions about the location and contents of C.TYPR and C.STAT ; are made in code from here to label ILLSWT, mainly so that R0 addressing ; can be used to save code. The following conditionals check these assumptions. .IIF NE C.TYPR, .ERROR ; INCORRECT ASSUMPTION THAT C.TYPR = 0 .IIF NE C.STAT-1, .ERROR ; INCORRECT ASSUMPTION THAT C.STAT = 1 .IIF NE CS.OUT-CS.INP-1, .ERROR ; INCORRECT ASSUMPTION THAT CS.OUT=CS.INP+1 MOVB #CS.INP,(R0) ; Assume inputs are inputs BITB #CS.EQU,C.STAT(R0) ; But if there isn't an '=' in cmd line BNE 442$ INCB (R0) ; we will fetch them as "outputs" ;NOW PROCESS I/O SPECIFICATIONS. .IIF NDF PIPWLD,;NO WILD-CARDS HERE! ;NOW GET INPUT SPECS AND SWITCHES ; 442$: CSI$2 ,,#SWTBL BCS ILLSWT .SBTTL PROCESS (INPUT) SWITCHES .IF DF PIPWLD JSR PC,INIWLD OFID$R ,,,,#BUF,#MAXWID,ERR1; Open input LU3 .IFF OPEN$R #DTIFDB,,,,#BUF,#MAXWID,ERR1;OPEN INPUT LU3 .ENDC MOV #TINAME,CSBLK+C.DEVD+2 ; Output defaults to TI: MOV #3,CSBLK+C.DEVD BITB #CS.EQU,CSBLK+C.STAT ; if not given explicitly BEQ 5$ MOV #CSBLK,R0 ; We have an output. Point to CSI control blk MOV (R0),-(SP) ; Save input status and control bytes (C.TYPR & C.STAT) INCB (R0) ; Switch to output CSI$2 ,,#OUTCSW ;GET OUTPUT FIRST MOV (SP)+,(R0) ; Restore BCC 5$ ; Illegal switch -- close input (if O/P switch) and try again CLOSE$ #DTIFDB ; Close input ILLSWT: QIOW$C IO.CCO,5,5,,,,,CODE MOV #EX$ERR,EXSTAT ; Flag error JMP TRY ; Try again 5$: CMPB SWITC3,#S3.OD!S3.EV ; /OD/EV BNE 6$ CLRB SWITC3 ; Means do both 6$: FDOP$R #DTOFDB,,,,#FO.WRT ; Assume open for write BIT #1,OSMSK ;/AP OUTPUT SWITCH? BEQ 10$ ;NO FDOP$R ,,,,#FO.APD ; Yes, open for append 10$: OPEN$ ,,,,,,#BUFA,#MAXWID,ERR1 ;OUT LU4 .PAGE .SBTTL CHECK LIMITS ;SET UP VALUES FROM WHATEVER WAS ENTERED MOV CMAX,SW.COL CLRB PAUSE ; Assume we pause at start of (next) page BIT #SW.PA,SWITCH ; But do we? BNE 11$ ; Yes DECB PAUSE ; No, never 11$: BIT #SW.RL,SWITCH ; /RL specified? BEQ 12$ ; No BIC #S2.TA,SWITC2 ; Yes, /RL overrides /TA 12$: BITB #FD.TTY,DTOFDB+F.RCTL ;IS OUTPUT A TERMINAL? BEQ 25$ ;IF NOT BRANCH MOV #IO.ATT,ATTDET+Q.IOFN ; Yes, attach to it DIR$ #ATTDET ; so that ctrl/O will work ;FOR TERMINALS SET UP DEFAULT IF NO SWITCHES. QIOW$C SF.GMC,4,4,,,,,CODE ; Get TT: size in case needed BIT #SW.WI,SWITCH ;WAS SWITCH /WI:NNN GIVEN? BNE 26$ ;YES, USE IT. MOVB GSIZE+1,LINSIZ ; No, fetch size from driver as default 26$: BIT #SW.LE,SWITCH ;WAS LENGTH SWITCH GIVEN? BNE 27$ ;YES, USE IT MOVB GSIZE+3,PAGSIZ ; No, fetch size from driver as default 27$: BIT #SW.ED,SWITCH ;REVERSE SENSE OF /ED SWITCH TOO BEQ 28$ ;IF OFF TURN ON BIC #SW.ED,SWITCH ;IF ON TURN OFF AND IGNORE BR 251$ 28$: BIS #SW.ED,SWITCH ;SO WE DON'T GET FF TO TERMINAL UNLES /ED CLRB EDVAL ;ALSO ARRANGE OUTPUT OF NULL FIRST BR 251$ 25$: MOVB #-1,PAUSE ; Not a terminal. Don't pause ever 251$: BIS #SW.LE!SW.WI,SWITCH ; Only set terminal defaults once TST PADW ; No /RL switch? (If /RL used) BNE INTERP ; Value given, keep it MOV LINSIZ,PADW ; No value, default to /LE:n .DSABL LSB ; N.B. Switches whose values are to be tested by LIMITS must set bits in ; SWITCH (bits SW.xx), NOT OSMSK, SWITC2 etc. INTERP: JSR R5,LIMITS ;PROCESS VALUE .WORD LINSIZ,SW.WI,MAXWID,MINWID,LINSIZ JSR R5,LIMITS ;PROCESS VALUE .WORD PAGSIZ,SW.LE,MAXLIN,1.,PAGSIZ JSR R5,LIMITS ;PROCESS VALUE .WORD SW.COL,SW.CO,18.,0,CMAX JSR R5,LIMITS ;PROCESS VALUE .WORD ROLL0,SW.RO,MAXLIN,5.,ROLL0 JSR R5,LIMITS ;PROCESS VALUE .WORD PADW,SW.RL,MAXWID,MINWID,PADW TST RIVAL ; /RI:0, or just /RI? BNE 5$ ; No, keep switch bit BIC #S2.RI,SWITC2 ; Yes, clear switch (0 causes SOB problems) 5$: MOVB #'w,-(SP) ; Assume emphasis (if any) is by cpi change BIT #SW.GR,SWITCH ; But if emphasis is ANSI graphic rendition BNE 10$ ; Branch JSR R5,LIMITS ;PROCESS VALUE .WORD HDCPI,SW.PI,16.,5,HDCPI JSR R5,LIMITS ;PROCESS VALUE .WORD TECPI,SW.PI,16.,5,TECPI JSR R5,LIMITS ;PROCESS VALUE .WORD FTCPI,SW.PI,16.,5,FTCPI BR ESCCHR 10$: MOVB #'m,(SP) ; /GRaphics rendition letter is 'm' JSR R5,LIMITS ;PROCESS VALUE .WORD HDCPI,SW.GR,7,0,HDCPI JSR R5,LIMITS ;PROCESS VALUE .WORD TECPI,SW.GR,7,0,TECPI JSR R5,LIMITS ;PROCESS VALUE .WORD FTCPI,SW.GR,7,0,FTCPI ADD #RENCHR-CPICHR+5,HDCPI ; Point into dummy table ADD #RENCHR-CPICHR+5,TECPI ; of rendition codes ADD #RENCHR-CPICHR+5,FTCPI ESCCHR: MOVB (SP),TXTLTR ; Set escape seq char for pitch or rendition MOVB (SP)+,FTGLTR .SBTTL CORRECT PAGE SIZE FOR HEADER, ETC MOVB PAGSIZ,LMAX ;PAGE SIZE WITH HEADER BIT #SW.NP!SW.NH,SWITCH ; No pagination, or no header? BNE 1$ ; Yes, keep full size DECB LMAX ;1 LINE FOR FF DECB LMAX ; and 1 for blank BIT #S2.EH,SWITC2 ; Extra header? BEQ 1$ ; No DECB LMAX ; Yes, that takes another line 1$: BIT #S2.FT,SWITC2 ; Footing? BEQ 11$ ; No DECB LMAX ; Yes, 1 blank line DECB LMAX ; and footing text 11$: TSTB PAUSE ; Will pause prompt be output? BMI 51$ ; No, never DECB LMAX ; If so, that takes a line too 51$: ; Strip delimiting quotes from /EH and /FA strings, if given. MOV #FA$L,R1 ; Address /FA string JSR PC,DEQUOT ; De-quote it MOV #EHTXT,R1 ; Same for /EH string JSR PC,DEQUOT JSR PC,DENULL ; But also trim off trailing nulls MOV #FTTXT,R1 ; and /FT string JSR PC,DEQUOT JSR PC,DENULL .SBTTL COMPUTE COLUMN WIDTHS MOV #1,R4 ;COL # MOV LINSIZ,R2 ;LINE LENGTH MOV #WIDTH,R3 ;ADR FOR COL 1 2$: MOV %2,%1 ; Load dividend CLR %0 ; unsigned DIV %4,%0 ; Divide MOVB R0,(R3)+ ; Save result INC R4 ;ANOTHER COL PER PAGE SUB #2,R2 ;2 CHAR PER DIVIDER CMP #19.,R4 ;DONE ALL? (TABLE ALLOWS UP TO 20.) BHIS 2$ ; NO, DO NEXT .SBTTL PROCESS FORM FEED MOVB #XFF,FORM+6 ;ASSUME FF BIT #SW.ED,SWITCH ;WANT ^D? BEQ 3$ ; NO MOVB EDVAL,FORM+6 ;YES, FILL IN WITH SEPARATOR CHAR. 3$: .SBTTL DATA FILE PROCESSING .SBTTL CREATE LIST HEADER CLHEAD: .IF DF PIPWLD MOV DTIFDB+F.FNB+N.FTYP,DN+N.FTYP ; Propagate filetype .IFF MOV DTIFDB+F.FNB+N.FTYP,DTIFNB+N.FTYP ; Propagate filetype .ENDC MOV #DASH,R3 ;HEADER BUFFER ADR MOV R3,R0 ;GET COPY MOV LINSIZ,R2 ;LINE LENGTH CLR HEADER+4 ; Will be header length (inc esc seq) MOV HDCPI,R1 ; Get header pitch or rendition no MOVB CPICHR-5(R1),R1 ; Then character for pitch/rendition MOV #SKIP,ENDHDR ; Blank after header if no pitch changes BIT #SW.PI!SW.GR,SWITCH ; Doing pitch or rendition changes? BEQ FILL ; No, keep header as it is ; Prefix header with esc[hw, and scale length of header: ; HDRSIZ=LINSIZ*(HDCPI/TECPI). To compute actual HDCPI and TECPI values, we ; must take the required value, look up the nearest control character, (stored ; back in xxCPI) and then find the exact value (*100) from table CPI. MOVB #ESC,(R0)+ ; Put in escape sequence MOVB #'[,(R0)+ MOVB #'0,(R0)+ ; First 0 turns current rendition off MOVB #';,(R0)+ ; (doesn't affect pitch) MOVB R1,(R0)+ ; Include pitch/rendition char MOVB TXTLTR,(R0)+ ; Put in 'w' (pitch) or 'm' (rendition) BIT #SW.GR,SWITCH ; Graphics? BNE 5$ ; Yes, leave pitch alone ASL R1 ; Double pitch char as index to actual size (*100) MUL CPI-<2*'1>(R1),R2 ; Form LINSIZ*HDCPI 5$: MOV TECPI,R1 ; Get text pitch/rendition MOVB CPICHR-5(R1),R1 ; Load text control digit CMPB R1,-2(R0) ; Same as header? BEQ 10$ ; Yes, no change sequence needed MOV #STATXT,ENDHDR ; No, header will end with text esc seq MOVB R1,TXTCPI ; Set reset sequence 10$: BIT #SW.GR,SWITCH ; Graphics? BNE 15$ ; Yes, leave pitch alone again ASL R1 DIV CPI-<2*'1>(R1),R2 ; Get adjusted dash count ASR R1 ; Reset R1 15$: MOV R0,R3 ; Note new start of header text ADD #SEQLEN,HEADER+4 ; SEQLEN more bytes in header FILL: ADD R2,HEADER+4 ; Set total header length 10$: MOVB #'-,(R0)+ ;DASHES TO HEADER SOB R2,10$ MOV FTCPI,R2 ; Get footing pitch/rendition MOV #SKIP,FTSKIP ; Set footing skip (in case /FT) CMPB CPICHR-5(R2),R1 ; Different code to text? BEQ 20$ ; No, keep SKIP MOV #STAFTG,FTSKIP ; Yes, need escape sequence MOVB CPICHR-5(R2),FTGCPI ; Put char into it 20$: MOV R3,R0 ;BACK AT LEFT MOV #VERSON,R1 ;VERSION # AT LEFT MOV #VERLEN,R2 FILLV: MOVB (R1)+,(R0)+ ;VERSION TO HEADER SOB R2,FILLV MOVB #SPACE,(R0)+ MOV HEADER+4,R2 ;RIGHT SIDE ADD #DASH,R2 ;PT TO END MOV #TALSIZ,R0 ;SIZE OF RIGHT INFO MOV #TAIL,R1 ;RIGHT SIDE INFO 1$: MOVB -(R1),-(R2) ;COPY RIGHT SIDE SOB R0,1$ INC R2 ;LOCATION FOR DATE MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) MOV #TIMBUF,R1 ; Address output area GTIM$S R1 ;GET DATE, TIME, ETC. AND MOV R2,R0 ; Copy output area address JSR PC,$DAT ; Convert BIT #SW.UC,SWITCH ; Unless /UC set BNE 101$ BISB #40,-5(R0) ; Make last 2 letters of month lower-case BISB #40,-4(R0) ; Now that we have the time, put it in after the LISTRS header. 101$: MOV R3,R0 ; Point to place for it ADD #VERLEN,R0 ; = start of line + VERLEN MOV #2,R2 ; Want hour:minute JSR PC,$TIM ; Convert MOVB #SPACE,(R0)+ ; Add a trailing space MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 ;RESTORE REGS USED ADD #20,R2 ;FOR PAGE # (TENS) MOV R2,PAGEAD ;SAVE IT BIT #SW.UC,SWITCH ; If /UC set BEQ 102$ BICB #40,-3(R2) ; Make "Page" into "PAGE" BICB #40,-4(R2) BICB #40,-5(R2) 102$: MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) ;PUT IN FILENAME FROM FILENAME BLK MOV #DTIFDB+F.FNB+N.FNAM,R3 ; Load pointer to filename MOV #BUF,R0 ; Build up name in BUF .REPT 3 ; Name, 3 words MOV (R3)+,R1 ; Fetch word JSR PC,$C5TA ; Convert to ASCII .ENDR 103$: CMPB -(R0),#SPACE ; Trim off trailing spaces BEQ 103$ INC R0 MOVB #'.,(R0)+ ; . before type MOV (R3),R1 ; Get type JSR PC,$C5TA ; Convert that too 104$: CMPB -(R0),#SPACE ; Trim spaces there too BEQ 104$ SUB #BUF-1,R0 ; Get length of name MOV HEADER+4,R1 ; Point to start name is (page width SUB R0,R1 ; -name length) ASR R1 ; /2 ADD (SP),R1 ; + start of line, -1 CMPB -(R1),-(R1) ; -1 since 1st col is BUF[0], -1 for ldg space BIT #SW.PI!SW.GR,SWITCH ; Account for pitch or rendition change BEQ 1041$ ; if /PI set CMPB -(R1),-(R1) ; which gave 4 too many in HEADER+4 1041$: MOVB #SPACE,(R1)+ ; leading space MOV #BUF,R3 ; Address name just formed 105$: MOVB (R3)+,(R1)+ ; Copy it in SOB R0,105$ MOVB #SPACE,(R1)+ ; with a trailing null MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 .SBTTL PROCESS AN INPUT PAGE .SBTTL INITIALIZE ZOTGO: MOV FIRSTP,PAGEN ;LAST PAGE # DEC PAGEN CLR LINENO ; Clear line number MOV #2,R2 ;CONSTANT CLRB EOD ;MORE IN FILE CLR OVRFLO ;NO COLUMN OVERFLOW CLRB VAR ;ASSUME # COLS SPECIFIED DECB CMAX ;MAP 1-19. TO 0-18. MOVB CMAX,R0 ;GET FOR INDEX BGE 1$ ;# SPECIFIED INCB VAR ;VARIABLE # COLS MOVB #18.,CMAX ;MAXIMUM OF 18. COLS CLR R0 ;USE SINGLE COL MAX 1$: MOVB WIDTH(R0),WIDE ;WIDTH BEFORE TRUNCATION .SBTTL NEXT PAGE NEWPAG: MOVB WIDTH,AVAIL ;FOR VARIABLE # COLS CLRB AVAIL+1 MOV #L,PL ;FIRST LINE IN MOV #C,PCO ; FIRST COL MOV BLOCK,R4 ;SET PAGE BUFFER PTR CLRB COL ;TO COUNT COLS .SBTTL NEXT COLUMN NEWCOL: CLRB LINE ;TO COUNT UP # LINES ON PAGE MOV R4,@PL ;SAVE PTR TO COLUMN HEAD CLRB MAX ;LONGEST LINE FOR VAR # COLS .SBTTL NEXT LINE NEWLIN: JSR PC,READL ;GET NEXT LINE CMPB R3,MAX ;THIS LONGEST IN COL? BLOS 4$ ; NO MOVB R3,MAX ;SET NEW MAX TSTB VAR ;VARIABLE # COLS? BEQ 4$ ; NO, SKIP FOLLOWING JUNK .PAGE CMPB R3,AVAIL ;STILL FIT ON PAGE? BLOS 4$ ; YES MOV @PL,PP ;SAVE COL HEAD FOR NEXT PAGE JSR PC,PRINT ;PRINT PAGE ;SET NEW PAGE VARIABLES CLRB COL ;NO COLS ON NEW PAGE MOV #L,PL ;SET PL TO FIRST COL MOV #C,PCO ;RESET COLUMN INDEX MOV BLOCK,R4 ;SET PTR TO PAGE BUFFER MOV R4,L ;SET PTR TO FIRST COL ALSO MOVB WIDTH,AVAIL ;# CHAR POSITIONS LEFT CLRB AVAIL+1 ;COPY EXTRA LINES TO BUFFER TOP MOVB LINE,R5 ;# LINES ON PAGE INC R5 MOV PP,R1 ;PTR TO FIRST LINE IN BUFFER 1$: MOVB (R1)+,R3 ;GET LINE CHARACTER COUNT MOVB R3,(R4)+ ; & COPY IT BEQ 3$ ;SKIP IF EMPTY LINE 2$: MOVB (R1)+,(R4)+ ;COPY LINE DECB R3 BNE 2$ ;0 TO 256, NOT -128 TO 127 3$: DECB R5 ;ONE LESS LINE BGT 1$ ;COPY REST OF LINES 4$: INCB LINE ;ANOTHER LINE ON PAGE CMPB LINE,LMAX ;MORE FIT? ; N.B. make this a SIGNED branch in case /LE value < header/footing space. BLT NEWLIN ; YES CLR R0 BISB MAX,R0 ;LONGEST LENGTH IN COL MOVB R0,@PCO ;SAVE IT INC PCO ;MOVE PTRS TO NEXT COL ADD R2,PL ; FOR NEXT TIME INCB COL ;ONE LESS COLUMN CMPB COL,CMAX ;MORE COLS ON PAGE? BGT 5$ ; NO, PAGE FULL ADD R2,R0 ;# CHARS REQUIRED TO LIST COL SUB R0,AVAIL ;# CHARS LEFT ON PAGE BGT 6$ ;PAGE FULL .PAGE .SBTTL OUTPUT A PAGE 5$: JSR PC,PRINT ;PRINT FULL PAGE TSTB EOD ;MORE? BEQ NEWPAG ; YES BR DONE 6$: TSTB EOD ;MORE? BEQ NEWCOL ; YES JSR PC,PRINT ;PRINT FULL PAGE BR DONE ERR1: TST (SP)+ ;JUNK CALL VIA JSR PC. ERR2: MOVB F.ERR(R0),R1 ; Get error no MOV #ERNUM+2,R0 ; Address place for it MOV #" ,(R0) ; Space-fill MOV (R0),-(R0) MOV #^B1111100001010,R2 ; Load conversion flag JSR PC,$CBTA ; Put error no in error message QIOW$C IO.CCO,5,5,,,,,CODE MOV #EX$ERR,EXSTAT .IF DF PIPWLD CLRB ENFLAG ; No more wildcards .IFTF CLRB CSBLK+C.STAT ; No more files .SBTTL COMPLETION PROCESSING .SBTTL CLOSE INPUT FILE DONE: CLOSE$ #DTIFDB ;CLOSE & RELEASE BCC 100$ JMP SCRAM ; Can't close -- exit 100$: .IFT TSTB ENFLAG ; Processing wildcards? BEQ 1$ ; No JSR PC,ENEXT ; Yes, see if another wild file MOV #DTIFDB,R0 ; Address FDB to check for errors BCC 4$ ; Yes, go get it CMPB F.ERR(R0),#IE.NSF ; No such file = normal wild completion? BNE ERR2 ; Report any other error .IFTF 1$: BITB #CS.MOR,CSBLK+C.STAT ; No, any more files on command line? BEQ 6$ ; No, end output and get another 2$: CSI$2 #CSBLK,,#0 ; Yes, parse for next file, no switches BCC 3$ ; OK, branch JMP ILLSWT ; Switches are illegal here 3$: .IFT JSR PC,INIWLD ; Start wildcard processing 4$: OFID$R ,,,,#BUF,#MAXWID ; OK, open file .IFF OPEN$R #DTIFDB,,,,#BUF,#MAXWID ; OK, open file .ENDC ; PIPWLD BCS ERR2 MOV SW.COL,CMAX ; Reset CMAX JMP CLHEAD ; and repeat .SBTTL CLOSE OUTPUT FILE 6$: BIT #SW.PI!SW.GR,SWITCH ; Yes, was special emphasis used? BEQ 61$ TST DTOFDB+F.BDB ; And is output file (still) open? BEQ 61$ MOVB #'0,TXTCPI ; If so, esc[0;0x will clear emphasis WRITE #DTOFDB,#STATXT 61$: BITB #FD.TTY,DTOFDB+F.RCTL ; Is output a terminal? BEQ 7$ ; If not branch MOV #IO.DET,ATTDET+Q.IOFN ; Detach TI: DIR$ #ATTDET 7$: BIT #2,OSMSK ;DID HE WANT THE FILE SPOOLED (/SP:N)? BEQ 11$ ;NO, JUST CLOSE IT. BIC #-40,SPCNT ;MAKE COPIES RANGE LEGAL (< 32) BNE 10$ ;IF NONZERO ALL IS WELL MOV #1,SPCNT ;IF ZERO MAKE IT 1 10$: PRINT$ #DTOFDB,SCRAM,,,,,,SPCNT ;QUEUE SPCNT COPIES OUT BR 20$ ;THEN GO (SPOOL CALL CLOSES FILE) 11$: CLOSE$ #DTOFDB ;CLOSE & RELEASE 20$: BCS SCRAM ;IF CLOSE FAILS, LEAVE 40$: JMP TRY SCRAM: MOV EXSTAT,%0 ; Load exit status JMP $EXST ; Leave .SBTTL SUBROUTINES .SBTTL LIMITS: CHECK ON SWITCH VALUES ; JSR R5,LIMITS ; .WORD ADR OF VALUE ENTERED (IN SWITCH TABLE) ; .WORD SWITCH BIT ; .WORD MAXIMUM VALUE ; .WORD MINIMUM VALUE ; .WORD ADR OF BYTE VARIABLE LIMITS: MOV @(R5)+,R0 ;LAST SPECIFIED VALUE BIT (R5)+,SWITCH ;SWITCH SPECIFIED? BNE 1$ ; YES TST (R5)+ ;SKIP MAX VALUE BR 3$ ; & USE LAST VALUE 1$: CMP (R5)+,R0 ;CHECK MAX BHIS 2$ ; OK MOV -2(R5),R0 ;CLAMP HI 2$: CMP (R5),R0 ;CHECK MIN BLOS 3$ ; OK MOV (R5),R0 ;CLAMP LO 3$: TST (R5)+ ;PT TO VARIABLE PTR MOVB R0,@(R5)+ ;SET VALUE INTO VARIABLE RTS R5 ;LEAVE .SBTTL COPYRL: PAD LINES TO SAME LENGTH COPYRL: MOV R0,-(SP) ;SAVE REGS MOV R1,-(SP) MOV R2,-(SP) MOV #BUFOUT,R0 ;PAD INTO BUFOUT MOV 6+2+2(SP),R1 ;GET BUFFER HEADER ADR CMP R0,R1 ;USING BUFOUT? BEQ 2$ ; YES, DON'T HAVE TO COPY MOV R0,6+2+2(SP) ; No, replace with BUFOUT CMP (R0)+,(R0)+ ;PT TO ACTUAL BYTE COUNT CMP (R1)+,(R1)+ ; ( ADD #4,R0 ; ADD #4,R1 ) MOV (R1)+,R2 ;DATA LENGTH CMP #MAXWID,R2 ;TOO LONG? BHIS 10$ ; NO MOV #MAXWID,R2 ; YES, CLAMP AT BUFFER SIZE 10$: MOV R2,(R0)+ ; Copy size BEQ 2$ ; No data, no copy 1$: MOVB (R1)+,(R0)+ ;COPY BUFFER SOB R2,1$ 2$: MOV #BUFOUT+4,R0 ;PT TO BYTE COUNT CLR R2 BISB PADW,R2 ;GET TOTAL WIDTH MOV (R0),R1 ;CURRENT LENGTH MOV R2,(R0)+ ;SET CONSTANT LENGTH ADD R1,R0 ; Point to end SUB R1,R2 ;AMOUNT TO PAD BLE 4$ ; No pad if <=0 3$: MOVB #SPACE,(R0)+ ;PAD SOB R2,3$ 4$: .IIF DF,VRSATK,MOVB #COLSEP,-1(R0) ;VERSATEK MUST HAVE NON-BLANK AT END MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC .SBTTL READL: READ A LINE READL: MOV R4,CHRCNT ;CHARACTER COUNT BYTE PTR CLR R3 ;CHAR COUNT MOV OVRFLO,R1 ;PNT TO NEXT CHAR IN LINE BEQ 1$ ; NO OVERFLOW .SBTTL FINISH LAST LINE OVERFLOW, IF ANY MOVB FA$L+2,-(R1) MOVB FA$L+1,-(R1) MOVB FA$L,-(R1) CLR OVRFLO ;CLEAR OVERFLOW FLAG ; If /WS set and /MS and /NS clear, add spaces for /RI and/or /LN. BIT #S2.WS,SWITC2 ; Wrap with spaces? BEQ 2$ ; No, at margin BIT #S2.NS!S2.MS,SWITC2 ; Spaces suppressed? BNE 2$ ; Yes, keep it that way MOV RIVAL,R3 ; Include right shift BIT #S2.LN,SWITC2 ; If /LN set, include BEQ 10$ ADD #MAXLNO+1,R3 ; (max) length of line number 10$: MOVB #SPACE,-(R1) ; Put in spaces SOB R3,10$ ; as far as required BR 2$ ;HAVE LINE WITH R1 SET .SBTTL READ NEXT INPUT LINE 1$: MOV #BUFIN,-(SP) ;PUSH BUF HDR MOV #DTIFDB,-(SP) ;PUSH FDB JSR PC,RSXRED ;READ (GET) DATA CMP (SP)+,(SP)+ ;RESTORE STACK BITB #100,BUFIN+3 ;EOD? BEQ 11$ JMP EOT ; YES 11$: MOV #BUF,R1 ;SET R1 TO PT TO NEW LINE 2$: .PAGE CLRB (R4)+ ;ZERO CHARACTER COUNT BYTE MOV #10,R5 ;SET FIRST TAB STOP .SBTTL PROCESS NEXT CHARACTER .ENABLE LC NEXTC: BICB EIGHTB,(R1) ;LEAVE 7 BITS ONLY (IN CASE OF SCREWY WORD PROCESSORS) CLR R0 ; unless explicitly using 8-bit chars (/EI) BISB (R1),R0 ;GET NEXT CHAR (ZERO-EXTENDED) BEQ IGNORE ;IGNORE NULLS BIT #SW.UC,SWITCH ;CASE TRANSLATION NEEDED? BEQ CKSPC2 ;NO. BITB #100,(R1) ;IF 100 BIT ON, THEN 40 BIT OFF IF SPEC. BEQ CKSPC BICB #40,(R1) ;CONVERT LOWER TO UPPER CASE BR CKSPC ;GO SKIP LOWER CASE NOW CKSPC2: BIT #S2.LC,SWITC2 ;/LC CONVERSION TO LOWER CASE FORCING DESIRED? BEQ CKSPC ;IF EQ NO, SKIP IT CMPB (R1),#'@ ;LEAVE @ ALONE BEQ CKSPC CMPB (R1),#'Z ;LEAVE EVERYTHING ABOVE Z ALONE TOO BHI CKSPC BITB #100,(R1) ;IF YES FORCE ON BIT 40 IF BIT 100 IS ON BEQ CKSPC ;IF NOT BIT 100 ON, NOT IN RANGE BISB #40,(R1) ;LOWER CASE NOW CKSPC: TSTB R0 ; See if 8-bits (only if /EI) BPL 10$ ; No CMPB R0,#240 ; Non-printing 8-bit char? BLOS MOVE ; No, just copy MOVB #'~,(R4)+ ; Yes, show these as ~ BISB #100,(R1) ; + UC letter BICB #200,(R1) ; from 7-bit set BR SPEC 10$: CMP #40,R0 ;SEE IF SPECIAL BLOS MOVE ; NO, COPY CHARACTER SUB #XCR,R0 BEQ EOL ;CR BGT CONTROL ;OUTPUT ^X ADD R2,R0 BGT FF ;FF BEQ EOL ;VT ADD R2,R0 BGT EOL ;LF BLT CONTROL ;001-010 BIT #SW.CT,SWITCH ;WANT TO KEEP TABS? BEQ TAB ; YES MOVB #SPACE,(R1) ;REPLACE TAB WITH SPACE BR MOVE .SBTTL CONTROL CHARACTER CONTROL: BIT #S2.NE,SWITC2 ;ARE WE PRINTING ESC AS ^[ OR $? BNE 1$ ;PRINTING AS ^[ SO DO IT CMPB #ESC,(R1) ;THIS AN ESCAPE CHARACTER? BNE 1$ ;NO, ECHO AS ^ MOVB #'$,(R1) ;PRINTING AS DOLLAR SIGN SO HANDLE THAT WAY BR MOVE ;THEN SHOVE IT OUT. (DEFAULT = $ ) 1$: BISB #100,(R1) ;FORCE PRINTABLE MOVB #'^,(R4)+ ;INSERT ^ CHARACTER BR SPEC .SBTTL IGNORE CHARACTER IGNORE: INC R1 BR NEXTC .SBTTL FORM FEED FF: BIT #S2.FF!S2.FP,SWITC2 ; Want to process FFs? BEQ IGNORE ; No, ignore them totally (not even EOL) MOV CHRCNT,R4 ; Yes, nothing else (preceding) on line counts BIT #S2.FP,SWITC2 ; New page? BEQ 10$ ; No, just new column TSTB LINE ; Yes, but if we just did one BNE 5$ TSTB COL ; LINE=0 and COL=0 BEQ EOL ; Don't do another 5$: CLRB AVAIL ; Else say no more space 10$: TSTB LINE ;AT TOP OF COLUMN? BEQ EOL ; YES, DON'T BLANK WHOLE COLUMN BR E1 ; NO, FILL COLUMN WITH BLANK LINES .PAGE .SBTTL TAB TAB0: ADD #10,R5 ;MOVE TO NEXT TAB STOP TAB: CMP R3,R5 ;AT TAB STOP? BGE TAB0 ;MOVE TO NEXT INC R1 ;SKIP TAB IN INPUT LINE TAB1: MOVB #SPACE,(R4)+ ;FILL WITH SPACES INC R3 ;COUNT CHARACTER CMPB R3,WIDE ;MORE FIT IN LINE? BHIS TOWIDE ; NO, FULL CMPB R3,R5 ;AT TAB STOP? BLO TAB1 ; NO, GET ANOTHER SPACE BR NEXTC .SBTTL UNINTERESTING MOVE: MOVB (R1)+,(R4)+ ;COPY CHARACTER SPEC: INC R3 ;COUNT CHARACTER CMPB R3,WIDE ;MORE FIT IN LINE? BLO NEXTC ; YES, GET NEXT .SBTTL CHECK FOR COLUMN OVERFLOW TOWIDE: BIT #SW.TR,SWITCH ;WANT TO TRUNCATE LINES? BNE EOL ; YES, END LINE NOW CMPB #XCR,(R1) ;IF AT CR BEQ EOL ; NO OVERFLOW MOV R1,OVRFLO ;SAVE NEXT CHARACTER PTR/SET FLAG .SBTTL LINE FEED - END OF LINE EOL: MOVB R3,@CHRCNT ;INSERT LINE BYTE COUNT RTS PC .SBTTL END OF INPUT FILE EOT: INCB EOD ;REMEMBER SAW EOD TSTB LINE ; Top of column? BNE E1 ; No, clear rest MOVB LMAX,LINE ; Yes, step back to end of previous one DECB COL BPL E2 ; Normal exit to do last page if there was one TST (SP)+ ; There wasn't, lose return address JMP DONE ; Do an abnormal exit -- no last page E1: CLRB (R4)+ ;FILL REST COLUMN WITH INCB LINE CMPB LINE,LMAX ;NEED MORE? BLO E1 ; YES E2: RTS PC .PAGE .SBTTL WRITE A PAGE .SBTTL FIND COLUMN PADDING WIDTHS PRINT: INC PAGEN ;GET PAGE # TSTB SWITC3 ; Selecting only odd or even numbered pages? BEQ 10$ ; No, print all MOV PAGEN,-(SP) ; Yes, push page no ADD SWITC3,(SP) ; Add switch (only bit 0 matters) ROR (SP)+ ; Rotate out resultant bit 0 BCS E1 ; Set means don't print this page 10$: MOVB COL,R3 ;ACTUAL # COLUMNS BNE 11$ INC R3 11$: TSTB VAR ;VARIABLE # COLS? BEQ 2$ ; NO CLR R0 MOV AVAIL,%1 ;FIND # EXTRA CHARACTERS PER COLUMN ; The following line "fixes" a bug, usually on the last page, when AVAIL gets ; set to a small -ve number which the (unsigned) divide makes into a large ; number of extra columns, giving corrupted output and/or task failure. BLE 1$ ; None if <=0 DIV %3,%0 1$: MOVB C-1(R3),R1 ;GET COL WIDTH ADD R0,R1 ;ADD # EXTRA CHARS MOVB R1,C-1(R3) ;UPDATE # SOB R3,1$ BR 3$ 2$: MOVB WIDE,C-1(R3) ; SOB R3,2$ 3$: .SBTTL SETUP & OUTPUT APPROPRIATE HEADER JSR PC,RSAV ;SAVE REGS MOV PAGEN,R1 ; Get # to convert MOV PAGEAD,R0 ; Ptr to hundreds digit MOV #^B1111000001010,R2 ; Load conversion flag JSR PC,$CBTA ; Convert it JSR PC,RRES ;POP REGS AGAIN TSTB PAUSE ; Pause before next page? BMI LETGO ; -ve = no, never BEQ NEXTIM ; 0 = not now, but next time ;PUT A WAIT ON READING CONSOLE HERE. QIOW$C IO.RPR!TF.CCO,5,5,,IOSTAT,,,CODE CMPB IOSTAT,#IE.EOF BNE LETGO JMP DONE ;EXIT IF ^Z ON PAUSE NEXTIM: INCB PAUSE ; Pause next time LETGO: .PAGE BIT #SW.RO,SWITCH ;ROLL PAPER? BEQ 9$ ; NO MOV #BUFOUT+4,R5 ;PT TO ACTUAL BYTE COUNT MOVB LINSIZ,(R5) ;SET IT TO FULL WIDTH MOV (R5)+,-(SP) ;SAVE COUNT 10$: MOVB #'=,(R5)+ ;CREATE PAGE DIVIDER DEC (SP) ; MORE? BGT 10$ ; YES TST (SP)+ ;DROP COUNTER MOVB ROLL0,ROLL ;SET PAGE LENGTH WRITE #DTOFDB,#BUFOUT ;WRITE DIVIDER ; HERE SHOVE OUT SECOND HEADER ALSO... BIT #S2.EH,SWITC2 ;SEE IF EXTRA HDR DESIRED BEQ 501$ ; IF EQ NO, SKIP WRITE #DTOFDB,#EHHDR ;IF SO WRITE IT OUT 501$: WRITE #DTOFDB,ENDHDR ; & skip a line (changing to text size if reqd) BR 11$ ;SKIP PAGED JUNK 9$: .IF DF NOFF1 TSTB OPENLP ;FIRST TIME? BNE 4$ ; YES, OMIT FF .IFTF BIT #SW.NP,SWITCH ;NO PAGE SEPARATORS? BNE 46$ WRITE #DTOFDB,#FORM 46$: .IFT 4$: CLRB OPENLP ;NO LONGER FIRST TIME .ENDC 11$: BIT #,SWITCH ;OMIT HEADER? BNE 5$ ; YES WRITE #DTOFDB,#HEADER ;WRITE HEADER ; HERE SHOVE OUT SECOND HEADER ALSO... BIT #S2.EH,SWITC2 ;SEE IF EXTRA HDR DESIRED BEQ 601$ ; IF EQ NO, SKIP WRITE #DTOFDB,#EHHDR ;IF SO WRITE IT OUT 601$: WRITE #DTOFDB,ENDHDR ; & skip a line (changing to text size if reqd) 5$: .SBTTL FORM & OUTPUT LINES MOVB LMAX,R5 ;COUNT DOWN # LINES MOVB COL,-(SP) ;SAVE # COLS ON PAGE NEWL: MOV #L,PL ;START AT FIRST COL MOV #C,PCO MOVB (SP),COL ;# COLS ON PAGE MOV #BUFA,R1 ;PT TO OUTPUT LINE BUFFER .PAGE NEWC: MOV @PL,R4 ;PT TO LINE IN COL CLR R0 BISB (R4)+,R0 ;# CHAR IN LINE MOV R0,R3 ;SAVE IT FOR PADDING BEQ 2$ ;LINE EMPTY 1$: MOVB (R4)+,(R1)+ ;COPY CHARACTER SOB R0,1$ 2$: MOV R4,@PL ;SAVE PTR TO NEXT LINE IN COL DECB COL ;ONE LESS COL TO DO BEQ CRLF ;DONE BISB @PCO,R0 ;GET COL WIDTH FOR PAD SUB R3,R0 ;# SPACES REQ'D 3$: MOVB #SPACE,(R1)+ DEC R0 BGE 3$ ;EXTRA SPACE FOR DIVIDER BIT #S2.SC,SWITC2 ;SEPARATOR CHARACTER SPECIFIED? BEQ 102$ ;NO, SEE IF BLANK WANTED BIT #S2.BS,SWITC2 ;SPECIFIED SEPARATOR AND BLANK? BEQ 100$ ;NO ; BOTH /SC AND /BL SWITCHES SET. REMOVE EXTRA BLANK AND USE CHAR. DEC R1 ;FORGET EXTRA BLANK IF USING BLANK AS SEPARATOR BR 100$ 102$: BIT #S2.BS,SWITC2 ;WANT BLANK AS SEPARATOR? BEQ 100$ ;NO MOVB #SPACE,(R1)+ BR 101$ ;YES. FILL IT IN 100$: MOVB SEPCHR,(R1)+ ;NO, FILL IN SEPARATOR (INITIALLY COLSEP) ; MOVB #COLSEP,(R1)+ 101$: ADD R2,PL ;MOVE TO NEXT COL INC PCO BR NEWC CRLF: BIT #S2.TA,SWITC2 ; Compress multiple spaces to tabs? BEQ 10$ ; No, keep all spaces MOV R0,-(SP) ; Yes, save registers MOV R2,-(SP) MOV #BUFOUT+6,R0 ; Point to output buffer MOV R1,R2 ; Compute length SUB R0,R2 MOV R0,R1 ; Output (shorter) overwrites input JSR PC,$ENTAB ; Compress MOV (SP)+,R2 ; Restore registers MOV (SP)+,R0 10$: SUB #BUFOUT+6,R1 ;GET LINE LENGTH MOV R1,BUFOUT+4 ;SET ACTUAL BYTE COUNT WRITE #DTOFDB,#BUFOUT DECB R5 ;MORE LINES? BGT NEWL ; YES BIT #S2.FT,SWITC2 ; See if footing desired BEQ 20$ ; If eq no, skip WRITE #DTOFDB,FTSKIP ; If so, skip a line (changing size if reqd) WRITE #DTOFDB,#FTHDR ; Write footing text 20$: MOVB (SP)+,COL ;CLEAN STACK BIT #SW.RO,SWITCH ;ROLL PAPER? BEQ 2$ ; NO 1$: TSTB ROLL ;NEED ANOTHER LINE? BLE 2$ ; NO WRITE #DTOFDB,#SKIP BR 1$ 2$: RTS PC .PSECT RWDATA,RW,D .SBTTL WRITE COMMAND MESSAGE .SBTTL FILE CONTROL BLOCKS SEPCHR: .BYTE COLSEP,COLSEP ;SEPARATOR CHARACTER FOR COLUMNS BUFIN: .WORD MAXWID .WORD 20 .WORD 0 BUF: .BLKB MAXWID+2+MAXRTS+MAXLNO ; INPUT BUFFER, inc right shift & line no .SBTTL LINE BUFFERS .EVEN BUFOUT: .WORD MAXWID+2 .WORD 20 .WORD 0 BUFA: .BLKB MAXWID+2+2 ;(SAFETY) .EVEN .PAGE .SBTTL VARIABLES EXSTAT: .WORD EX$SUC ; Exit status, default success GSIZE: .BYTE TC.WID,80. ; Get terminal width .BYTE TC.LPP,24. ; and length COL: .BYTE 0 ;COLUMN COUNTER .EVEN CMAX: .WORD 0 ;MAX # COLS .EVEN ;LINE MUST BE EVEN LINE: .BYTE 0 ;COUNT DOWN LINES LMAX: .BYTE 0 ;# TEXT LINES/PAGE .EVEN PAGSIZ: .WORD 64. ;CURRENT # LINES PER PAGE(INCL. HEADER) LINSIZ: .WORD 132. ;# PRINT POSITIONS MAX: .BYTE 0 ;MAX # CHAR IN COL SO FAR VAR: .BYTE 0 ;NZ => VARIABLE # COLS .EVEN ;WIDE MUST BE EVEN, ; NOTE HIGH BYTE USUALLY 0 WIDE: .BYTE 0 ;MAX # CHARACTERS PER COLUMN EOD: .BYTE 0 ;NZ => SAW EOD EDVAL: .WORD 0 ;CHARACTER TO FILL IN ON /ED ROLL0: .WORD 56. ;LINE PER ROLL PAGE ROLL: .BYTE 0 ;LINES LEFT TO GO PAUSE: .BYTE -1 ; Pause flag: -ve=never, 0=next time, +ve=now .EVEN PADW: .WORD 132. ;RECORD LENGTH FOR /RL SKPLTR: .WORD 0 ;# INPUT LETTERS TO SKIP IF /SL:NNN ASKED .IF DF,NOFF1 OPENLP: .BYTE 0 ;0 => DOING FIRST FILE .ENDC .EVEN AVAIL: .WORD 0 ;# FREE CHARACTER POSITIONS REMAINING ON PAGE CHRCNT: .WORD 0 ;PTR TO LINE BYTE COUNT BYTE OVRFLO: .WORD 0 ;NZ IS ADR OF NEXT CHAR IN OVERFLOW LINE PAGEAD: .WORD 0 ;PTR TO PAGE HUNDREDS IN HEADER PAGEN: .WORD 0 ;LAST PAGE # FIRSTP: .WORD 1 ;FIRST PAGE NO LINENO: .WORD 0 ; Current source line no LOLINE: .WORD 0 ; First line to list HILINE: .WORD 65535. ; Last line to list EIGHTB: .WORD ^C177 ; Mask to remove parity bit (& sign extend) HDCPI: .WORD 0 ; Pitch or rendition for header TECPI: .WORD 0 ; Ditto, for text FTCPI: .WORD 0 ; Ditto, for footing IOSTAT: .BLKW 2 ; IO.RPR status block PP: .WORD 0 ;SAVE FOR @PL(I+1) PL: .WORD 0 ;PTR TO CURRENT L PCO: .WORD 0 ;PTR TO CURRENT C L: .REPT 24. .WORD BUF ;ADR OF FIRST LINE OF ITH COLUMN IN BLOCK .ENDR C: .REPT 20. .BYTE 16. ;WIDTH OF ITH COLUMN .ENDR .BYTE 10.,10.,10.,10. ;TABLE OF FIXED COLUMN WIDTHS WIDTH: .REPT 20. ; ENTRY I IS: MAXWID+2-<2*I>/2 .BYTE 20. .ENDR .BYTE 10.,10.,10.,10. ;SPARES, BUT ALL INITIALIZED. .PAGE .SBTTL SWITCHES .EVEN .GLOBL SWITC3,SWITC2,SWITCH SWITC3: .WORD 0 ; ODd/EVen flags (MUST be ONLY bits in lo byte) S3.OD=1 ; /ODd pages only printed (MUST be bit 0) S3.EV=2 ; /EVen pages only printed ; Hi byte of SWITC3 is available for later use SWITC2: .WORD 0 ;MORE SWITCH FLAGS S2.SC=1 ;SEPARATOR CHARACTER S2.BS=2 ;BLANK SEPARATE S2.NE=4 ;NE TREAT ESCAPE PRINT AS ^[ (DEFAULT IS $) S2.RI=10 ;/RI:NNN SHIFT OUTPUT RIGHT NNN SPACES S2.LC=20 ;/LC FORCE LOWER CASE OUTPUT S2.NS=40 ;/NS FORCE NO SPACES RECOGNIZED ON INPUT S2.EH=100 ;/EH:TEXTSTRING OUTPUTS 2ND HDR S2.LN=200 ;/LN number lines S2.LI=400 ;/LI:l:h select lines S2.TA=1000 ;/TA use tabs in output S2.FF=2000 ;/FF RETAIN FF OPTION S2.FP=4000 ;/FP Break page at FF S2.FT=10000 ;/FT:textstring outputs page footing S2.WS=20000 ;/WS include /RI&/LN indent on wrapped line S2.MS=40000 ;REMOVE MULTIPLE SPACES (MAKE SINGLE SPACES) IF /MS ;SWITCH SET SWITCH: .WORD 0 ;SWITCH FLAGS SW.PI=100000 ;/PI:h:t:f define pitches SW.SL=20000 ;SKIP LETTERS /SL:NNN TO SKIP NNN CHARS ON INPUT ;IN EACH RECORD SW.NP=10000 ;NO PAGES (NO FORMFEED OR HEADER) SW.UC=4000 ;CONVERT LOWER TO UPPER CASE SW.RL=2000 ;FIXED LENGTH LINES SW.RO=1000 ;ROLL PAPER SW.CT=400 ;CHANGE TAB TO SPACE SW.ED=200 ;USE ^D INSTEAD OF FF SW.PA=100 ;PAUSE OPTION SW.WI= 40 ;WIDTH OPTION SW.LE= 20 ;LENGTH OPTION SW.CO= 10 ;# COLUMNS SW.COL: .WORD 0 SW.GR =4 ; /GR:h:t:p define graphics renditions SW.NH =2 ;NO HEADER OPTION SW.TR =1 ;TRUNCATE OPTION S8.EI =^C177 ; Eight-bit option .EVEN .PAGE .SBTTL SWITCH TABLES .PSECT RODATA,RO,D SWTBL: CSI$SW UC,SW.UC,SWITCH ;UPPER CASE /UC SWITCH CSI$SW RL,SW.RL,SWITCH,,,RLTBL ; /RL:NNNNN CSI$SW RO,SW.RO,SWITCH,,,ROTBL; /RO:NNNNN CSI$SW CT,SW.CT,SWITCH ;COMPRESS TABS /CT CSI$SW ED,SW.ED,SWITCH,,,EDTBL ; /ED:NNN (NNN=CHAR OCT) CSI$SW PA,SW.PA,SWITCH,SET,NEG ;/PAUSE (NYA) CSI$SW WI,SW.WI,SWITCH,,,WITBL ;/WI:NNN CSI$SW LE,SW.LE,SWITCH,,,LETBL ;/LE:NNN CSI$SW CO,SW.CO,SWITCH,,,COTBL ;/CO:N CSI$SW FF,S2.FF,SWITC2,SET,NEG ;/FF starts a new column CSI$SW FP,S2.FP,SWITC2,SET,NEG ;/FP FF starts a new page CSI$SW EH,S2.EH,SWITC2,,,EHTBL ;/EH:TEXT-STRING FOR 2ND HDR LINE CSI$SW NH,SW.NH,SWITCH,SET,NEG ;/NH NO HDR CSI$SW TR,SW.TR,SWITCH,SET,NEG ;/TRUNCATE COL CSI$SW NP,SW.NP,SWITCH,SET,NEG ;/NP NO PAGE SEPARATORS CSI$SW SL,SW.SL,SWITCH,,,SLTBL ;/SL:NNN SKIP LETTERS CSI$SW MS,S2.MS,SWITC2,SET,NEG ;/MS MAKE MULTIPLE SPACES SINGLE SP'S CSI$SW SC,S2.SC,SWITC2,,,SCTBL ;/CS:CHAR FILL IN COLUMN SEPARATOR CHR CSI$SW BS,S2.BS,SWITC2,SET,NEG ;/BS BLANK SEPARATOR FOR COLUMNS CSI$SW NS,S2.NS,SWITC2,SET,NEG ;/NS DELETES ALL SPACES CSI$SW NE,S2.NE,SWITC2,SET,NEG ;/NE NO ESCAPE SPECIAL ECHO (TREAT AS ;NORMAL CONTROL CHARACTER.) CSI$SW RI,S2.RI,SWITC2,,,RITBL ;/RI:NNN SHIFTS OUTPUT RIGHT NNN SPACES CSI$SW LC,S2.LC,SWITC2,SET,NEG ;/LC FORCES ALL LOWER CASE CSI$SW FA,0,SWITC2,,,FATBL ;/FA SPECIFIES CONTINUATION MARK CSI$SW PN,0,SWITCH,,,PNTBL ;/PN:n sets 1st page no CSI$SW LN,S2.LN,SWITC2,SET,NEG ;/LN numbers lines CSI$SW LI,S2.LI,SWITC2,SET,NEG,LITBL ; /LI:l:h CSI$SW EI,S8.EI,EIGHTB,CLEAR,NEG ; /EIght bit characters CSI$SW TA,S2.TA,SWITC2,SET,NEG ; /TAbs may be used to compress O/P CSI$SW PI,SW.PI,SWITCH,SET,,PITBL; /PItch:header:text:footing CSI$SW GR,SW.GR,SWITCH,SET,,PITBL; /GRaphics:header:text:footing CSI$SW OD,S3.OD,SWITC3,SET,NEG ; /ODd pages only CSI$SW EV,S3.EV,SWITC3,SET,NEG ; /EVen pages only CSI$SW FT,S2.FT,SWITC2,,,FTTBL ; /FT:text-string for page footing CSI$SW WS,S2.WS,SWITC2,SET,NEG ; /WS include /RI&/LN spaces when wrapping CSI$ND ;END TABLE CSI$SV DECIMAL,PADW,2,RLTBL CSI$ND CSI$SV DECIMAL,ROLL0,2,ROTBL CSI$ND CSI$SV OCTAL,EDVAL,2,EDTBL CSI$ND CSI$SV DECIMAL,LINSIZ,2,WITBL CSI$ND CSI$SV DECIMAL,PAGSIZ,2,LETBL CSI$ND CSI$SV DECIMAL,CMAX,2,COTBL CSI$ND CSI$SV DECIMAL,SKPLTR,2,SLTBL CSI$ND CSI$SV ASCII,SEPCHR,1,SCTBL CSI$ND CSI$SV DECIMAL,RIVAL,2,RITBL CSI$ND CSI$SV ASCII,FA$L,5,FATBL CSI$ND CSI$SV ASCII,EHTXT,80.,EHTBL CSI$ND CSI$SV DECIMAL,FIRSTP,2,PNTBL CSI$ND CSI$SV DECIMAL,LOLINE,2,LITBL CSI$SV DECIMAL,HILINE,2 CSI$ND CSI$SV DECIMAL,HDCPI,2,PITBL CSI$SV DECIMAL,TECPI,2 CSI$SV DECIMAL,FTCPI,2 CSI$ND CSI$SV ASCII,FTTXT,80.,FTTBL CSI$ND OUTCSW: OUTSWS: CSI$SW AP,1,OSMSK ;/AP OPEN OUTPUT FOR APPEND CSI$SW SP,2,OSMSK,,NEG,SPCPY ;/SP:N SPOOL N COPIES CSI$ND CSI$SV DECIMAL,SPCNT,2,SPCPY CSI$ND .PSECT RWDATA,RW,D RIVAL: .WORD 0 ;/RI:NNN SWITCH VALUE FA$L: .ASCIZ /-->/<0><0> ;LINE CONTINUE INDICATOR .EVEN EHHDR: .WORD 80.,0,80. ; FAKE DOS WRITE BUFFER HDR EHTXT: .BLKB 82. FTHDR: .WORD 80.,0,80. ; FAKE DOS WRITE BUFFER HDR FTTXT: .BLKB 82. .EVEN .PAGE .SBTTL TEXT STRINGS .NLIST BEX OSMSK: .WORD 0 ;OUTPUT FILE SWITC MASKS. SEE OUTSWS TBL ;FOR BIT DEFS SPCNT: .WORD 0 ;NO. COPIES TO SPOOL IF SPOOLING OUTPUT VERSON: .ASCII /LIST-11 V4.0 / VERLEN=.-VERSON .EVEN HEADER: .WORD MAXWID+6,0,0 DASH: .BLKB MAXWID+6 ; / dd-mmm-yy Page dddd/ PAGE: .ASCII / Page / TAIL: TALSIZ=TAIL-PAGE MINWID=10.*6 .IF LT MINWID-VERLEN MINWID=VERLEN .ENDC .IF LT MINWID-TALSIZ MINWID=TALSIZ .ENDC .EVEN FORM: .WORD 1,0,1 ;FORM FEED .BYTE XFF ;OR ^D IF /ED ;NOTE /ED IS FOR THE VT01 DRIVER THAT USES IT TO ERASE A SCREEN. .EVEN ENDHDR: .WORD SKIP ; Changed to STATXT if /PI STATXT: .WORD SEQLEN,0,SEQLEN ; Escape sequence TXTSEQ: .ASCII "[0;" TXTCPI: .BYTE '0 ; to change to text TXTLTR: .BYTE 'w ; pitch (w), or rendition (m) SEQLEN=.-TXTSEQ ; Each sequence is this length SKIP: .WORD 0,0,0 ;CR LF only FTSKIP: .WORD SKIP ; Changed to STAFTG if /PI STAFTG: .WORD SEQLEN,0,SEQLEN ; Escape sequence FTGSEQ: .ASCII "[0;" ; to change to footing FTGCPI: .BYTE '0 FTGLTR: .BYTE 'w .EVEN ; So that ERNUM is even ERTXT: .ASCII "%LIST-F-IOERR, File I/O error " .IIF NE <.-CSBLK>&1, .ERROR .-CSBLK ; ERNUM must be at an even address ERNUM: .ASCII " " ERSIZ=.-ERTXT .EVEN TIMBUF: ; Temporary buffer for get date/time TIMYR: .WORD 0;YEAR TIMMON: .WORD 0 TIMDA: .WORD 0 ;DAY OF MONTH .BLKW 5 ;OTHER JUNK .SBTTL PAGE BUFFERS SPSAV: .LIMIT ; LIMIT block, 1st word is initial SP BLOCK=.-2 ; 2nd word is top of task = start of buffer ;BLOCK: .BLKB <*MAXLIN> ; Allocated by EXTTSK ; PCO -> C, PL -> L ; C CONTAINS WIDTH OF CURRENT COLUMN ; L CONTAINS ADDRESS IN BLOCK OF START OF CURRENT LINE ; BLOCK CONTAINS PACKED LINES: ; FIRST BYTE IS # CHARACTERS TO FOLLOW ; FOLLOWED BY CHARACTERS FROM LINE .PSECT RODATA,RO,D LISTPR: .ASCII /LIST>/ LISTPL=.-LISTPR PAUSES: .ASCII /LIST pause>/ PAULEN=.-PAUSES ;LET MACRO FIGURE OUT HOW LONG STRING IS! .EVEN ; Pitch and rendition control tables. ; '1 '2 '3 '4 '5 '6 '7 '8 ; Chars controlling: CPI: .WORD 1000.,1200.,1320.,1650.,500.,600.,660.,825. ; cpi*100 CPICHR: .BYTE '5,'6,'7,'8,'8,'1,'1,'2,'3,'3,'4,'4 ; Nearest chars for 5-16 cpi RENCHR: .BYTE '0,'1,'0,'0,'4,'5,'0,'7 ; Rendition codes (0=unused) ; Error messages: SWTXT: .ASCII "%LIST-F-ILLSWT, Illegal switch" SWSIZ=.-SWTXT .EVEN .PAGE .SBTTL SUBROUTINES .PSECT CODE,RO,I RSAV: MOV R0,-(SP) ;SAVE REGISTERS MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) JMP @12.(SP) RRES: MOV (SP)+,12.(SP) ;STORE RETURN ADDRESS MOV (SP)+,R5 ;RESTORE REGISTERS MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ; Remove matching quotes on a switch text argument (/FA, /EH, or /FT). DEQUOT: MOV R1,-(SP) ; Save start pointer CMPB (R1)+,#'" ; Starting quote? BNE 30$ ; No, nothing to do 10$: TSTB (R1)+ ; Find trailing null BNE 10$ DEC R1 ; Point back to it CMPB -(R1),#'" ; Did we have a matching end quote? BNE 30$ ; No, keep the leading one CLRB (R1) ; Yes, strip off trailing one MOV (SP),R1 ; Reload text pointer 20$: INC R1 ; Advance pointer MOVB (R1),-1(R1) ; Copy down text BNE 20$ CLRB (R1) ; Delete duplicate last char 30$: MOV (SP)+,R1 ; Restore R1 RTSPC: RTS PC ; and return ; Truncate trailing nulls from EHTXT or FTTXT by reducing length shown in header. DENULL: MOV R1,-(SP) ; Push pointer BR 11$ ; No inc first time 10$: INC (SP) ; Advance pointer 11$: TSTB @(SP) ; Passed null? BNE 10$ ; Keep looking SUB R1,(SP) ; Find new length MOV (SP)+,-(R1) ; Store it RTS PC ; and return .IF DF PIPWLD ; Initialise wildcard processing INIWLD: FDOP$R #DTIFDB,,#CSBLK+C.DSDS ; Reset dataset descriptor, putting R0->FDB JSR PC,ENOPEN ; Initialise (wildcard) processing BCS 10$ ; Trap error JSR PC,ENEXT ; Fetch first file 10$: MOV #DTIFDB,R0 ; Return with R0->FDB BCC RTSPC JMP ERR1 .ENDC .END LIST