; IIII NN NN PPPPPPP UU UU TTTTTTTT ; II NNN NN PP PP UU UU TT ; II NNNN NN PP PP UU UU TT ; II NN NN NN PPPPPPP UU UU TT ; II NN NN NN PP UU UU TT ; II NN NNNN PP UU UU TT ; IIII NN NNN PP UUUUU TT .TITLE INPUT ASCII PAPER TAPE PROGRAM .IDENT /V3.02/ .ENABL LC .PSECT ; Task to input an ASCII paper tape from the high speed reader. ; Carriage return/line feeds are deleted and output is in standard ; RSX11-M file format (unsequenced records). Parity may be checked ; for odd, even, set, or clear. A longitudinal checksum created by ; the complementary punch program and despooler is also tested. ; A copy may be spooled to the lineprinter. ; ; Run program as: ; ; >INP /switches,/switches ... ; ; Switches:- ; PY:EVen * Check even parity (default for ASCII tape) ; PY:ODd * Check odd parity (default for EIA tape) ; PY:CLear Check parity clear ; PY:SEt Check parity set ; PY:NO No parity check ; -PY Equivalent to PY:NO ; ET: Tape ends with control/ (default is ET:Z) * ; -ET No tape terminator ; SP Spool a copy of to the PRINT queue ; -SP * Don't print a copy of ; -AP * Close o/p file at end of 1st tape ; AP Append successive tapes to o/p file ; LE: Specify maximum O/P file line length (default 132.) ; LA Latch current switch setting ; -LA * Don't latch switches ; GO Don't prompt at terminal for tape to be loaded ; -GO * Issue prompt at terminal: "Load PR:, press a key" ; ER:n Abandon input after n parity errors (default n=50.) ; -MU * Don't convert input from Murray (Telex) code to ASCII ; MU Input tape is in Murray code. Convert output to ASCII ; -EIA * Don't convert input from EIA RS-244 format ; EIA Convert input from EIA RS-244 format to ASCII ; FO * Make file owner the UIC in which it is put ; -FO Make file owner the UIC under which INP is running ; ; * marks default settings ; Defaults may be changed at task build time by GBLPAT's to:- ; DEFSW Switch word (for meanings of bits see SWTAB): ; DEFEB End byte ; DEFPY Parity (see PYVAL:) ; DEFLE Max. record length ; DEFTYP Filetype (1 radix-50 word) ; DEFERR Error count ; ; ; If parity checking is called for, errors are reported by printing ; the whole line containing errors, with *'s under the erroneous ; characters. (This may be confused by non-printing characters.) ; Null and erase characters are not checked for parity and are always ; ignored. The O/P file has parity cleared on all bytes, including ; those for which errors were detected. ; If an end-of-tape byte is specified, a longitudinal checksum block ; is expected, and will be checked. ; ; Assemble as: ; >MAC INPUT=INPUT ; ; Task build as: ; TKB>INPUT/CP/-FP=INPUT ; TKB>/ ; ENTER OPTIONS: ; TKB>UNITS=5 ; TKB>ASG=TI:1:5,SY:2,PR:3 ; TKB>ACTFIL=3 ; TKB>STACK=48 ; TKB>TASK=...INP ; TKB>LIBR=FCSRES:RO ; TKB>/ ; ; Modifications record: ; ; 1.05 Recognise the GO switch only on the first file on the line. ; Accept a command line which specifies just a device (e.g. TI:). ; Default filetype to that of previous file on line, and ; allow it to be latched. ; Treat a blank filename as "just checking" -- not an error. ; ; 1.06 Change QIO's back to QIOW's. ; Exit with status. ; Correct trap for illegal wildcard specification. ; Name spool only output file "INPUT.LST" for identification in queue. ; Ring bell if any parity errors. ; Abandon after MAXERR errors on any file (default 50.), changed by /ER:n. ; ; V2.01 24-June-81 CJD ; Don't print rubbish at end-of-file if no EOT character. ; Treat a lone line feed as line terminator. ; Don't treat FF as line terminator. ; Set file owner to file UIC if given, and implement /FO switch. ; Implement Murray-ASCII code conversion (/MU switch). ; Change PR: buffer size to 64. bytes to match actual device buffer. ; Use run-time macros QIOW$R and QIOW$M where appropriate. ; Exit without status if exit with doesn't work (not supported). ; ; V3.01 5-Jul-82 CJD ; Add EIA conversion option. ; Change error messages to lower case for RSX V4. ; Use $EXST and .PRINT subroutine calls, as these are in Syslib, ; instead of EXST$/EXIT$S and PRINT$ macros, which aren't. ; ; V3.02 1-Apr-86 CJD ; Use IO.RPB instead of IO.RLB, for VAX PCDRIV (IO.RLB stops on EOF). ; Remove calls to QIOW$M/QIOW$R. .PAGE .MCALL FDBDF$,FDRC$A,FDOP$A,NMBLK$,FINIT$,FSRSZ$,FDAT$A .MCALL CSI$,CSI$1,CSI$2,GCML$,GCMLB$,GCMLD$,CSI$SW,CSI$SV,CSI$ND .MCALL QIOW$,QIOW$C,QIOW$S,OPEN$W,PUT$,DIR$,CLOSE$ .GLOBL $CBTA,DEFSW,DEFEB,DEFPY,DEFLE,DEFTYP,DEFERR,.ASCPP,.WFOWN BUFSIZ=64. ; PR: Buffer size ; ASCII chars ENQ=5 ; Who are you? BEL=7 HT=11 LF=12 CR=15 DEL=177 ; EIA chars: EIFEED=20 ; Tape feed EIADEL=77 ; Delete ; Murray shift chars. LETSHF=37 ; Select letters shift FIGSHF=33 ; Select figures shift START: FINIT$ ; (Re)initialise FCS BR RSTART ; Start properly ESTART: MOV #EX$ERR,EXSTAT ; Restart here on cmd line error RSTART: TSTB SWWRD ; Latched switches? BMI GETCOM ; Continue if so MOV #ETBIT!LEBIT!PYBIT!FOBIT,SWWRD ; Else set default switches DEFSW==.-4 CLR SWTGVN ; Switches mentioned flag MOV #EVEN,PYVAL ; Default even parity check DEFPY==.-4 MOVB #'Z,ENDBYT ; Default end ^Z DEFEB==.-4 MOV #132.,LINLEN ; 132. bytes max line lth DEFLE==.-4 MOV #^RTXT,DEFOUT+N.FTYP ; Default filetype .TXT DEFTYP==.-4 MOV #50.,MAXERR ; Maximum no of parity errors allowed DEFERR==.-4 GETCOM: CLR %1 ; Set %1 to zero JSR PC,.WFOWN ; to reset file owner to terminal UIC GCML$ #GC ; Get command line BCC CMDIN ; Branch if OK CMPB #GE.EOF,GC+G.ERR ; Control/Z? BNE ILLCOM ; No, must be an error MOV EXSTAT,%0 ; Yes, load exit status JMP $EXST ; and exit, with status if supported ILLCOM: JSR %5,ERRMES ; Else print error COMERR ; "Command error" BR ESTART ; Set error flag and try again CMDIN: CSI$1 #CSIBLK,GC+G.CMLD+2,GC+G.CMLD ; Pre-process command BCS ILLCOM ; Branch if error BITB #CS.EQU,CSIBLK+C.STAT ; No '=' BNE ILLCOM ; Allowed MOVB #-1,FILENO ; Flag 1st file on line NXTFIL: INCB FILENO ; Set file position flag CSI$2 #CSIBLK,OUTPUT,#SWTAB ; Get next output file BCS SWTERR ; Carry set = "Illegal switch" (probably) BIS CSIBLK+C.MKW1,SWTGVN ; OR in switches mentioned word BIT #EIABIT,SWWRD ; EIA bit set? BEQ FILIN ; No, continue MOVB #377,ENDBYT ; Yes, make "end byte" one which can't occur BIT #PYBIT,SWTGVN ; Has parity been mentioned? BNE 10$ ; Yes, use what was supplied MOV #ODD,PYVAL ; No, default to odd 10$: TST SWWRD ; Make sure we don't have Murray switch set too BPL FILIN ; MUBIT is bit 15, so OK if +ve SWTERR: JSR %5,ERRMES ; Else error ILLSWT ; "Illegal switch" JESTRT: BR ESTART ; Try again ; Unless just spooling or parity checking, there must be a filename. ; If spooling only, open temporary file INPUT.LST . ; In any case, byte NOOP signifies whether (<>0) or not (=0) ; there is to be any output. FILIN: MOVB #-1,NOOP ; Assume no output BITB #CS.WLD,CSIBLK+C.STAT ; Wildcards not allowed BNE ILLCOM ; -- command line error if any BITB #CS.NMF!CS.DVF,CSIBLK+C.STAT ; Is there a filename or device? BNE OPNFIL ; Yes, go open it BIT #SPBIT,SWWRD ; Just spooling? BNE SPLING ; Yes, open INPUT.LST CMPB CSIBLK+C.MKW1,#LABIT ; Just set/clear latch bit? BNE OPNOK ; No, just checking JMP NEWFIL ; Yes, don't read tape, get another file ; If spooling only, open INPUT.LST using dataset descriptor. SPLING: OPEN$W #OUTPUT,,#LPDSD ; Open file BCC FILOPN ; OK if carry clear OPNERR: JSR %5,ERRMES ; Else another error OPNFLD ; "Open failed" BR JESTRT ; Keep trying ; Open file fetched by CSI. OPNFIL: CLR -(SP) ; Make space on stack for binary UIC BIT #FOBIT,SWWRD ; But is /-FO given? BEQ 5$ ; Yes, cancel owner word whatever happens BITB #CS.DIF,CSIBLK+C.STAT ; Directory specified? BEQ 10$ ; No, keep current file owner MOV #CSIBLK+C.DIRD,%2 ; Yes, address ASCII directory specifier MOV SP,%3 ; Result will be on stack JSR PC,.ASCPP ; Convert ASCII UIC to binary 5$: MOV @SP,%1 ; Load binary UIC (or 0) JSR PC,.WFOWN ; Set up file owner word 10$: TST (SP)+ ; Purge stack OPEN$W #OUTPUT,,#CSIBLK+C.DSDS ; Open output file named BCS OPNERR ; Branch if error MOV OUTPUT+F.FNB+N.FTYP,DEFOUT+N.FTYP ; Copy filetype for next default FILOPN: CLRB NOOP ; Clear no output flag OPNOK: BIT #LEBIT,SWWRD ; Defining length? BNE ADJEBT ; No skip next section CMP LINLEN,#132. ; LINLEN too big? BHI LENILL ; Yes, illegal TST LINLEN ; 0 is wrong too BNE ADJEBT ; Branch if <>0 LENILL: JSR %5,ERRMES ; Else error ILLLEN ; "Illegal length" MOV #132.,LINLEN ; Set to 132. ; Adjust ENDBYT to be the end-of-tape character, if any, null if not. ADJEBT: BIT #ETBIT,SWWRD ; End byte given? BNE EBT ; Branch if so CLRB ENDBYT ; Else store null BR SETPAR ; And continue EBT: BIT #MUBIT!EIABIT,SWWRD ; End byte given. If ASCII BNE SETPAR ; i.e. not Murray or EIA BICB #340,ENDBYT ; Then set letter->control/letter ; Make sure parity switch is legal, put a JSR address in location PARCHK ; so that a parity check can be made by JSR @PARCHK. ; This location is also loaded with the address of the Murray-ASCII conversion ; routine if the /MU switch is on (in which case parity is ignored). SETPAR: MOV #MURASC,%0 ; Suppose Murray-ASCII conversion reqd TST SWWRD ; But is it? (MUBIT is bit 15) BMI INITRD ; Yes, start reading MOV #NOCHK,%0 ; No, default no parity check CMP #NO,PYVAL ; PY:NO? BEQ INITRD ; Branch if no check BIT #PYBIT,SWWRD ; -PY? BEQ INITRD ; = PY:NO MOV #CHKEVN,%0 ; PY:EVen? CMP #EVEN,PYVAL BEQ INITRD ; Branch if so MOV #CHKCLR,%0 ; PY:CLear? CMP #CLEAR,PYVAL BEQ INITRD ; Branch if so MOV #CHKSET,%0 ; PY:SEt CMP #SET,PYVAL BEQ INITRD ; Branch if so MOV #CHKODD,%0 ; PY:ODd? CMP #ODD,PYVAL BEQ INITRD ; Must be one of them JSR %5,ERRMES ; Else error: ILLPAR ; "Illegal parity" MOV #NOCHK,%0 ; Set for no check BIC #PYBIT,SWWRD ; Set switch word bit MOV #NO,PYVAL ; and parity value ; Initialise for read. INITRD: MOV %0,PARCHK ; Set up selected parity test CLR ERRCNT ; Clear error count TSTB FILENO ; First file on line? BNE APPEND ; No, don't check GO bit BIT #GOBIT,SWWRD ; Tape ready to go? BNE SETCSM ; Then bypass prompt ; Print prompt message on TI: and wait for a key to be pressed. ; Escape terminates an appending sequence. APPEND: MOV #IO.RPR!TF.RNE,TIQIOW+Q.IOFN ; Prompt "Load PR:, press a key" MOV #1,TIQIOW+Q.IOPL+2 ; and get 1 char MOV #INBUF,TIQIOW+Q.IOPL ; to INBUF DIR$ #TIQIOW MOV #IO.WLB,TIQIOW+Q.IOFN ; Reset DPB CMP #IS.ESC,IOSTAT ; Input byte. Escape? BNE SETCSM ; No, continue JMP EOF ; Yes, end file SETCSM: MOV #CSUM,%5 ; Address c/sum area .REPT 4 ; Clear all 8 checksums CLR (%5)+ .ENDR MOV #INBUF+BUFSIZ+1.,INPTR ; Set I/P buffer pointers MOV #INBUF+BUFSIZ.,BUFEND ; To force a read CLRB IOSTAT ; Clear an old e-o-f flag CLRB NOBLNK ; Clear suppress blank lines CLRB LSTCHR ; Clear line terminator character flag QIOW$C IO.ATT,3,3 ; Attach PR0:, unit 3 ; If Murray tape being read, skip leader of nulls or letter shift chars. ; If EIA, skip leading nulls. BIT #MUBIT!EIABIT,SWWRD ; Murray or EIA tape? BEQ READ ; No, start reading CLRB FIGS ; Yes, start in letters shift 10$: JSR PC,INCH ; Read character BCS EOFR ; Trap end-of-tape BEQ 10$ ; Ignore nulls TST SWWRD ; Murray? BPL 20$ ; No, EIA, that's all we test here CMPB %0,#LETSHF ; Murray letter shift? BEQ 10$ ; Yes, ignore that too 20$: DEC INPTR ; No, something else, unread it ; Read PR: forming lines of LINLEN characters maximum and transferring ; to O/P file. READ: CLRB ERRFLG ; Clear error flag on this line MOV #OUTBUF,%3 ; Address O/P buffer MOV #ERRBUF,%2 ; & parallel error buffer MOV (PC)+,(%2)+ ; Start error buffer .BYTE CR,LF ; CR/LF MOV LINLEN,%4 ; Load line length NEXTCH: JSR PC,INCH ; Get next char to %0 BCS EOFR ; Branch if e-o-t MOV %0,%1 ; Make a copy in %1 BIT #EIABIT,SWWRD ; EIA tape? BEQ 5$ ; No, branch TST %1 ; Yes, null = end of data? BNE 4$ ; No, go check for rubout/feeder TSTB ENDBYT ; Yes, are we expecting a checksum BEQ EOFE ; Yes, go get it, following immediately JMP EOT ; No, don't look for it 4$: BIC #^C77,%1 ; No, strip parity bits CMP %1,#EIADEL ; Rubout? BEQ NEXTCH ; Yes, ignore it CMP %1,#EIFEED ; Tape feed? BEQ NEXTCH ; Ignore that too BR 20$ ; Process everything else 5$: BIC #177600,%1 ; With parity clear BNE 10$ ; Branch if not null TST SWWRD ; Null, is this Murray tape? BPL NEXTCH ; No, ignore nulls on ASCII input BR GETCSM ; Yes, null flags start of checksum 10$: CMPB #DEL,%1 ; ASCII rubout? BEQ NEXTCH ; Yes, ignore it ; Add this character to checksums if there will be an end byte. TSTB ENDBYT ; End byte? BEQ NOCSUM ; No if null 20$: MOV #CSUM,%5 ; Else address c/sum bytes MOV %0,-(SP) ; Save character MOV #8.,-(SP) ; Set counter on stack CSUMLP: ROLB %0 ; Shift out 1 bit at a time ADCB (%5)+ ; Adding to each count DEC @SP ; Dec bit counter BGT CSUMLP ; Branch until 8 done TST (SP)+ ; Purge stack MOV (SP)+,%0 ; Restore char NOCSUM: JSR PC,@PARCHK ; Check parity on %0 (or Murray convert) BVS NEXTCH ; Ignore Murray case change character BCC NOERR ; Branch if parity OK MARKER: CMP ERRCNT,MAXERR ; Too many errors? BHI EOT ; Yes, give up ; Character has parity error, put a * in error flag buffer. MOVB #'*,(%2)+ ; Copy the * CMPB #HT,%0 ; Was char a tab? BNE STORE ; No, go store it ERRTAB: MOVB %0,(%2)+ ; If tab, put one in error buffer BR STORET ; To keep in step ; No error, put a space or tab in error buffer for printing chars, ; Nothing for non-printing. NOERR: CMPB %0,ENDBYT ; End byte? BEQ EOFC ; Branch if so CMPB #HT,%0 ; Tab? BEQ ERRTAB ; Put it in ERRBUF CMPB %0,#<' > ; Printing? BLT STORE ; No, do nothing MOVB #' ,(%2)+ ; Else store a space ; Copy character to O/P buffer unless CR or LF. ; End line if this is CR or LF preceded by something which isn't. ; Ignore CR preceded immediately by LF which acted as a terminator, and ; vice versa. STORE: CMPB %0,#LF ; Line feed? BNE 10$ ; No, go see if CR CMPB LSTCHR,#CR ; Yes, was last character a terminating CR? BEQ 20$ ; Yes, ignore this following LF BNE EOL ; No, this is end-of-line 10$: CMPB #CR,%0 ; CR? BNE STORET ; No, store anything else CMPB LSTCHR,#LF ; Yes, did last line end at LF? BNE EOL ; No, this is end-of-line 20$: CLRB LSTCHR ; Cancel line terminated marker BR NEXTCH ; and ignore 2nd char of pair STORET: CLRB LSTCHR ; Store anything not ending line MOVB %0,(%3)+ ; Store character in buffer DEC %4 ; Dec counter BGT NEXTCH ; Branch back for LINLEN chars (Too far for SOB) JSR PC,OUTLIN ; Too many chars, print the line INCB NOBLNK ; Flag forced termination BR READ ; Start a new line ; End-of-line. Send it to file & go for another. EOL: MOVB %0,LSTCHR ; Remember what the terminator was JSR PC,OUTLIN ; Print the line BR READ ; Go for next ; End-of-tape routines: ; EOFR entered if we were expecting an end byte which didn't come ; EOFC entered if end byte found -- test checksum ; EOT at end-of-tape, append another or exit ; EOF at end-of-file, close it and look for another EOFR: TSTB ENDBYT ; Should there be an end byte? BEQ EOT ; OK if not JSR %5,ERRMES ; Else error: NOEOT ; "No EOT char" BR EOT ; End tape anyway EOFC: JSR PC,INCH ; ASCII checksum starts with 377 BCS CSUMAB ; Error if end-of-tape INCB %0 ; Test for 377 by INC BNE EOFC ; Gives 000. Branch if so ; EIA checksum enters here. Checksum starts in very next byte. EOFE: MOV #8.,%4 ; ASCII and EIA tape have 8 checksum bits MOV #CSUM,%5 ; Load address of store BR GETCS ; Join common code ; Murray checksum enters here. Start char detected above, 5 bits only GETCSM: MOV #5.,%4 ; Computed 5-byte c/sum MOV #CSUM+3,%5 ; Only last 5 bytes GETCS: JSR PC,INCH ; Get c/sum byte BCS CSUMAB ; Error if e-o-t TST SWWRD ; 5-hole tape? BPL 10$ ; No, keep all 8 bits BICB #^C37,@%5 ; Yes, strip top 3 bits of checksum 10$: CMPB %0,(%5)+ ; Same as stored value? BEQ 20$ ; OK if so MOV %4,%0 ; Else copy counter ADD #'0-1,%0 ; Adjust to ASCII digit MOVB %0,CSUMBT-1 ; Copy to message JSR %5,ERRMES ; "Checksum error, bit n" CSUMER 20$: SOB %4,GETCS ; Loop for all bits BR EOT ; Then end of tape ; Checksum block absent or incomplete. CSUMAB: JSR %5,ERRMES ; Error message CSMABS ; "No c/sum" EOT: INCB NOBLNK ; Set flag for no blank line JSR PC,OUTLIN ; PUT$ last line QIOW$C IO.DET,3,3 ; Detach reader BIT #APBIT,SWWRD ; Appending? BEQ EOF ; No, end file JMP APPEND ; Yes, go do it ; At end of file, print no of parity/conversion errors if checking for them. EOF: CMP PARCHK,#NOCHK ; No check? BEQ EOF0 ; Just end file CMP PARCHK,#MURASC ; Murray? BEQ EOF0 ; No parity if so MOV #ERRREP+2,%0 ; Else address count string MOVB #' ,(%0)+ ; Put in a space MOV ERRCNT,%1 ; Get error count BEQ 10$ ; Leave space if no errors MOVB #BEL,-1(%0) ; Else put in a bell char 10$: MOV #23012,%2 ; Format mask -- 4 dec digits, spc fill JSR PC,$CBTA ; And put decimal no of errors into messaga MOVB #'s,ERRORS-1 ; Assume we had more than one DEC ERRCNT ; But was there only 1? BNE 20$ ; No, keep the plural CLRB ERRORS-1 ; Yes, make it singular 20$: JSR %5,MESAGE ; Print message ERRREP ; " nnnn. error(s)" ; Close file and/or spool a copy. EOF0: TSTB NOOP ; Any O/P? BNE NEWFIL ; No, just start a new file MOV #OUTPUT,%0 ; Load address of O/P FDB BIT #SPBIT,SWWRD ; Test spool bit BEQ EOF1 ; Just close if clear JSR PC,.PRINT ; Else spool to printer BCC NEWFIL ; Ok if spool accepted JSR %5,ERRMES ; Else error: SPLERR ; "Spool failed" EOF1: CLOSE$ ; Close O/P file ; Check for a new tape. NEWFIL: BITB #CS.MOR,CSIBLK+C.STAT ; Another on same line? BNE .+6 JMP RSTART ; Restart if not JMP NXTFIL ; Else go get it .PAGE .SBTTL SUBROUTINES ; Type an error message on TI:, unit 5. ERRMES: CMP EXSTAT,#EX$SUC ; Are we still flagging success? BNE MESAGE ; No, leave current error flag CLR EXSTAT ; Yes, set to 0=EX$WAR MESAGE: MOV #ERRSTM,TIQIOW+Q.IOPL ; Start "INP -- " MOV #9.,TIQIOW+Q.IOPL+2 DIR$ #TIQIOW ; Entry type to type a general message stored as: ;