.TITLE VAXIO ; This is the I/O setup for Bonner Lab Runoff ; VAX-VMS native version ; ; AUTHOR: Charles Sandmann 7-5-85 RICE U. CHEM ENG DEPT ; Initial version (many bugs) ; Revised: Charles Sandmann 7-25-86 Shell Oil Co. ; Fix /TT /2P and other problems ; AZ (new) ; NSWC Changes: V ; ; 13 Feb 87 - Allow all qualifier names to be longer than ; four characters. ; Add /VERSION qualifier; process it here. ; Process RNO as a VMS CLD command, allowing ; for the fact that the command line must be ; parsed twice for /2PASS. ; Allow longer command lines and file names. ; Allow .REQUIRES nested to REQSIZ levels; ; REQSIZ is defined in VAXPRE.MAR. ; Make .TOC default output file type if .RNTxx ; is the input file type. ; Delete file after printing if /SPOOLed. ; 17 Feb 87 - Add /VARIANT command qualifier. ; 18 Feb 87 - Add /DOWN command qualifier. ; 20 Feb 87 - Add code to support .TWO PASS command. ; 23 Nov 87 - Correctly process /CONTENTS and /PRINT qualifiers. ; 1 Dec 87 - Add /X9700 command qualifier. ; Fix minor bug in /PRINT. ; 22 Dec 87 - If /X9700 used, define default escape sequences ; for NSWC XEROX 9700 used via LASERTAPE program, ; and use ASCII VT instead of BS on output. ; 8 Feb 88 - Rename /TT to /PASTHRU. ; Make /DOWN not subtract from page size. ; Check for overflow moving filenames to trace ; buffer. ; Move file opening and closing to another routine ; (VAXFILES); remaining code reorganized. ; Test numeric qualifier values for validity. ; Add support for Personality Module (P$M...). ; 28 Mar 88 - Correct /VARIANT qualifier processing. ; 5 Apr 88 - Use macros to define Fortran common. ; Use TTBUF in parsing pass2 command line, in- ; stead of a special area, to save memory. ; If /EPRINT and /CRLF, have TTOUT put CR/LF ; at end of lines going to .DOC file. ; Make code for X9700 conditional. ; Move buffer used by .DEFINE DCL here so we ; can share it. ; ^ ; AZ (new) ; Data structures used to access the CLI information .CONST ;NONWRITEABLE DATA P1: .ASCID /P1/ ; PARAMETER 1 (INPUT FILE) QUALT: .ASCID /NOFF/ ; | Table of qualifiers .ASCID /HYPHENATE/ ; | .ASCID /WAIT/ ; | ORDER .ASCID /SPOOL/ ; | IS .ASCID /UC/ ; | CRITICAL !!! .ASCID /CRLF/ ; | .ASCID /EVEN/ ; | Must .ASCID /ODD/ ; | Match .ASCID /DEBUG/ ; | Order .ASCID /PASTHRU/ ; | Of the .ASCID /2PASS/ ; | Bits in .ASCID /WRNMSG/ ; | $SWTCH !!! .ASCID /EPRINT/ ; | .WORD 0 ; | End of table ; Other qualifiers (order is not critical) Q_UL: .ASCID /UL/ Q_RIGHT:.ASCID /RIGHT/ Q_PS: .ASCID /PS/ Q_PAGES:.ASCID /PAGES/ Q_NOFF: .ASCID /NOFF/ Q_APPEN:.ASCID /APPENDICES/ Q_CHAPT:.ASCID /CHAPTERS/ Q_VERSI:.ASCID /VERSION/ Q_VARIA:.ASCID /VARIANT/ Q_DOWN: .ASCID /DOWN/ Q_PRINT:.ASCID /PRINT/ .if df $X9700 ; AZ 4/88 Q_X9700:.ASCID /X9700/ X9700_: .ASCIZ /X9700/ ; For defining variant .endc ; AZ 4/88 OPRTXT: .ASCID <7>/Adjust page & press "return"/<7> ; Wake up text ERMSG1: .ASCID \%RNO-F-BADQUAL, /NOFF value must be between 16 and 127\ ERMSG2: .ASCID \%RNO-F-BADQUAL, /PS height must be between 16 and 127\ ERMSG3: .ASCID \%RNO-F-BADQUAL, /PS width must be between 16 and 198\ ERMSG4: .ASCID \%RNO-F-BADQUAL, qualifier value must be a positive integer\ ERMSG5: .ASCID \%RNO-F-IOERR, I/O error on $QIO to terminal:\ CLINE: .ASCID /$LINE/ ; For second pass SYSOUT: .ASCIZ /SYS$OUTPUT/ CR_LF: .ASCII ; AZ 4/88 .ALIGN LONG P$MARG: .LONG 1 ;Static Call frame for P$M_INPUT .LONG P$MDSC P$MDSC: .LONG IBFSZ ; Size of input buffer .LONG INPUT ; Address of input buffer ; The following three structures are for re-parsing the ; AZ 4/88 ; DCL command line at the beginning of the second pass. ; AZ 4/88 GFORN: .LONG 2 ; Static Call frame for .LONG CLINE ; CLI$GET_VALUE('$LINE',... .LONG CMDLDES DPARS: .LONG 2 ; Static Call frame for .LONG CMDLDES ; CLI$DCL_PARSE .LONG RNO_TABLES CMDLDES:.LONG 256 ; Command line descriptor .LONG TTBUF ; AZ 4/88 .VARS QUALB: .ASCID / / ;BUFFER TO HOLD QUALIFIER VALUE QUALV: .LONG ; Two locations to pass back two integer .LONG ; values for qualifiers like /CHAPT=(1,3) GVALF: .LONG 2 ;CALL FRAME FOR GETTING VALUES .LONG Q_NOFF .LONG QUALB DCLBUF::.BLKB 256 ; Buffer for .DEFINE DCL, etc. ; AZ 4/88 P$MARG2:.LONG 1 ; Static Call frame for P$M_COMMAND .LONG P$MDSC2 P$MDSC2:.LONG 0 ; Size of input buffer .LONG INPUT ; Address of input buffer OUTOPN: .LONG 0 ; Non-zero if output files open OLDSWS: .LONG 0 ; Switches from first pass X9700$::.LONG 0 TTBLK: $FAB FNM=,RAT=CR TTBLK_R:$RAB FAB=TTBLK,CTX=SYSOUT TTQIO: $QIO FUNC=IO$_WRITEVBLK!IO$M_NOFORMAT,IOSB=ISTAT ISTAT: .BLKL 2 ; IOSB status block for $QIO COMMON /TRACE/ ; AZ 4/88 TRCBUF:: .LONG ; (There is more, but this is all we need here) COMMON /RABS/ ; AZ 4/88 INRAB_: .LONG TOCRAB_: .LONG OUTRAB_: .LONG NINPUT: .LONG COMMON /P$M_/ ; AZ 4/88 P$M_SW: .BYTE P$M_SW2:: .BYTE .CODE ; The start of RUNOFF (called from module STARTN). $START:: MOVL SP,SPSAV ; SAVE INITIAL STACK POINTER $CREATE FAB=TTBLK ; OPEN SCREEN OUTPUT FOR ERRORS $CONNECT RAB=TTBLK_R PUSHAL Q_VERSI ; If RNO /VERSION is CALLS #1,G^CLI$PRESENT ; invoked, display BLBS R0,SHOVER ; the NSWC version RETURN SHOVER: MOVW NSWCVER,TTBLK_R+RAB$W_RSZ MOVL NSWCVER+4,TTBLK_R+RAB$L_RBF $PUT RAB=TTBLK_R ; Display NSWC version BLBC R0,2$ PUSHAL P1 ; Is there more to do? CALLS #1,G^CLI$PRESENT BLBC R0,1$ RETURN ; Go do the main work 1$: MOVL #1,R0 2$: $EXIT_S R0 ; Exit if no more work ; Section executed after initialization, before processing ; (called from module STARTN). Excuted once or twice ; (twice if /2PASS). RESTRT:: CLRL NINPUT ; Clear input file counter CALLS #0,G^OPEN_INPUT_FILE MOVB #1,CSMOR ; Flag we might have more files ; Now check switches and set values as necessary MOVAL QUALT,R9 ; Qualifier table location MOVL $SWTCH,R8 ; Put original contents in r8 CLRL R11 ; Switch number (0-12) 171$: PUSHAL (R9) ; Address of next qual CALLS #1,G^CLI$PRESENT ; Is qual present? BLBC R0,172$ ; If not, clear switch BBSS R11,R8,180$ ; Set the switch bit BRB 180$ 172$: BBCC R11,R8,180$ ; Clear the switch bit 180$: ADDW2 (R9),R9 ; Leap over string ADDW2 #8,R9 ; and descriptor INCL R11 ; Increment switch no. TSTW (R9) ; Past all quals? BNEQ 171$ ; Get next qual, if any MOVL R8,R9 ;MAKE COPY MOVL #,R6 ;SWITCHES THAT MUST BE CLEAR MOVL #^C,R7 ;AND COMPLEMENT BICL2 R6,R8 ;CLEAR IN ORIGINAL BICL2 R7,R9 ;CLEAR SET IN COPY BICL2 R9,R6 ;COMPLEMENT IN R6 NOW FOR CL BISL2 R6,R8 ;AND UPDATE IN R8 ; Bits are set in $SWTCH properly, so now set other values MOVL R8,$SWTCH ; FINISHED SO RESTORE IT CLR R1 ; SET TO CLEAR CASE SHIFT BITEQ #UPCSW,$SWTCH,140$ ; NO UPPER CASE REQUIRED? MOV #401,R1 ; REQUIRED UPPER 140$: MOV R1,CASE ; SET CASE BITNE #HYPSW,$SWTCH,150$ ; HYPHENATION SWITCH? MOVB #-1,$HYPSW ; SET IT PERMENANTLY OFF 150$: NOFFQ: MOVAL QUALT,GVALF+4 ;Must do this (/2PASS) CALLG GVALF,G^CLI$GET_VALUE ;FIRST CALL IS DEFAULT FF BLBC R0,RIGHTQ ;NONE THERE? MOVL #1,R11 ;HOW MANY VALUES TO GET JSB TRANSV ;TRANSLATE TO NUMBERS MOVL QUALV,R0 ;IS FIRST VALUE 0? BEQL RIGHTQ ASL R0 CMPL R0,#255. BGT 1$ CMPL R0,#MINPG BGE 2$ 1$: PUSHAQ ERMSG1 JMP ERMSG 2$: MOVL R0,LPPG ;SO PUT LINES PER PAGE RIGHTQ: MOVAL Q_RIGHT,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,ULQ JSB TRANSV TSTL QUALV BEQL ULQ MOVL QUALV,RIGSHI ULQ: MOVAL Q_UL,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,1$ MOVB QUALB+8,ULSWT 1$: MOVB #^A/_/,$ULCH ; Underline char as underscore MOVB ULSWT,R0 ; Get underline char BEQ PSQ ; No underline switch CMPNEB #^A/L/,R0,2$ ; NOT Line mode ? COMB $ULMSW ; SET Line mode BR PSQ 2$: CMPNEB #^A/S/,R0,3$ ; NOT SIMULATE MODE? INCB $ULMSW ; SET SIMULATE SWITCH MOVB #^A/-/,$ULCH ; Set underline char to hyphen BR PSQ 3$: CMPNEB #^A/N/,R0,PSQ ; Not No mode ? COMB $UNLSW ; SET NO UNDERLINE SWITCH ; If none of the above, default is backspace (B) mode. ; RNO.CLD guarantees that one of (B,L,N,S) is present. PSQ: MOVL #2,R11 MOVAL Q_PS,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,PAGESQ JSB TRANSV MOVL QUALV,R0 ; Check lines-per-page BEQL PAGESQ ASL R0 CMPL R0,#MINPG BLT 1$ CMPL R0,#255. BLE 2$ 1$: PUSHAQ ERMSG2 JMP ERMSG 2$: MOVL R0,PNLPG MOVL R0,NLPG MOVL QUALV+4,R0 ; Check columns-per-line BEQL PAGESQ CMPL R0,#MINLN BLT 3$ CMPL R0,#OBFSZ-2 BLE 4$ 3$: PUSHAQ ERMSG3 JMP ERMSG 4$: MOVL R0,PRMRG MOVL R0,RMARG PAGESQ: MOVAL Q_PAGES,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,APPENQ JSB TRANSV TSTL QUALV BEQL APPENQ MOVL QUALV,LOWPAG TSTL QUALV+4 BEQL APPENQ MOVL QUALV+4,HGHPAG APPENQ: MOVAL Q_APPEN,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,CHAPTQ JSB TRANSV TSTL QUALV BEQL CHAPTQ MOVL QUALV,LOWAPN TSTL QUALV+4 BEQL CHAPTQ MOVL QUALV+4,HGHAPN CHAPTQ: MOVAL Q_CHAPT,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,VARIAQ JSB TRANSV TSTL QUALV BEQL VARIAQ MOVL QUALV,LOWCHP TSTL QUALV+4 BEQL VARIAQ MOVL QUALV+4,HGHCHP VARIAQ: PUSHAL INLAB ; Process /VARIANT PUSHL #IFMAX ; AZ 3/88 PUSHL SP PUSHAL 4(SP) PUSHAL Q_VARIA CALLS #3,G^CLI$GET_VALUE ADDL3 (SP)+,(SP)+,R2 ; R2 = One byte past end BLBC R0,DOWNQ ; No string? CLRB (R2) ; Chock end of string CALL QVARNT BR VARIAQ DOWNQ: MOVL #1,R11 ; Process /DOWN MOVAL Q_DOWN,GVALF+4 CALLG GVALF,G^CLI$GET_VALUE BLBC R0,PRINTQ JSB TRANSV TSTL QUALV BLEQ PRINTQ MOVL QUALV,R3 CALL CVSP ; Convert to half spacing MOVL R3,DWNSHI PRINTQ: PUSHAL Q_PRINT ; Process /PRINT CALLS #1,G^CLI$PRESENT BLBC R0,PRINT2 ; AZ 4/88 BIS #SPLSW,$SWTCH PRINT2: ; AZ 4/88 ; AZ 4/88 .if df $X9700 ; AZ 4/88 X9700Q: PUSHAL Q_X9700 CALLS #1,G^CLI$PRESENT MOVL R0,X9700$ BLBC R0,1$ MOVC3 #6,X9700_,INLAB CALL QVARNT ; Define "X9700" Variant MOVL #ESCBF,R3 CALL CLRBF MOVL #XEROX,R2 CALL DEFESC ; Define X9700 Escapes MOVB #11,BKSP$ ; Replace ASCII BS with VT .endc ; AZ 4/88 1$: JMP GO ; Routine to translate the ascii strings to numbers TRANSV: PUSHL #3 PUSHL #4 PUSHAL QUALV PUSHAL QUALB CALLS #4,G^OTS$CVT_TI_L ;CONVERT NUMBER IN BUFF BLBS R0,3$ ;BAD VALUE ? 2$: PUSHAQ ERMSG4 JMP ERMSG 3$: TSTL QUALV BLSS 2$ CMPL #1,R11 BEQL 1$ CALLG GVALF,G^CLI$GET_VALUE ;SECOND VALUE, CALL AGAIN BLBC R0,4$ ;NONE THERE? PUSHL #3 PUSHL #4 PUSHAL QUALV+4 PUSHAL QUALB CALLS #4,G^OTS$CVT_TI_L ;CONVERT NUMBER IN BUFF BLBC R0,2$ ;BAD VALUE ? TSTL QUALV+4 BLSS 2$ 1$: RSB 4$: CLRL QUALV+4 RSB ; Setup pass params GO: TSTL OUTOPN BEQL 10$ ; Branch if not 2nd pass and .TWP used CLRB $OUTSW BISL3 OLDSWS,#PASSW,$SWTCH BR 30$ 10$: BITEQ #PASSW,$SWTCH,20$ ; Single pass only? MOVB $OUTSW,R2 ; Current output switch COM R2 ; Reverse switch BIC #^C,R2 ; Clear extra bits MOVB R2,$OUTSW ; New switch BNE 30$ ; output? ; Section to open output file 20$: PUSHAW TTQIO+8 PUSHAL $SWTCH CALLS #1,G^OPEN_OUTPUT_FILE ; section to open TOC file if necessary CALLS #0,OPEN_CONTENTS_FILE BLBC R0,25$ ; Branch if no TOC file CLRB $TOCSW MOVAL #^A/.TOC/,R1 MOVL #4,R2 CALL OUTTOC 25$: MOVL $SWTCH,OLDSWS ; Save first pass switches INCL OUTOPN ; Save indication that files are open ; Now finish up details and go process 30$: MOV HFOUT,HFOUT+8 ; SET CHAR COUNTER IN OUT BUFF MOV #OUBUF,HFOUT+4 ; AND ADDRESS MOV BUFADD,R3 ; GET INPUT BUFFER CALL CLRBF ; Get first line JMP LGO ; AND INTO MAIN LOOP ; Source file input routine; gets one line from current source file FIN:: MOV BUFADD,BUFAD ; Reset subst stack to input buffer CLRB SUBSTK ; At bottom of substitute stack TSTB EOFSW BEQL 2$ BRW 40$ 2$: MOVAL INPUT,R10 TSTB P$M_SW BEQL 4$ CALLG P$MARG,G^P$M_INPUT MOVL R0,R11 ; Length of line P$M_INPUT is supplying BNEQ 21$ ; Read a line if P$M_INPUT returned zero 4$: MOVL INRAB_,R11 ; GET ADDRESS OF RAB MOVL R10,RAB$L_UBF(R11) MOVW #IBFSZ,RAB$W_USZ(R11) 1$: INC @TRCBUF ; Next line number BEQ 1$ ; Zero ? $GET RAB=(R11) BLBS R0,20$ CMPL R0,#RMS$_EOF BEQL 10$ JMP IOERR1 10$: CALLS #0,G^CLOSE_INPUT_FILE BLBS R0,30$ ; MORE LUNS IN STACK? BRW 40$ ; NO MORE 20$: MOVZWL RAB$W_RSZ(R11),R11 ; R11 = Line length 21$: MOVL R11,P$MDSC2 ; Save length for P$M commands ADDL2 #2,R11 ; We add CR/LF MOVL BUFADD,R1 SUBL3 #1,R10,BF.ADD(R1) MOVL R11,BF.CNT(R1) MOVL R11,BF.MAX(R1) CLRL BF.FUL(R1) CLRL BF.SPC(R1) CLRL BF.HED(R1) CLRL BF.VSP(R1) MOVB #LF,-(R10)[R11] MOVB #CR,-(R10)[R11] BITEQ #DEBSW,$SWTCH,30$; No debug ? CALL TTINOU ; Output whole input line 30$: CLC RETURN 40$: MOVB #-1,EOFSW ; SET EOF MOV R3,R11 MOV BUFADD,R3 ; Set nothing in buffer CALL CLRBF ; Clear it MOV R11,R3 MOV #LF,R1 ; AND OUTPUT END OF LINE SEC RETURN ; The end of an input file has been encountered. ENDFIL:: TSTB CSMOR BEQL 10$ ; Branch if this was the final input file CALLS #0,G^OPEN_INPUT_FILE BLBC R0,5$ ; Branch if we don't have another input file CLRB EOFSW MOV BUFADD,R3 CALL CLRBF JMP LGO ; Continue with the next input file 5$: CLRB CSMOR ; Finished with all input files MOVB #-1,EOFSW JMP LGO ; Go terminate things for this pass ; We are finished with the final input file. 10$: BITEQB #SW.DIS,$OUTSW,20$ ; Branch if not in first of two passes ; This is the start of the second pass CALLG GFORN,G^CLI$GET_VALUE ; Get the original DCL command line BLBC R0,15$ CALLG DPARS,G^CLI$DCL_PARSE ; Parse the command line BLBC R0,15$ JMP RUNOFF ; Start second pass at top again 15$: $EXIT_S R0 20$: $EXIT_S ; This is the normal exit point for RNO ; REQUIRE command REQUR:: CALL GETLIT BCC 30$ JMP ILCM 30$: PUSHL R0 ; Build descriptor (addr) PUSHL R1 ; Build descriptor (len) PUSHAL (SP) ; Address of descriptor CALLS #3,G^OPEN_REQUIRE_FILE BLBS R0,RDONE MOV #20.,R0 ; Too many nested .REQUIRES JMP ILCMA ; REQUIRE BINARY command 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 MOVL INRAB_,R6 ; Save current lun 10$: CALL FIN ; Get input line CMPNE INRAB_,R6,RDONE ; No longer in required file ? MOV BUFADD,R3 ; Buffer address SUB #2,BF.MAX(R3) ; Skip CR/LF SUB #2,BF.CNT(R3) ; Skip CR/LF 20$: CALL GBYT ; Get single byte of input BCS 30$ ; No more this buffer CALL FOUT ; Output it BR 20$ ; And more ... 30$: CALL OUTPUT ; End the line BR 10$ RDONE: MOV BUFADD,R3 ; Current buffer address CALL CLRBF ; CLEAR THE BUFFER MOV #CR,R1 ; GET CARRIAGE RET TO SIGNAL END OF LINE CALL PBYT ; INTO BUFFER MOV #LF,R1 ; PUT LF INTO BUFFER AS END LINE CALL PBYT ; INTO BUFFER CALL BEGBF ; SET TO TOP OF BUFFER RETURN ; Commands parsed in the personality module: ; OD command P$MCMD::CALL CCIN CMPEQB R1,#CR,10$ CMPEQB R1,#LF,10$ BR P$MCMD 10$: MOV R1,-(SP) ; Save last character CALLG P$MARG2,G^P$M_COMMAND MOV (SP)+,R1 TSTL R0 BEQL 20$ JMP ILCMA 20$: RETURN ; Output one character; R1 = character FOUT:: TSTNEB $OUTSW,10$ ; No output? MOVB R1,@HFOUT+4 ; Store character in output buffer INC HFOUT+4 ; Increment buffer pointer DEC HFOUT+8 ; Any more room in buffer? BEQ OUTPUT ; If zero, no more room 10$: RETURN ; This routine outputs the current contents of the line buffer (VMS) OUTPUT::SUBL3 HFOUT+8,HFOUT,R10 ; R10 = Line length BNE 10$ ; Not empty ? BITNE #CRSW,$SWTCH,30$ ; CRLF output? 10$: TSTNEB $OUTSW,20$ ; No output? BITEQ #TTSW,$SWTCH,15$ ; Not terminal output? MOVAL TTQIO,R0 ; Output is to terminal via $QIO MOVAL OUBUF,28(R0) MOVL R10,32(R0) $QIOW_G (R0) BLBC R0,IOERR2 ; $QIO error? MOVZWL ISTAT,R0 BLBC R0,IOERR2 BR 20$ 15$: MOVL OUTRAB_,R11 ; Output is to .DOC file via RMS MOVW R10,RAB$W_RSZ(R11) MOVAL OUBUF,RAB$L_RBF(R11) $PUT RAB=(R11) BLBC R0,IOERR1 20$: MOV HFOUT,HFOUT+8 ; Reset output buffer MOV #OUBUF,HFOUT+4 30$: RETURN IOERR1: PUSHL R11 PUSHL R0 CALLS #2,G^IO_ERROR IOERR2: MOVL R0,R10 PUSHAQ ERMSG5 CALLS #1,G^LIB$PUT_OUTPUT $EXIT_S R10 ; Output table of contents ; R1 = string address ; R2 = string length OUTTOC::MOVL TOCRAB_,R11 MOVL R1,RAB$L_RBF(R11) MOVW R2,RAB$W_RSZ(R11) $PUT RAB=(R11) BLBC R0,IOERR1 RETURN ; Terminal I/O Routines ; CALL EROUT ; ; Input: R0 = ASCIZ string address ; ; CALL TTOUT ; ; Input: R0 = string address ; R1 = string length EROUT:: MOV R0,-(SP) 1$: MOV (SP)+,R0 ; String address MOV R0,R1 ; DITTO 10$: CMPNEB (R1),#CR,20$ ; Not carriage return ? INC R1 MOV R1,-(SP) ; Next sub string INC (SP) ; Skip CR,LF MOV #1$,-(SP) ; Next return BR 30$ 20$: TSTB (R1)+ ; FIND END OF STRING BNE 10$ ; NOT FOUND 30$: SUB R0,R1 ; LENGTH OF STRING DEC R1 TTOUT:: TST R1 ; Check string length BLE 3$ ; None ? BITNEB #SW.DIS,$OUTSW,1$ ; No output file ? BITEQ #EROSW,$SWTCH,1$ ; Output to terminal ? MOVL OUTRAB_,R11 BITEQ #CRSW,$SWTCH,2$ ; Not /CRLF file ; AZ 4/88 MOVL R1,R6 ; AZ 4/88 PUSHR #^M ; AZ 4/88 MOVC3 R1,(R0),DCLBUF ; AZ 4/88 MOVW CR_LF,(R3) ; AZ 4/88 POPR #^M ; AZ 4/88 MOVAL DCLBUF,R0 ; AZ 4/88 ADDL3 R6,#2,R1 ; AZ 4/88 BR 2$ 1$: MOVAL TTBLK_R,R11 2$: MOVW R1,RAB$W_RSZ(R11) MOVL R0,RAB$L_RBF(R11) $PUT RAB=(R11) BLBS R0,3$ JMP IOERR1 3$: RETURN ; TTINOU types out the whole input line TTINOU::MOVAL INPUT,R0 MOVL P$MDSC2,R1 JMP TTOUT ; Wait for operator to adjust forms OPRWAT:: BITEQ #PAUSW,$SWTCH,10$ ; DON'T WAIT FOR NEW PAPER? PUSHAL OPRTXT PUSHAL QUALB CALLS #2,G^LIB$GET_INPUT 10$: RETURN ; RETURN ERMSG: CALLS #1,G^LIB$PUT_OUTPUT ; Put out a diagnostic message $EXIT_S #^x10000004 ; and abort ;$DEBUG=1 ; Remove ";" to activate for debugging .if df $DEBUG ; The following debugging routines are designed to ouput ; useful information when debugging new features ; ; If $DEBUG is defined each input line is automatically output. ; In addition a call to CHROUT will output the character in R1. ; Control characters are enclosed in <>, CHROUT::TSTW QIOB+8 ;IS CHAN IN BLK? BNEQ 1$ ;IF YES CONTINUE $ASSIGN_S CHAN=QIOB+8,DEVNAM=TTDES 1$: MOVL R1,TEMP MOVZBL R1,R1 ;CLEAR EXTRA BITS BIC #177600,R1 ; clear extra bits CMPNE R1,#CR,10$ ; NOT CARRIAGE RET MOVL #4.,QIOB+32 MOVAL CRM,QIOB+28 $QIOW_G QIOB BR 100$ 10$: CMPNE R1,#LF,20$ ; NOT LINE FEED MOVL #4.,QIOB+32 MOVAL LFM,QIOB+28 $QIOW_G QIOB BR 100$ 20$: CMPNE R1,#TAB,30$ MOVL #4.,QIOB+32 MOVAL TBM,QIOB+28 $QIOW_G QIOB BR 100$ 30$: CMP R1,#32. ; PRINTABLE? (> SPACE) BGE 40$ ; YES MOVB R1,CTM+1 ; NO BISB #64.,CTM+1 MOVL #3.,QIOB+32 MOVAL CTM,QIOB+28 $QIOW_G QIOB BR 100$ 40$: MOVL #1.,QIOB+32 MOVAL TEMP,QIOB+28 $QIOW_G QIOB 100$: MOVL TEMP,R1 ; Restore RETURN .VARS TEMP: .LONG 0 CRM: .ASCII // LFM: .ASCII // TBM: .ASCII // CTM: .ASCII /<@>/ SPACE: .ASCII / / QIOB: $QIO FUNC=IO$_WRITEVBLK!IO$M_NOFORMAT TTDES: .ASCID /TT:/ .CODE .endc .ENTRY LBYTE,^M<> CVTBL @4(AP),R0 RET .ENTRY ZBYTE,^M<> MOVZBL @4(AP),R0 RET .ENTRY LONGWD,^M<> MOVL @4(AP),R0 RET .ENTRY SET_LONGWD,^M<> MOVL @8(AP),@4(AP) RET .ENTRY SET_BYTE,^M<> MOVB @8(AP),@4(AP) RET .END