;FILE SPOOL.MAC .REPT 0 Author: Maarten van Swaay Department of Chemistry Kansas State University Operating System: RT11 V3 or later Memory: 4.1K bytes SYSGEN options: FB or XM monitor with support for 2 or more terminals This program will print spooled files from SY: with the extension .SPL via LUN 1 or LUN 2. Run-time commands are WIDTH=, LINES=, LUN=, TECO=, and SHOW. SHOW reports the current configuration. The program can run as a system job or as a foreground job. .ENDR .MCALL .LOOKUP, .TWAIT, .READW, .READ, .DELETE, .QSET .MCALL .MTATCH, .MTDTCH,.MTOUT, .MTGET, .MTSET, .EXIT .MCALL .TTINR, .TTYIN, .TTYOU, .WAIT, .PRINT, .WRITE .IIF NDF CHAN, CHAN=1 ;access channel to SY: .IIF NDF LUNDFT, LUNDFT=1 ;default compile for LUN=1 .IIF NDF MMG$T, MMG$T=0 ;default no XM .IIF NDF DSTROY, DSTROY=0 ;default: do not destroy spool file content .GLOBL SPOOL ;entry point .GLOBL WIDTH,PAGE,TYPE ;to allow object patching .GLOBL LUN,DFLAG .ENABL LC ;for messages JSW= 44 USRLOC= 46 ;Directory acces words: SEG defined at end of file LINK=SEG+2 ;link to next segment, if any STEP=SEG+6 ;count of additional bytes per entry OFFSET=SEG+10 ;starting block of first file in segment STATUS=SEG+12 ;status word of first file entry ;.READ EMT words: IOBLK defined at end of file BLOKNO=IOBLK+2 IOBUF=IOBLK+4 IOCNT=IOBLK+6 ;************************* ;*The buffers and code below must not be in the USR swap area ;* LKBLK: .BLKW 3 ;for .MTATCH and .LOOKUP FILNAM: .RAD50 /SY / ;non-file disk access .WORD 0,0,0,0 FILSIZ=FILNAM+10 QUEUE: .BLKW 10. ;one element, big enough for XM TBLOK: .WORD 24*400,TIME TIME: .WORD 0,30. ;500 msec per keyboard look, 30 looks per ;directory scan, or every 15 seconds DELETE: .DELETE #LKBLK,#0,#FILNAM ;cannot use an existing channel! BCC DSCAN JMP DELERR ;* ;*End of no-swap area ;************************* ;************************* ;*Program entry point ;* SPOOL: .QSET #QUEUE,#1 ;for ping-pong reads, and .TWAIT MOV #SPOOL,@#USRLOC ;swap location beyond no-swap area .LOOKUP #LKBLK,#CHAN,#FILNAM BCS LKERR BIS #100,@#JSW ;inhibit input wait for .TTINR SPOOL1: .MTATCH #LKBLK,#0,LUN ;DZ11 channel 1, no AST word BCS ATCHER ;should never fail .MTGET #LKBLK,#MTSTS,LUN BCS GETERR BIC #2,MTSTS ;turn off automatic fold by RMON .MTSET #LKBLK BCS SETERR MOVB LUN,PUTBLK+4 ;LUN channel for .MTOUT staging block DSCAN: MOV #1000,IOCNT ;directory segments are 2 blocks MOV #6,BLOKNO ;and start with block 6 MOV #SEG,IOBUF DIRRD: .READW #IOBLK,#CHAN ;block nr. in EMT block is preset! BCS DRDERR LOOK: MOV #STATUS,R5 ;R5 => file status words LKLOOP: BIT #4*400,(R5) BEQ NPERM ;if clear, not a permanent file CMP TYPE,6(R5) BEQ FOUND ;extension matched spooler extension NPERM: ADD 10(R5),OFFSET ;step offset to next file BIT #10*400,(R5) BNE ENDSEG ;test for last entry in segment ADD #16,R5 ADD STEP,R5 ;advance to next file entry BR LKLOOP ENDSEG: MOV LINK,BLOKNO BEQ NOMORE ;skip out if no more segments ADD #2,BLOKNO ;will make 4 after left shift ASL BLOKNO ;sets block nr. for next segment BR DIRRD NOMORE: MOV #30.,R5 ;30 keyboard looks per directory scan 1$: .TTINR BCS 2$ JMP INPUT 2$: .TWAIT #TBLOK ;1/2 second wait SOB R5,1$ BR DSCAN ;new directory cycle after 30 looks ;************************* ;*Error handlers, all fatal ;* DELERR: MOV #DELMS,R1 BR PRINT ATCHER: MOV #ATCHMS,R1 BR PRINT LKERR: MOV #LKERMS,R1 BR PRINT DRDERR: MOV #DRDMS,R1 BR PRINT GETERR: MOV #GETMS,R1 BR PRINT RDERR: MOV #RDERMS,R1 BR PRINT SETERR: MOV #SETMS,R1 BR PRINT WRERR: MOV #WRMS,R1 PRINT: .PRINT #FATAL MOV R1,R0 .PRINT .EXIT ;quit on serious error ;************************* ;*Read, edit, and write found file ;* FOUND: MOV OFFSET,BLOKNO ;copy block address of found file MOV #FILNAM+2,R4 TST (R5)+ ;step to file name MOV (R5)+,(R4)+ ;file name MOV (R5)+,(R4)+ ;file name MOV (R5)+,(R4)+ ;file extension MOV (R5)+,(R4)+ ;file length FILMOV: JSR PC,PUTNEW ;init transfer buffer for PUT MOV PAGE,LINECT ;this means that an abort should leave CLR COLUMN ; a clean printer (top left of page!) MOV #400,IOCNT ;one block per read MOV #SEG,IOBUF BIT #1,BLOKNO BEQ 1$ ADD #1000,IOBUF ;odd block nrs. use high half of buffer 1$: .READ #IOBLK,#CHAN BCS RDERR TSTB DFLAG BEQ OULP MOV #1,IOCNT ;destroy file content if DFLAG nonzero .WRITE #IOBLK BCS WRERR MOV #400,IOCNT ;************************* ;*Here begins the ping-pong read loop ;* OULP: .WAIT #CHAN BCS RDERR ;non-file, so never gets EOF MOV IOBUF,R5 ;pointer setup for WRITE DEC FILSIZ BEQ LAST ;if last block, write out remainder MOV #SEG,IOBUF ; else set up for next read INC BLOKNO BIT #1,BLOKNO BEQ 1$ ADD #1000,IOBUF 1$: .READ #IOBLK BCS RDERR TSTB DFLAG BEQ 2$ MOV #1,IOCNT ;destroy file content if DFLAG nonzero .WRITE #IOBLK BCS WRERR MOV #400,IOCNT 2$: JSR PC,WRITE ;output editing routine BR OULP ;************************* ;*Wrap-up for last block ;* LAST: JSR PC,WRITE ;edit last block of file EJECT: MOV PAGE,R1 ;then make up trailing FF if need be BNE 1$ MOV #9.,R1 ;if unpaged, FF makes 9 LFs and CR BR 2$ 1$: SUB LINECT,R1 ;will never make a negative ADD COLUMN,R1 BEQ WRDONE ;zero means top left corner of page MOV LINECT,R1 ; else calculate LFs needed ADD #66.,R1 SUB PAGE,R1 2$: MOVB #12,R0 3$: JSR PC,PUT SOB R1,3$ MOVB #15,R0 ;FF makes implicit CR JSR PC,PUT WRDONE: JSR PC,PUTEND ;drain out remaining stuff in PUTBUF JMP DELETE ;then go delete the printed file ;************************* ;*Subroutine WRITE edits one block at a time, by inpsecting each character, ;*and inserting any special strings as needed. All characters are handed ;*over to PUT, which interfaces to the output ring maintained by RMON. ;* WRITE: MOV #1000,R4 ;byte count, R5 => transfer buffer WRLOOP: MOVB (R5)+,R0 BIC #177600,R0 ;7-bit strip BEQ NEXT ;eat nulls CMPB #177,R0 BEQ NEXT ;and rubouts TSTB TECO ;TECO job? BEQ NOTECO ;no, bypass control code conversion CMPB R0,#37 BHI NOSCAN CMPB R0,#33 BHI 2$ ;34-37 are control codes, so convert BEQ 3$ ;ESC echoes as $ 1$: CMPB R0,#15 ;if below ESC, test for printer control codes BHI 2$ CMPB R0,#10 BHIS NOTECO 2$: BISB #100,R0 ;convert control char. to a printing one MOVB R0,-(R5) ;and put back in buffer INC R4 ;keep counting straight MOVB #'^,R0 ;make the ^ BR NOSCAN 3$: MOVB #'$,R0 ;replace ESC with $ BR NOSCAN NOTECO: CMPB R0,#15 BHI NOSCAN ;no special char. with code > 15 MOVB R0,R1 ASL R1 ;convert control code into word index JMP @JVEC(R1) ;then jump via dispatch table NOSCAN: CMP COLUMN,WIDTH BHIS FOLD ;if next char. beyond right margin, fold JSR PC,PUT ; else hand it over INC COLUMN ; and account for it NEXT: SOB R4,WRLOOP RTS PC JVEC: .WORD NEXT,NEXT,NEXT,NEXT ;control codes 0-3 ignored .WORD NEXT,NEXT,NEXT,NEXT ;also 4-7 .WORD BSP ;ASCII 10, backspace .WORD TAB ;11 .WORD LF ;12 .WORD NEXT ;13, vertical tab, ignored .WORD FF ;14 .WORD CR ;15 ;************************* ;*FOLD, BSP, TAB, CR, LF, AND FF handle special characters and ;*conditions. Dispatching by WRITE via JVEC; all routines exit to NEXT. ;* FOLD: MOVB #15,R0 ;synthesize CRLF on long lines JSR PC,PUT CLR COLUMN ;account for CR DEC R5 ;to get back the held-up char. INC R4 ;and keep the transfer count in step MOVB #12,R0 BR LF ;do the lines accounting at LF BSP: TST COLUMN BEQ NEXT ;no backspace if at margin DEC COLUMN JSR PC,PUT BR NEXT TAB: MOVB #40,R0 ;always need one or more spaces ADD #10,COLUMN CMP COLUMN,WIDTH BLO 1$ ;branch if enough space left on line SUB #7,COLUMN ;not enough room, make one space JSR PC,PUT BR NEXT 1$: SUB #10,COLUMN 2$: JSR PC,PUT INC COLUMN BIT #7,COLUMN BNE 2$ BR NEXT CR: TST COLUMN BEQ NEXT ;NOP if at margin CR1: JSR PC,PUT CLR COLUMN BR NEXT LF: JSR PC,PUT TST PAGE BEQ NEXT ;no need to count if unpaged DEC LINECT BNE NEXT BR FFCALC ;if paged and at bottom, do as if FF FF: MOVB #12,R0 MOV PAGE,R1 BNE 1$ MOV #9.,R1 ;if unpaged, FF makes 9 LFs and CR BR LFMOVE 1$: SUB LINECT,R1 ; else test for top left corner ADD COLUMN,R1 BEQ NEXT ;zero means top left corner of page FFCALC: MOV LINECT,R1 ; else calculate LFs needed ADD #66.,R1 SUB PAGE,R1 LFMOVE: JSR PC,PUT SOB R1,LFMOVE MOV PAGE,LINECT MOVB #15,R0 ;FF makes implicit CR BR CR1 ;************************* ;*The PUT subroutine interfaces WRITE to the RMON ring buffer. It is not ;*necessary to use an intermediate buffer, but a string transfer avoids ;*multiple passes through the EMT dispatch code. ;*PUTNEW initializes pointers for PUT. ;*PUTEND moves a partially filled buffer to the ring buffer. ;* PUT: MOVB R0,@PUTPTR ;incoming char. in R0 INC PUTPTR DEC PUTCTR BNE PUTEX MOV R0,-(SP) ;.MTOUT changes R0 .MTOUT #PUTBLK MOV (SP)+,R0 PUTNEW: MOV #40.,PUTCTR ;entry for initialization MOV #PUTBUF,PUTPTR MOVB #40.,PUTBLK+5 ;in case it was changed with an abort PUTEX: RTS PC PUTEND: SUB #40.,PUTCTR ;drains a partially filled buffer BEQ PUTNDX NEG PUTCTR MOVB PUTCTR,PUTBLK+5 .MTOUT #PUTBLK MOVB #40.,PUTBLK+5 PUTNDX: RTS PC ;************************* ;*Keyboard input handler for run-time changes of LUN, LINES, WIDTH, ;*and TECO, and to SHOW current setup. ;* INBUF=SEG ;SEG never in use when INBUF is needed TOKEN=SEG+134. ;beyond max. input line length DTBLK=SEG ;used for .MTDTCH only INPUT: MOV #INBUF,R1 ;collect input string MOVB R0,(R1)+ 1$: .TTYIN (R1)+ CMPB #12,R0 BNE 1$ CLRB NUMFLG ;nonzero if num. arg. given MOV #INBUF,R1 MOV #TOKEN,R2 2$: CMPB (R1),#'= BEQ EQL CMPB (R1),#15 BEQ ENDTOK CMPB (R1),#12 BEQ ENDTOK CMPB (R1),#40 BNE 3$ ;ignore spaces INC R1 BR 2$ 3$: MOVB (R1)+,(R2)+ ;insert token char. BR 2$ ENDTOK: MOVB #200,(R2) BR ENDENC EQL: MOVB #200,(R2) ;close off token 1$: INC R1 CMPB (R1),#40 BEQ 1$ ;discard spaces CLRB NOCT ;non-octal flag CLR R4 ;octal staging reg. CLR R3 ;decimal staging reg. LOOP: MOVB (R1)+,R0 CMPB R0,#'0 BLO NODIG CMPB R0,#'9 BHI NODIG CMPB R0,#'7 BLOS 1$ MOVB R0,NOCT ;set non-octal flag 1$: SUB #60,R0 ASH #3,R4 BVS CMDERR ;octal overflow ADD R0,R4 MUL #10.,R3 BCS CMDERR ;decimal overflow ADD R0,R3 INCB NUMFLG ;numeric arg. supplied BR LOOP NODIG: CMPB R0,#15 BEQ ENDNUM CMPB R0,#12 BEQ ENDNUM CMPB R0,#'. BNE CMDERR MOV R3,R4 ;R4 is num. response BR ENDENC ;end of encoding ENDNUM: TSTB NOCT BNE CMDERR ;non-octal in octal string ENDENC: JSR R5,STRING .WORD CLIST,TOKEN BCS CMDERR JMP @0(R3) ;dispatch to CSHOW, CLUN, CWID, CLINES CMDERR: .PRINT #INVAL CMDEXT: JMP NOMORE ;command exit CSHOW: .PRINT #SLUN MOVB LUN,R0 ADD #60,R0 .TTYOUT .PRINT #SPAGE MOV PAGE,R5 JSR PC,BINPRT ;converts and prints decimal .PRINT #SWID MOV WIDTH,R5 JSR PC,BINPRT MOV #TECOFF,R0 TSTB TECO BEQ 1$ MOV #TECON,R0 1$: .PRINT BR CMDEXT CLUN: TSTB NUMFLG BEQ CMDERR ;missing num. arg. CMP R4,#2 BEQ CHLUN ;ok to change LUN CMP R4,#1 BNE CMDERR CHLUN: CMP R4,LUN BEQ CMDEXT ;old LUN = new LUN .MTDTCH #DTBLK,LUN BCS DETERR MOV R4,LUN JMP SPOOL1 DETERR: MOV #DETMS,R0 JMP PRINT CLINES: TSTB NUMFLG BEQ CMDERR ;missing num. arg. TST R4 BEQ 1$ CMP R4,#30. BLO CMDERR CMP R4,#60. BHI CMDERR 1$: MOV R4,PAGE BR CMDEXT CWID: TSTB NUMFLG BEQ CMDERR ;missing num. arg. CMP R4,#30. BLO CMDERR ;lines at least 30 char. CMP R4,(PC)+ MAXWID: .WORD 132. BHI CMDERR ; and at most 132 (131 if TECO set) MOV R4,WIDTH BR CMDEXT CTECO: TSTB NUMFLG BEQ CMDERR CLRB TECO ;mode flag TST R4 BEQ 1$ INC TECO 1$: BR CMDEXT BINPRT: TST R5 BNE 1$ .TTYOUT #'0 BR 5$ 1$: CMP R5,#100. ;converts and prints R5 up to 199 dec. BLO 2$ SUB #100.,R5 .TTYOUT #'1 2$: MOVB #'0,R0 3$: SUB #10.,R5 BMI 4$ INC R0 BR 3$ 4$: ADD #<10.+60>,R5 .TTYOUT MOVB R5,R0 .TTYOUT 5$: RTS PC STRING: MOV R4,-(SP) MOV (R5)+,R3 ;stolen from STRING.MAC, for MOV (R5)+,HOLDS ;comments see that file LOOPS: MOV HOLDS,R4 TSTB (R3) BPL 1$ SEC BR EXITS 1$: CMPB (R4)+,(R3)+ BEQ 1$ TSTB -(R3) BNE 2$ TSTB -(R4) BMI FOUNDS 2$: TSTB (R3)+ BNE 2$ 3$: TSTB (R3)+ BEQ 3$ INC R3 BR LOOPS FOUNDS: BIT #1,R3 BNE 1$ INC R3 1$: INC R3 CLC EXITS: MOV (SP)+,R4 RTS R5 ;************************* ;*Buffers and variables ;*LUN, TYPE, PAGE, WIDTH are global to allow object patching ;* LUN: .WORD LUNDFT ;default LUN = 2 (DZ11 ch. 1) TYPE: .RAD50 /SPL/ ;default extension SPL PAGE: .WORD 60. WIDTH: .WORD 132. CLIST: .ASCIZ /SHOW/ ;dispatch list for run-time commands .EVEN .WORD CSHOW .ASCIZ /LUN/ .EVEN .WORD CLUN .ASCIZ /WIDTH/ .EVEN .WORD CWID .ASCIZ /LINES/ .EVEN .WORD CLINES .ASCIZ /TECO/ .EVEN .WORD CTECO .WORD -1 LINECT: .BLKW 1 COLUMN: .BLKW 1 HOLDS: .BLKW 1 PUTBLK: .WORD 37*400+3,PUTBUF .WORD 40.*400 ;char. count in high byte ;low byte loaded with LUN on startup IOBLK: .WORD 0,0,SEG,0,1 ;EMT staging block for .READ MTSTS: .BLKW 4 ;terminal status block PUTPTR: .WORD PUTBUF PUTCTR: .WORD 40. SEG: .BLKW 1000 ;2 blocks per segment PUTBUF: .BLKB 40. NOCT: .BLKB 1 NUMFLG: .BLKB 1 TECO: .BYTE 0 ;normal is TECO OFF DFLAG: .BYTE DSTROY ;file destruction flag ;************************* ;*messages and USR swap space ;* CRLF: .BYTE 0 FATAL: .ASCII /SPOOL-F-cannot /<200> ATCHMS: .ASCIZ /attach terminal/ DETMS: .ASCIZ /detach terminal/ LKERMS: .ASCIZ /access system device/ DRDMS: .ASCIZ /read directory/ GETMS: .ASCIZ /get terminal status/ RDERMS: .ASCIZ /read spooled file/ SETMS: .ASCIZ /set terminal status/ DELMS: .ASCIZ /delete file/ INVAL: .ASCIZ /?SPOOL?-E-valid commands are SHOW, LINES=, WIDTH=, TECO=/ SLUN: .ASCII /LUN = /<200> SPAGE: .ASCII /, LINES = /<200> SWID: .ASCII /, WIDTH = /<200> TECOFF: .ASCIZ /, TECO = 0 (OFF)/ TECON: .ASCIZ /, TECO = 1 (ON)/ WRMS: .ASCIZ /destroy file contents/ .EVEN .IF EQ MMG$T .IF LT <.-SPOOL>-10000 .BLKW <10000-.+SPOOL>/2 ;to fill out USR swap space .ENDC .ENDC ZZZZZZ= . .END SPOOL