PROCEDURE ,010005 ;+ ; Copyright (c) 1976 ; Digital Equipment Corporation, Maynard, Mass. ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the inclu- ; sion of the above copyright notice. This software, or any ; other copies thereof, may not be provided or otherwise made ; available to any other person except for use on such system ; and to one who agrees to these license terms. Title to and ; ownership of the software shall at all times remain in DEC. ; ; The information in this software is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation. ; ; DEC assumes no responsibility for the use or reliability of its ; software on equipment which is not supplied by DEC. ; ; Abstract: This module contains the FCS I/O routines ; for Runoff. ; ; Written: 1-Jun-72, -0.0.0-, L. Wade ; ; Modified: 10-Jan-80, -1.0.0-, Henry R. Tumblin ; Made Duke supported version ; ; Verified: 10-Jan-80, -1.0.0-, Henry R. Tumblin .IF DF A$$RAP ; ; Modified: 27-Aug-80, -1.0.1-, John D. Leonard ; If output to Diablo terminal use QIO with write-pass-all ; rather than PUT$S so graph mode spacing works. ; ; Modified: 26-Sep-80, -1.0.2-, John D. Leonard ; Added support to output two character sets (CS2OUT) ; ; Modified: 07-NNov-80, -1.0.3-, John D. Leonard ; Added call to SUBSYM, which scans the input line and substitutes ; the string values of any character symbols imbedded in the input line. ; ; Modified: 21-Nov-80, -1.0.4-, John D. Leonard ; OUTPUT did not save register R0. Problem developed when FOUT filled ; buffer, called OUTPUT and modified R0 when R0 was being used as a ; loop counter in calling routine. Symptom: infinite looping. Saved R0. ; ; Modified: 03-Dec-80, -1.0.5-, John D. Leonard ; Fixed up CS2OUT so no horizontal movement if nothing to print ; on pass 2. .ENDC ;- .SBTTL MCALLS AND RUNOFF DEFINITIONS .MCALL GET$,GET$S,PUT$S,CALLR,DIR$,QIOW$S,MRKT$S,WTSE$S ;+ ; RUNOFF global definitions ;- .GLOBL CR ; carriage return .GLOBL ENDFIL ; endfile processing .GLOBL EOF ; end of file character .GLOBL HFIN ; Input buffer descriptor .GLOBL HFOUT ; Output file buffer descriptor .GLOBL HGHCHP ; high limit of /ch:l:h .GLOBL HGHPAG ; high limit of /pa:l:h .GLOBL LF ; line feed .GLOBL LOWCHP ; low limit of /ch:l:h .GLOBL LOWPAG ; low limit of /pa:l:h .GLOBL LSTBLK ; output fdb address .GLOBL PAGENO ; current page number .GLOBL RUNOFF ; restart point after error .GLOBL S1 ; current pointer to string to output .GLOBL TTLDMY ; source input fdb .GLOBL $QIO ; Q-I/O DPB for terminal I/O ;+ ; globals defined in this module ;- .GLOBL CRLF ; output a cr/lf to listing file .GLOBL FIN ; read record from input file .GLOBL FMSG ; output asciz string to listing file .GLOBL FOUT ; insert character into listing ; file output buffer. .GLOBL OUTPUT ; output contents of line buffer to ; listing file. .GLOBL $OUT ; output string to TI0: .SBTTL FILE INPUT/OUTPUT ROUTINES CODE RNFIO ; declare p-sect ;+ ; file input/output routines ;- FMSGL: INC S1 ; bump up pointer to next char. FMSG:: MOVB @S1,R1 ; move character -> r1 to be output BNE 10$ ; eq- then end of string, return to caller RETURN ; ... 10$: CALL FOUT ; output character BR FMSGL ; loop ; crlf -- output cr/lf combination to output file CRLF:: TSTB $SWPFL ; swap files ? BEQ 10$ ; EQ - no JMP TCRLF ; Else do it to the TOC file 10$: .IF DF A$$RAP CALL FLUSH .ENDC MOV #CR,R1 ; Get carriage return CALL FOUT ; Output it to the file MOV #LF,R1 ; Get line feed CALL FOUT ; Output it .IF DF A$$RAP CALL FLUSH .ENDC RETURN ; Return to caller ; fout -- output character to output file FOUT:: TSTB $SWPFL ; Swap files ? BEQ 5$ ; EQ - no JMP TFOUT ; Else do it to the TOC file 5$: MOVB R1,@HFOUT+BF.PTR ; store character in buffer INC HFOUT+BF.PTR ; increment buffer pointer INC HFOUT+BF.LEN ; Bump up length of string CMP HFOUT+BF.PTR,HFOUT+BF.END ; At end of buffer ? BLO 10$ ; EQ - Yes, go output line .IF DF A$$RAP BISB #BOVFLG,$CS2FL ; Indicate OUTPUT called due to buffer overflow .ENDC CALL OUTPUT ; Output the line 10$: RETURN ; .SBTTL FLUSH - Flush the output buffer FLUSH:: ; CMPNE #3,CSVAL,10$ ; Skip if not changing wheel line by line CALL OUTPUT BICB #BOVFLG,$CS2FL ; Clear buffer overflow flag - logical end 10$: RETURN .sbttl FIN -- INPUT CHARACTER FROM INPUT FILE FIN:: TST HFIN+BF.LEN ; anything in buffer? BGT 40$ ; IF GT YES BITB #FIN.CR,FINFLG ; Has the been done yet ? BNE 2$ ; NE - then check BISB #FIN.CR,FINFLG ; Show that we've done MOV #CR,R1 ; Else insert BR 50$ ; And return 2$: BITB #FIN.LF,FINFLG ; Has the been done yet ? BNE 5$ ; NE - then read from file BISB #FIN.LF,FINFLG ; Show that we've done MOV #LF,R1 ; Else insert BR 50$ ; And return 5$: MOV #HFIN,R4 ; Get pointer to buffer header MOV BF.END(R4),R1 ; Get end SUB BF.ADR(R4),R1 ; Calculate length MOV BF.ADR(R4),BF.PTR(R4) ; Reset pointer CLR BF.LEN(R4) ; Reset length BICB #FIN.CR!FIN.LF,FINFLG ; Clear flags GET$ #TTLDMY,BF.ADR(R4),R1 ; Read a record BCC 20$ ; br if i/o ok CMPEQB #IE.EOF,F.ERR(R0),10$ ; not end of file? MOV R0,-(SP) ; point to fdb DIAG INPERR,FCS ; output diagnostic message CALLR RUNOFF ; restart 10$: CALL NXTFIL ; try to open the next file if possible. BCC 5$ ; success, try to read a record. MOV #EOF,R1 ; Set EOF byte BR 50$ ; And go do clean up 20$: .IF DF D$$BUG CALL IDSPLY ; display the input line .ENDC ; D$$BUG TST F.NRBD(R0) ; Anything there ? BNE 30$ ; NE - then not a null line MOV #40,R1 ; Insert a blank CLR HFIN+BF.LEN ; Reset length BR 50$ ; And go do clean up 30$: MOV F.NRBD(R0),BF.LEN(R4) ; Set length CMP F.NRBD+2(R0),BF.ADR(R4) ; Are the buffers the same ? BEQ 35$ ; EQ - then don't update pointers MOV F.NRBD+2(R0),BF.PTR(R4) ; Set pointer to record 35$: .IF DF A$$RAP ; CALL DBPRNT CALL SUBSYM ; Substitute strings for character type symbols ; CALL DBPRNT .ENDC 40$: MOVB @HFIN+BF.PTR,R1 ; get next character from input record INC HFIN+BF.PTR ; point to next character DEC HFIN+BF.LEN ; one less from total BIC #^C<177>,R1 ; clear excess bits BEQ FIN ; if eq null CMPEQ R1,#177,FIN ; rubout? 50$: RETURN ; .SBTTL OUTPUT THE CURRENT LINE BUFFER ; this routine outputs the current contents of the line buffer OUTPUT: TSTB $SWPFL ; Have files been swapped ? BEQ 5$ ; EQ - no JMP TOTPUT ; Else go do it to the TOC file 5$: MOV R0,-(SP) ; Save R0 while in OUTPUT TST HFOUT+BF.LEN ; Anything in buffer ? BEQ 10$ ; if eq empty buffer ; check chapter range TSTB LSTSPC ; Listing file exist? BEQ 10$ ; J if not. CLR R0 ; clear for byte move MOVB CHPTN,R0 ; get chapter number CMP R0,LOWCHP ; only print in selected BLO 10$ ; chapter range CMP R0,HGHCHP ; ... BHI 30$ ; quit if out of range ; check page range CMP PAGENO,LOWPAG ; only print in the selected page BLO 10$ ; range CMP PAGENO,HGHPAG ; BHI 30$ ; quit if beyond range 7$: .IF DF A$$RAP ; Count number of formfeeds in output buffer SAVE R0,R1 ; save them MOV HFOUT+BF.ADR,R1 ; buffer address MOV HFOUT+BF.LEN,R0 ; and length 701$: CMPNEB (R1)+,#FF,702$ ; form-feed character ? INC NFFCH ; bump counter if yes 702$: SOB R0,701$ ; loop till done UNSAVE R0,R1 ; Restore registers CMPEQ #-1,CSVAL,8$ ; No special font handling CALL CS2OUT ; Deal with 2 font output BCC 10$ ; If set, only vertical motion stuff ; is output for /CS:2 8$: BITEQ #DIASW,$INSW,9$ ; Not Diablo, use PUT$S BITEQB #FD.TTY,LSTBLK+F.RCTL,9$ ; Not a terminal MOV HFOUT+BF.ADR,$QIOD+Q.IOPL ; buffer address MOV HFOUT+BF.LEN,$QIOD+Q.IOPL+2 ; buffer length CLR $QIOD+Q.IOPL+4 ; carriage control DIR$ #$QIOD ; BR 10$ ; 9$: .ENDC PUT$S #LSTBLK,HFOUT+BF.ADR,HFOUT+BF.LEN ; output line BCC 10$ ; if cs error CMPEQB #IE.EOF,F.ERR(R0),10$ ; If EOF on output ?? skip reporting TST (SP)+ ; Clear off saved R0 and report fatal error MOV R0,-(SP) ; point to fdb DIAG OUTERR,FCS ; indicate error CALLR RUNOFF ; and leave 10$: MOV HFOUT+BF.ADR,HFOUT+BF.PTR ; Reset pointers CLR HFOUT+BF.LEN ; Reset length MOV (SP)+,R0 ; Restore R0 RETURN ; return to caller 30$: TSTEQ HGHPAG,7$ ; If here before, print last line. CLR HGHPAG ; Indicate last line pending. MOV (SP)+,R0 ; Restore R0 CALLR ENDFIL ; otherwise initiate termination .sbttl $OUT -- Output string to TI: $OUT: MOV 4(SP),$QIO+Q.IOPL+2 ; Set length BEQ 10$ ; EQ - then skip I/O MOV 2(SP),$QIO+Q.IOPL ; Set buffer pointer MOV 6(SP),$QIO+Q.IOPL+4 ; Set carriage control DIR$ #$QIO ; Perform Q-I/O 10$: MOV (SP),6(SP) ; Clear stack ADD #6,SP ; ... RETURN ; Return to caller .IF DF A$$RAP .SBTTL CS2OUT - Output according to character set CS2OUT: SAVE R0,R1,R2,R3 ; Save the registers CLR CS2VP ; Init vertical position counter MOVB CSVAL,WHLTO ; Select wheel to output BICB #^C,$CS2FL ; Clear flags except for last character ; was indicator and overflow. CMPNEB #3,WHLTO,5$ ; Not line by line wheel change MOV $CS2FL,-(SP) ; Save flags byte and current font selection BISB #P2FLG,$CS2FL ; Indicate line by line first pass MOVB CWHLN,WHLTO ; Wheel to output is the one in Diablo ; 5$: MOV CSOUT+BF.ADR,R2 ; Address of converted output line 6$: MOV HFOUT+BF.ADR,R1 ; Address of line to output MOV HFOUT+BF.LEN,R0 ; Number of characters to convert ; 10$: ; Loop back to here for next character CMPNEB #ESC,(R1),20$ ; Not an escape BISB #ESCFLG,$CS2FL ; Indicate last char was an escape BR 290$ ; Proceed to next character ; 20$: BITEQB #ESCFLG,$CS2FL,50$ ; Last not escape ? BICB #ESCFLG,$CS2FL ; Clear the condition CMPEQB #CS1,(R1),30$ ; Select wheel 1 ? CMPNEB #CS2,(R1),40$ ; Not wheel 2 either MOVB #WHEEL2,WHLNM ; Indicate wheel 2 text BR 35$ 30$: MOVB #WHEEL1,WHLNM ; Indicate wheel 1 text 35$: BR 290$ ; ; See if this character alters vertical position ; 40$: CALL CS2VPC ; Vertical position calculation BCC 290$ ; Next character BR 120$ ; Y or Z and not correct font/wheel ; ; Check if this is a printable character - if not, pass it. ; 50$: CMPB #SPC,(R1) ; <= To a space ? BGE 250$ ; Yes, move to output buffer BISB WHLNM,$CS2FL ; Indicate some text for wheel n found CMPNEB #0,WHLTO,100$ ; Not /CS:0 ; ; If /CS:0 is specified character set 2 text will be echoed ; as the translated character with a '-' overstrike as an indicator ; CMPEQB #WHEEL1,WHLNM,290$ ; Font 1 - pass the character MOVB #'-,(R2)+ ; Hyphen followed by MOVB #BS,(R2)+ ; a backspace BR 290$ ; Next character ; ; Is print wheel in Diablo same as font indicated by text ? ; 100$: CMPNEB WHLNM,WHLTO,120$ ; No match - fill with blank space CMPEQB #WHEEL1,WHLNM,290$ ; Font 1 - No translation necessary CALL CS2TR ; Translate font 2 (greek wheel) BR 300$ ; Get next character ; 120$: MOVB #SPC,(R2)+ ; fill with space TSTB (R1)+ ; Bump buffer pointer BR 300$ ; ; ; If less than space - check for , , or characters ; 250$: CMPNEB #LF,(R1),255$ ; Not line feed BITNEB #GMFLG,$CS2FL,253$ ; In graph mode ADD #DIVPL,CS2VP ; Add one line to vertical movement BR 290$ ; 253$: INC CS2VP ; Bump vertical position 1/8 line BR 290$ ; 255$: CMPNEB #CR,(R1),260$ ; Not carriage return BISB #CRFLG,$CS2FL ; Indicate a carriage return on this line BR 290$ ; 260$: CMPNEB #FF,(R1),290$ ; Not a form-feed BISB #FFFLG,$CS2FL ; Indicate form feed on this line ; 290$: MOVB (R1)+,(R2)+ ; Output = Input character BR 300$ 295$: JMP 10$ 300$: SOB R0,295$ ; Loop on # of input characters ; ; Output the buffer ; CMPNE #WHEEL2,CSVAL,304$ ; If /CS:2 not selected, output the line BITNEB #,$CS2FL,304$ ; Output if wheel 2 stuff on ; this line or formfeed on line ; or buffer overflow forced output MOV HFOUT+BF.ADR,HFOUT+BF.PTR ; Reset pointers so we can use CLR HFOUT+BF.LEN ; buffer for FOUT calls to skip lines BITEQB #CRFLG,$CS2FL,302$ ; No carriage return this line MOV #CR,R1 ; CALL FOUT ; Hopefully buffer won't overflow 302$: MOV CS2VP,R2 ; skip lines BLT 303$ ; Skip down (negative line feeds) CALL SKIPUP ; else skip up BR 3031$ ; 303$: NEG R2 ; Use positive count for reverse feeds CALL SKIPDN ; skip down 3031$: UNSAVE R0,R1,R2,R3 ; Set to return SEC ; Set carry to buffer written out on ; Return to OUTPUT RETURN ; ; 304$: SUB CSOUT+BF.ADR,R2 ; Find length of output string BITEQ #DIASW,$INSW,305$ ; Not Diablo, use PUT$S BITEQB #FD.TTY,LSTBLK+F.RCTL,305$ ; Not a terminal MOV CSOUT+BF.ADR,$QIOD+Q.IOPL ; buffer address MOV R2,$QIOD+Q.IOPL+2 ; buffer length CLR $QIOD+Q.IOPL+4 ; carriage control DIR$ #$QIOD ; BR 310$ ; 305$: PUT$S #LSTBLK,CSOUT+BF.ADR,R2 ; output line BCC 310$ ; If no error MOV R0,-(SP) ; point to fdb DIAG OUTERR,FCS ; indicate error CALLR RUNOFF ; and leave ; 310$: BITEQB #P2FLG,$CS2FL,400$ ; Not line by line wheel change BITEQB CWHLN+1,$CS2FL,390$ ; If nothing on this line for the ; other wheel, return. MOV (SP)+,$CS2FL ; Restore flags and wheel # at ; start of line. SWAB CWHLN ; Flip wheel # in Diablo to other wheel MOVB CWHLN,WHLTO ; Indicate wheel to output and ; ; Go prompt operator with bell - one ring, primary wheel ; two rings, secondary wheel ; MOV CSOUT+BF.ADR,R2 ; Put into output buffer ; ; Save space for read i/o status ; SUB #2*2,SP ; Two words MOV SP,R1 ; R1 points to the IOSB for IO.RNE ; 330$: MOVB #BEL,(R2) ; First character a bell MOVB WHLTO,R0 ; Loop count for # of times to ring 335$: MRKT$S #1,#30.,#1, ; Pause to make bells distinct BCS 340$ ; If error don't wait for event flag WTSE$S #1 ; Wait for mark time to complete 340$: QIOW$S #IO.WAL,#MSGLUN,#1,#0,,, ; Ring the bell SOB R0,335$ QIOW$S #IO.RNE,#MSGLUN,#1,#0,R1,, ; Wait for response CMPEQ #IS.ESC,(R1),330$ ; If re-echo bell(s) ADD #2*2,SP ; Clean stack ; ; Assume OK to proceed - make first character in buffer ; MOV R2,-(SP) ; SAVE START OF BUFFER ADDRESS MOVB #CR,(R2)+ JMP 6$ ; GO RE-DO THE LINE ; 390$: TST (SP)+ ; Clear stack if P2flg set but ; not doing alternate wheel 400$: UNSAVE R0,R1,R2,R3 ; Restore the registers CLC ; Clear carry RETURN ; .SBTTL CS2TR - translate font 2 (scientific wheel) ; ; An IBB selectric keyboard layout is used to map the VT52 ; keyboard. The translate table, TRTAB, changes the input characters ; to the appropriate ones so the proper character will print on the ; DIABLO general scientific print wheel. ; CS2TR: MOVB (R1)+,R3 ; Get character to translate SUB #SPC,R3 ; Forget control characters MOVB TRTAB(R3),R3 ; Get the translated character BGE 100$ ; The two special characters on ; Diablo print wheels are reached ; by Y or Z. These are ; indicated by the sign bit set in ; the translate table. MOVB #ESC,(R2)+ ; Prefix with for special code BIC #177600,R3 ; Clear sign bits ; 100$: MOVB R3,(R2)+ ; Move to output buffer RETURN ; .sbttl CS2VPC - /CS:2 vertical position calculation ; ; In order to speed up the printing of pass 2 (greek wheel), we ; keep track of vertical paper movement. Then at the end of the line ; if there are no greek symbols on the line we need only to move the ; paper the appropriate amount. Note that if BOVFLG is set we know that ; OUTPUT was called as a result of the output buffer being full, and ; a forced emptying of it is necessitated. But in this case there may ; be more on the line so horizontal spacing must be preserved. ; ; This routine is called when a character is preceded by character. ; The character must be checked for D, U, or ; graph mode in/out control and vertical counter adjusted accordingly. ; CS2VPC: CMPNEB #NHLF,(R1),10$ ; SUB #,CS2VP ; Negative half-line feed BR 200$ ; 10$: CMPNEB #PHLF,(R1),20$ ; ADD #,CS2VP ; Positive half-line feed BR 200$ ; 20$: CMPNEB #LF,(R1),40$ ; BITEQB #GMFLG,$CS2FL,30$ ; DEC CS2VP ; Graph mode BR 200$ ; 30$: SUB #DIVPL,CS2VP ; BR 200$ ; 40$: CMPNEB #GMI,(R1),50$ ; BISB #GMFLG,$CS2FL ; Indicate in graph mode BR 200$ ; 50$: CMPNEB #GMO,(R1),300$ ; Not related to vertical movement BICB #GMFLG,$CS2FL ; Clear graph mode indicator 200$: CLC ; Clear C-bit if not Y or Z RETURN 300$: CMPEQB #'Y,(R1),310$ ; Y CMPNEB #'Z,(R1),200$ ; Not Z either, return 310$: CMPEQB WHLNM,WHLTO,200$ ; Proper wheel in printer and requested ; wheel is same, return to output char. MOVB #SPC,(R2)+ ; Else make if SPC and return to ; Space over for Y or Z SEC ; RETURN ; .ENDC .SBTTL Table of contents routines ; ; table of contents routines ; TCRLF:: MOV #CR,R1 ; Get carriage return CALL TFOUT ; Output to TOC file MOV #LF,R1 ; Get line feed CALL TFOUT ; Output to TOC file RETURN ; Return to caller TFOUT:: MOVB R1,@THFOUT+BF.PTR ; store character in buffer INC THFOUT+BF.PTR ; increment buffer pointer INC THFOUT+BF.LEN ; Bump up length CMP THFOUT+BF.PTR,THFOUT+BF.END ; any more room in buffer? BEQ TOTPUT ; if eq no RETURN ; ; ; TOTPUT:: TST THFOUT+BF.LEN ; Anything in buffer BEQ TOUT3 ; if eq empty buffer TSTB TOCSPC ; should we output? BEQ TOUT3 ; no PUT$S #TOCBLK,THFOUT+BF.ADR,THFOUT+BF.LEN ; output line BCC TOUT3 ; CC - then no error MOV R0,-(SP) ; point to fdb DIAG OUTERR,FCS ; indicate error CALLR RUNOFF ; and leave TOUT3: MOV THFOUT+BF.ADR,THFOUT+BF.PTR ; Reset pointers CLR THFOUT+BF.LEN ; Reset length RETURN .END