.title rt11io .ident /BL8.1/ ; Modified 14-Jan-86 by RLW (RT-11 SIG) .enable gbl .enable lc ; ; This code is designed to replace the RSX/IAS/VMS system dependent ; code required to handle device I/O for the program RUNOFF. ; ; Written by : Gary McMillian ; Physics Department ; Rice University ; P. O. Box 1892 ; Houston, Texas 77251 ; .mcall .close,.csispc,.lookup,.print .mcall .readw,.ttinr,.ttyout,.wait,.write,.writw ; .sbttl Word Definitions ; wcnt = 256. ;Word count for .readw and .writw l.lun == 0 ;Offset to logical unit number l.blk == 2 ;Offset to file block number l.chr == 4 ;Offset to current character address l.beg == 6 ;Offset to start of current buffer l.end == 10 ;Offset to end of current buffer l.one == 12 ;Offset to address of first buffer l.two == 14 ;Offset to address of second buffer infile = 30. ;Offset to dev:filnam.ext in ttbuf ; .sbttl Macro Definitions ; .macro push mov r4,-(sp) ;Push r4 on stack mov r5,-(sp) ;Push r5 on stack .endm ; .macro pop mov (sp)+,r5 ;Pop r5 off stack mov (sp)+,r4 ;Pop r4 off stack .endm .sbttl Define storage blocks .vars area:: .blkw 5 ;Five word EMT argument block rnobuf: .blkb 512. ;.RNO input buffer rnoend == .-1 ;Address of buffer end docone: .blkb 512. ;First .DOC output buffer rntone: .blkb 512. ;First .RNT output buffer .ifdf dblbuf doctwo: .blkb 512. ;Second .DOC output buffer rnttwo: .blkb 512. ;Second .RNT output buffer xque:: .blkw 20. ;Extra I/O queue elements .endc ; depth:: .word 0 ;.REQUIRE level nesting depth lev:: .word level0,level1,level2 ;Level pointer table .word level3,level4,level5 .word level6 level0: .word rno.ch ;Logical unit number .word 0 ;Block number .word rnoend+1 ;Current character address .irpc x,<123456> level'x:.word 1'x ;Logical unit number .word 0 ;Block number .word rnoend+1 ;Current character address .endr docblk::.word doc.ch ;Logical unit number .word 0 ;Block number .word docone ;Current character address .word docone ;Current buffer starting address .word ;Current buffer ending address .ifdf dblbuf .word docone ;Address of first output buffer .word doctwo ;Address of second output buffer .endc rntblk::.word rnt.ch ;Logical unit number .word 0 ;Block number .word rntone ;Current character address .word rntone ;Current buffer starting address .word ;Current buffer ending address .ifdf dblbuf .word rntone ;Address of first output buffer .word rnttwo ;Address of second output buffer .endc csibuf: .byte '= ;CSI format buffer .blkb 15. ;DEV:FILNAM.EXT buffer linbuf::.blkb 82. ;CSI command string buffer .even defext::.rad50 "RNO" ;CSI default file extensions .rad50 "DOC" .rad50 "RNT" .word 0 ;-------------------------------------------------------------+ ; The following variables added by the RT-11 SIG (SPR020) | binflg: .word 0 ; REQUIRE BINARY flag | reqlen: .word 0 ; size of required file | ;-------------------------------------------------------------+ ; ; Text storage block ; .text oprtxt: .ascii <7><7><7><7><7><200> ;Ring user's bell return: .ascii <15><12> ;Carriage return, line feed .EVEN .sbttl Line input routines .code ; ; Call fin ; carry set if no line transfered ; carry clear if line transfered ; fin:: MOV R3,-(SP) ;Save R3 MOV BUFADD,R3 ;Get input buffer address mov r3,bufad ;No substitutions clrb substk ;Substitution level zero CALL CLRBF ;Clear buffer MOV (SP)+,R3 ;Restore tstneb eofsw,6$ ;End of all files? push ;Save r4 and r5 inc @trcbuf ;Next line number clr r4 ;Clear transfer count mov bufadd,r1 ;Point r1 to actual line buffer mov bf.cad(r1),r1 ;Point r0 to current data buffer add #bflnk+1,r1 ;Skip over forward/backward links mov depth,r5 ;Get file nesting depth asl r5 ;Form table offset mov lev(r5),r5 ;Get current file descriptor pointer ;----------------------------------------------------------------+ ; The following two lines were added by the RT-11 SIG (SPR14) | tst l.lun(r5) ; is this the final eof? | bmi 7$ ; branch if it is | ;----------------------------------------------------------------+ ; The following lines added by the RT-11 SIG (SPR020) | tst binflg ; Is require binary? | beq 5$ ; Branch if not | mov depth,-(sp) ; Save current depth | call read ; Get next block | bcs 13$ ; Branch if error | cmpne depth,(sp),13$ ; Branch if done | mov #512.,-(sp) ; Save length on stack | cmp l.blk(r5),reqlen ; Last block? | blo 120$ ; Branch if not | mov #rnobuf,r0 ; Point to end | add (sp),r0 ; of input buffer | 110$: tstb -(r0) ; Is the byte zero? | bne 112$ ; Branch if it is | cmp r0,#rnobuf ; Any more to do? | bhi 110$ ; Branch if so | 112$: sub #rnobuf,r0 ; Compute length of | inc r0 ; non-null part | mov r0,(sp) ; Correct stacked length | 120$: mov #rnobuf,r0 ; Get current char adr | mov (sp),r4 ; r4 = length to move | 11$: movb (r0)+,(r1)+ ; Move one byte | sob r4,11$ ; Until done | mov (sp)+,r4 ; Reset byte count | tst (sp)+ ; clean stack | br 12$ ; Wrap it up | 13$: tst (sp)+ ; clean stack | pop ; restore r4,r5 | br 6$ ; all done | ;----------------------------------------------------------------+ 5$: mov l.chr(r5),r0 ;Get current character address ; 2$: cmp r0,#rnoend ;Test for end of block buffer ;----------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR10) | ; ble 3$ ;Within buffer boundary | blos 3$ ;Within buffer boundary | ;----------------------------------------------------------------+ 1$: call read ;Read next block from device ;----------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR14) | ; bcc 5$ ;Renter transfer loop | mov l.chr(r5),r0 ;Get current char adr | bcc 3$ ;Branch if read was ok | movb #CR,(r0) ;Else force a CR | movb #LF,1(r0) ; and a LF | tst r4 ;Test for partially | bne 3$ ; filled buffer | 7$: movb #1,eofsw ;Force eof | ;----------------------------------------------------------------+ pop ;Restore r4 and r5 6$: sec ;No line transfered return ; ;----------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR13) | ;3$: tsteqb (r0),1$ ;Null character? | 3$: movb (r0)+,(r1) ;Transfer character | beq 2$ ;If null, skip it | ;----------------------------------------------------------------+ inc r4 ;Increment character count cmp r4,#IBFSZ ;Overflowed line buffer? ble 4$ ;Inside buffer boundary mov #11.,r0 ;Input file error jmp ILINP ;Send error message to user ; 4$: ;----------------------------------------------------------------+ ; The following line was removed by the RT-11 SIG (SPR13) | ; movb (r0)+,(r1) ;Transfer character | ;----------------------------------------------------------------+ cmpneb #LF,(r1)+,2$ ;Watch for end of line ; mov r0,l.chr(r5) ;Save current character address ;----------------------------------------------------+ ; The following label added by the RT-11 SIG (SPR20) | 12$: ; | ;----------------------------------------------------+ mov bufadd,r1 ;Point r1 to actual line buffer mov r4,bf.cnt(r1) ;Enter count of characters remaining mov r4,bf.max(r1) ;Enter maximum number of bytes BITEQ #DEBSW,$SWTCH,20$ ; Not debug mode ? CALL TTINOU ; **** DEBUG 20$: pop ;Restore r4 and r5 clc ;Successful line transfer return ; ; Call read ; Carry set if end of all files ; Carry clear if transfer successful ; r5 = Address of file descriptor block ; read: mov #rnobuf,l.chr(r5) ;Initialize character address 5$: .readw #area,l.lun(r5),#rnobuf,#wcnt,l.blk(r5) bcs 1$ ;Go process input error inc l.blk(r5) ;Increment block number clc ;Successful block transfer return ; 1$: tsteqb @#errbyt,2$ ;End of file on input? mov #11.,r0 ;Input file error jmp ILINP ;Send error message to user ; 2$: tst depth ;Can we decrease nesting depth? beq 3$ ;No. .close l.lun(r5) ;Close nested .RNO file dec depth ;Decrease nesting depth mov depth,r5 ;Get file nesting depth asl r5 ;Form table offset mov lev(r5),r5 ;Get current file descriptor pointer dec l.blk(r5) ;Read previous block sub #trcln,trcbuf ;Backup to previous file br 5$ ;Continue block read ; 3$: cmp l.lun(r5),#10 ;Can we move to next .RNO file bge 4$ ;No. inc l.lun(r5) ;Move to next .RNO file .wait l.lun(r5) ;Has this file been opened? bcs 3$ ;No. clr l.blk(r5) ;Initialize block number br read ;Continue block read ; 4$: ;----------------------------------------------------------------+ ; The following two lines were replaced by the RT-11 SIG (SPR14) | ; movb #-1,eofsw ;Set end of file switch | ; clc ;End of input files | mov #-1,l.lun(r5) ;Set end of file switch | scc ;Indicate end of all | ;----------------------------------------------------------------+ return .sbttl REQUIRE command ; ; Call requr ; requr:: push ;Save r4 and r5 cmp depth,#6. ;Maximum file nesting depth is 6 blt 1$ ;Depth's O.K. mov #20.,r0 ;Too many nested .REQ jmp ILINP ;Send error message to user 1$: call GETLIT ;Get literal address and length bcs 3$ ;Literal error mov R0,R2 ;literal address BEQ 3$ cmp r1,#14. ;Compare literal length to legal size bgt 3$ ;Literal too long, file spec error add #trcln,trcbuf ;Point to next traceback buffer mov trcbuf,r5 ;Point r5 to current buffer clr (r5)+ ;Clear line count mov #csibuf+1,r0 ;Point to CSI buffer 6$: movb (r2),(r0)+ ;Load CSI buffer movb (r2)+,(r5)+ ;Load traceback buffer sob r1,6$ ;Transfer complete string clrb (r5) ;Null string, make ASCIZ clrb (r0) ;Null string, make ASCIZ mov sp,r4 ;Save stack pointer .csispc #ttbuf,#defext,#csibuf ;Process command string bcc 4$ ;No error mov r4,sp ;Restore stack pointer 7$: sub #trcln,trcbuf ;Backup to file with error 3$: mov #18.,r0 ;Input file specification error jmp ILINP ;Send error message to user 4$: mov r4,sp ;Restore stack pointer tsteq #ttbuf+infile+2,7$ ;Make sure file name specified inc depth ;Increment file nesting depth mov depth,r5 ;Point r5 to file nesting depth asl r5 ;Form table offset mov lev(r5),r5 ;Get current file descriptor pointer clr l.blk(r5) ;Initialize block number mov #rnoend+1,l.chr(r5) ;Initialize current character address .lookup #area,l.lun(r5),#ttbuf+infile ;Open input file bcc 5$ ;File opened mov #19.,r0 ;Input file open error jmp ILINP ;Send error message to user 5$: mov r0,reqlen ;Save it mov bufadd,r3 ;Point r3 to current line buffer call clrbf ;Clear the buffer mov #CR,r1 ;Put carriage return into r1 call pbyt ;Put byte into buffer mov #LF,r1 ;Put line feed into r1 call pbyt ;Put byte into buffer call begbf ;Set to top of buffer pop ;Restore r4 and r5 return ;-----------------------------------------------+ ; REQUIRE BINARY subroutine added by RT-11 SIG | ;-----------------------------------------------+ .sbttl Require binary REQBIN::CALL (R4) ; Get number CALL CVSP ; Get half line count MOV R3,-(SP) ; Save it for later MOV R3,R5 ; Vertical spacing CLR R4 ; CALL PARTS ; Check if space available SUB (SP),LINEC1 ; Subtract from spacing SUB (SP),LINEC2 ; "" SUB (SP)+,LINEC3 ; "" CALL REQUR ; Get input file INC BINFLG ; Flag where we are 10$: CALL FIN ; Get input line BCS 50$ ; Branch if done MOV BUFADD,R3 ; Buffer address 20$: CALL GBYT ; Get single byte of input BCS 10$ ; No more this buffer CALL FOUT ; Output it BR 20$ ; And more ... 50$: CLR BINFLG ; unflag where we are TST (SP)+ ; bump return address JMP LGO ; and start next input line .sbttl Character output routines ; ; Call fout ; r1 = character ; fout:: tstneb $outsw,OUTPUT ;No output? cmp docblk+l.chr,docblk+l.end ;Check for end of block buffer ;-------------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR10) | ; ble 1$ ;Continue until buffer full | blos 1$ ;Continue until buffer full | ;-------------------------------------------------------------------+ push ;Save r4 and r5 mov #docblk,r4 ;Point r4 to DOC descriptor block call write ;Transfer buffer to device pop ;Restore r4 and r5 1$: movb r1,@docblk+l.chr ;Transfer data to buffer inc docblk+l.chr ;Point to next byte address OUTPUT::return ; ; Output Table of Contents ; r1 = String address ; r2 = Length of string ; outtoc::tstneb $outsw,1$ ;No output? push ;Save r4 and r5 mov #rntblk,r4 ;Point r4 to .RNT descriptor block mov l.chr(r4),r5 ;Point r5 to current character address call tocout ;Transfer string mov #return,r1 ;Address of CR-LF string mov #2,r2 ;Transfer two characters call tocout ;Transfer string mov r5,l.chr(r4) ;Save current character address pop ;Restore r4 and r5 1$: return ; tocout: cmp r5,l.end(r4) ;Check for end of buffer ;-------------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR10) | ; ble 1$ ;Continue until buffer full | blos 1$ ;Continue until buffer full | ;-------------------------------------------------------------------+ call write ;Transfer buffer to device mov l.chr(r4),r5 ;Point r5 to beginning of buffer 1$: movb (r1)+,(r5)+ ;Transfer data to buffer sob r2,tocout ;Branch until transfer complete return ; ; Close out Document and Table of Contents files ; endfil::bitneb #SW.DIS,$outsw,20$ ;First of 2 passes ? mov #docblk,r4 ;Point r4 to .DOC descriptor block call null ;Null out rest of buffer .close l.lun(r4) ;Close output file tstneb $tocsw,1$ ;Did we make a Table of Contents? mov #rntblk,r4 ;Point r4 to .RNT descriptor block call null ;Null out rest of buffer .close l.lun(r4) ;Close output file 1$: ; Line added by R.Walraven 6-DEC-85 20$: jmp runoff ;Start over ; ; Call Null ; r4 = Address of file descriptor block ; null: mov l.chr(r4),r0 ;Point r0 to current character address ;-------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR11) | ; cmpeqb r0,l.beg(r4),3$ ;Ignore empty buffers | cmpeq r0,l.beg(r4),3$ ;Ignore empty buffers | ;-------------------------------------------------------------+ 1$: cmp r0,l.end(r4) ;Test for end of buffer ;------------------------------------------------------------------------+ ; The following line was replaced by the RT-11 SIG (SPR10) | ; bgt 2$ ;End of buffer, write last block | bhi 2$ ;End of buffer, write last block | ;------------------------------------------------------------------------+ clrb (r0)+ ;Null character br 1$ ;Next byte 2$: call write ;Transfer last block to device .ifdf dblbuf .wait l.lun(r4) ;Suspend execution until I/O complete bcs 10$ ;Error on previous I/O operation .endc 3$: return 10$: mov #10.,r0 ;Output file error jmp ILINP ;Send error message to user ; ; Call Write ; r4 = Address of file descriptor block ; write: .ifdf dblbuf .wait l.lun(r4) ;Suspend execution until I/O complete bcs 1$ ;Error on previous I/O operation .write #area,l.lun(r4),l.beg(r4),#wcnt,l.blk(r4) .iff .writw #area,l.lun(r4),l.beg(r4),#wcnt,l.blk(r4) .endc ; bcc 2$ ;Successful write 1$: mov #10.,r0 ;Output file error jmp ILINP ;Send error message to user ; 2$: inc l.blk(r4) ;Increment block number .ifdf dblbuf cmp l.beg(r4),l.one(r4) ;Currently first or second buffer? beq 3$ ;First buffer, go to second mov l.one(r4),r0 ;Point current buffer to first buffer br 4$ ;Finish buffer swap 3$: mov l.two(r4),r0 ;Point current buffer to second buffer 4$: mov r0,l.beg(r4) ;Point to start of current buffer add #511.,r0 ;Calculate ending address mov r0,l.end(r4) ;Point to end of current buffer .endc mov l.beg(r4),l.chr(r4) ;Initialize current character address return .sbttl Terminal I/O Routines ; ; Call erout ; r0 = ASCIZ string address ; erout:: .print ;Print out ASCIZ string return ; ; Call ttinou ; Type out the whole input line buffer ; ttinou::mov #ibuf1,r0 ;Point r1 to input buffer address mov bf.MAX(r1),r1 ;Number of bytes IN BUFFER sub #2,R1 ;Skip CR,LF mov bf.beg(r0),r0 ;Point r0 to data area add #bflnk+1,r0 ;Skip over forward/backward links ; ; Call ttout ; r0 = string address ; r1 = length ; ttout:: mov r2,-(sp) ;Save r2 on stack mov R0,R2 ;Address into R2 TST R1 BLE 2$ ; ZERO COUNT ? 1$: TSTEQB (R2),2$ ;ZERO BYTE ? .ttyout (r2)+ ;Print character sob r1,1$ ;Loop until complete 2$: .ttyout #CR ;Send carriage return .ttyout #LF ;Send line feed mov (sp)+,r2 ;Pop r2 off stack return ; ; Call oprwat ; Finish page print, print message, read input ; oprwat::biteq #pausw,$swtch,1$ ;Don't wait mov #docblk,r4 ;Point r4 to .DOC descriptor block call null ;Null out rest of buffer mov #oprtxt,r0 ;Point r0 to operator text call erout ;Output operator text bis #10000,@#jsw ;Set special mode terminal bit .ttinr ;Input character bcs .-2 ;Loop until character entered bis #100,@#jsw ;FB, XM, and TSX+ Inhibit terminal wait .ttinr ;Clear out rest of characters bcc .-2 ;Loop until complete bic #10100,@#jsw ;Clear special mode and terminal wait 1$: return .end