.TITLE HPX .IDENT /V1.08/ .ENABL LC .NLIST BEX,CND,ME,TOC ; HHH HHH PPPPPPPPPPP XXX XXX ; HHH HHH PPPPPPPPPPPP XXX XXX ; HHH HHH PPP PPP XXX XXX ; HHH HHH PPP PPP XXX XXX ; HHHHHHHHHHHH PPPPPPPPPPPP XXXXX ; HHHHHHHHHHHH PPPPPPPPPPP XXX ; HHH HHH PPP XXXXX ; HHH HHH PPP XXX XXX ; HHH HHH PPP XXX XXX ; HHH HHH PPP XXX XXX ; HHH HHH PPP XXX XXX ; ; Author: C J Doran ; Sira Ltd., South Hill, Chislehurst, Kent, BR7 5EH, England ; Tel: +44 1 467 2636 Telex: 896649 Fax: +44 1 467 6515 ; ;+ ; Transfer data files from PDP-11 to HP2648a terminal display, tape cartridges, ; or printer. ; ; Command syntax: ; ; Copy disk file(s) to terminal device(s): ; >HPX =[/AS][/BI] ; ; Copy from terminal device to disk file: ; >HPX [/SP][/AP]=[/AS][/BI] ; ; Compare device with disk file: ; >HPX [/SP]=[/AS][/BI]/CMP ; ; Position tape only: ; >HPX [/RT:n][/LT:n] ; ; where s are: ; /DI = screen display ; /LT:n = file n on left tape (default n = next file) ; unsigned n is absolute, signed is relative to current position ; /LT:A = append to end of last file on tape ; /LT:C = condition and rewind tape ; /LT:E = start a new file after last file on tape ; /LT:R = rewind tape ; /LT:C = condition and rewind tape ; /RT:x = as above, for right tape ; /PR = printer ; ; other switches are: ; /AS = ASCII data to be transferred = /-BI [default] ; /BI = binary transfer mode required = /-AS ; /FO = flag output file as having FORTRAN carriage-control ; /SP = spool output file ; /AP = append output to existing file ; /LA = latch current switch settings for next command line ; /WBR = use write-backspace-read mode [default = /-WBR = don't] ; /CMP = this is a compare operation [default = /-CMP = copy mode] ; /LI = list file(s) copied if wildcards or >1 input file [default] ; /-LI = don't list file(s), even if wildcards etc. ; /EL = cancel char set and emphasis at end of ASCII lines [default /-EL] ;- ; Assemble as: ; >MAC HPX=LB:[11,10]RSXMC/PA:1,SY:[g,m]HPX ; ; Note: under VMS, LB:[11,10]RSXMC.MAC should be replaced by a file containing: ; V$$AX1=nn ; R$$EIS=0 ; S$$TOP=0 ; where nn gives VAX-11 RSX version no, w/o 'V' or '.', so V2.1 is 21 etc. ; ; Task-build as: ; >TKB ; TKB>HPX/-FP,HPX=HPX,WLDCRD ; TKB>LL:[1,24]PIPUTL/LB,LB:[1,1]ANSLIB/DL ; TKB>/ ; Enter options: ; TKB>LIBR=FCSRES:RO ! if/as appropriate ; TKB>UNITS=3 ; TKB>ACTFIL=3 ; TKB>ASG=TI:1:3,SY:2 ; TKB>STACK=48 ; TKB>PRI=70 ; TKB>TASK=...HPX ; TKB>// ; ; Where WLDCRD is the wildcard directory/filename handler from the DECUS ; Spring 1981 RSX-11M SIG tape, directory [300,110] (also LIBKIT [7,315]), ; by Jim Downward (?), and PIPUTL.OLB is the PIP utilities library from the ; RSX-11M/M-PLUS source kit. These give a more sensible wildcard handling than ; that provided by the .PARSE/.FIND logic described in the I/O Operations manual, ; basically as PIP's (but no wild characters or embedded wildcards). ; ; MODIFICATIONS RECORD ; ==================== ; V1.02 11-May-83 CJD ; Allow escape sequences in ASCII transfers by using read-with-special- ; terminators to end line on CR only. ; Put IO.KIL into abort trap, so that ASTX doesn't return to a wait for ; I/O state. ; Poll device(s) busy bit while waiting for tape positioning, instead of ; just accepting S/F reply, which seems to be returned immediately by ; some position commands, and presumably therefore just means "command ; accepted", not "command executed". ; Reset caps lock and auto LF on exit. ; Support wildcard input files and list if > 1 being copied. ; Don't hang on transferring zero-length binary records. ; ; V1.03 13-Apr-84 CJD ; Correct odd address trap on /LT:junk etc., due to missing # at ILLVAL: ; ; V1.04 17-Aug-84 CJD ; Assume M$$EIS, A$$BRT, and S$$TOP for 11-M-PLUS -- these symbols aren't ; defined in RSXMC.MAC, but facilities are always available. ; ; V1.05 7-Oct-85 CJD ; Change M$$EIS conditional to R$$EIS. (I wish DEC would decide what to call it!) ; Do an ENQ/ACK handshake before each terminal QIO to make sure that the ; terminal is ready to receive it. Should cure bug that commands were ; missed at high speeds or on slow interfaces (DLV-11's). ; Reset caps lock etc before each command line or edit. ; Give explicit messages about missing tapes or printer, or write-protected ; tapes instead of leaving it to "device error F". ; Add /xT:Condition option. ; Correct bug on M-PLUS, linked with FCSFSL, that abort trap does an ; illegal instruction -- must set PS to user mode. ; Need to end ASCII tape records with CR+LF. LF alone is enough for ; read-back and local copy to screen, but local copy to Cadet printer ; doesn't do CR's unless they're really there. ; IO.RTT doesn't disable ^O recognition, essential for transferring screen ; displays, so do ASCII reads by binary QIOs instead. Needs to have ; terminal set up to TC.RPA so that typed-ahead characters don't get ; interpreted. ; Add /EL = cancel special character set/emphasis at end of ASCII line. ; Correct display of compare message when there is only 1 difference. ; ; Modifications for VMS (VAX-11 RSX V1.0 AME), conditionalised on ; V$$AX1=10:- ; Can't always use IO.RPR because AME doesn't support the TF.BIN ; sub-function required for binary transfers, or recognise parameter 6, ; giving an LF after any prompt which ends CR. ; Timeout returns IE.TMO instead of IS.TMO. ; The Abort request trap (SREA$) is not supported. ; Terminal to binary file must be done by IO.RPB, as TF.RAL doesn't ; suppress all control code translation. To prevent parity stripping, ; the terminal must be SET /EIGHT_BIT -- there is no way to do this ; from a program (SF.SMC TC.8BC is unsupported). ; ; V1.06 CJD 4-Dec-85 ; Turn off Tektronix graphics mode on startup. ; Show messages in VMS format if V$$AX1 <> 0. ; Conditionalise for VAX-11 RSX V2.0 (V$$AX1=20):- ; Bugs in the TF.RAL sub-function cause prompt of IO.RPR to be ; suppressed, and timeout to be ignored. Fortunately, TF.RAL is ; redundant in the AME, since it is necessary to set TC.BIN anyway. ; Timeout now correctly returns IS.TMO. ; ; V1.07 CJD 13-Aug-86 ; Display file version no in decimal if VAX/VMS, and add LF at end of ; filename instead of beginning (must be beginning for RSX). ; Use SF.SMC/SF.GMC to set and restore some terminal modes on entry ; and exit. ; Take advantage of RSX AME V2.1 features (V$$AX1=21):- ; Eliminate use of physical I/O (IO.RPB and IO.WPB), and consequent ; need for PHY_IO privileges, by using IO.RAL/TF.RAL with new ; TC.PTH/TC.TSY set options. ; Use new TC.8BC support to modify terminal on binary reads, so that it ; no longer has to be SET /EIGHT_BIT permanently. ; ; V1.08 CJD 5-Oct-87 ; Conditionalise usage of TC.RAT to allow for bugs in VAX-11 RSX versions: ; In V2.1 and V2.2, the bit was reversed from "real" RSX for both SF.GMC ; and SF.SMC functions. In V2.3, they fixed SF.SMC, but left SF.GMC ; wrong! .IF DF R$$MPL R$$EIS=0 ; 11-M-PLUS only runs on machines with EIS A$$BRT=0 ; 11-M-PLUS always supports SREA$ S$$TOP=0 ; and STOP$ .ENDC .IIF NDF V$$AX1, V$$AX1=0 ; Not VAX-11 AME .IF NE V$$AX1***** .ERROR V$$AX1 ; NO SUPPORT FOR THIS VERSION OF VAX-11 RSX .ENDC .MCALL FCSMC$,QIOW$,DIR$,OPEN$,ASTX$S,WSIG$S,SREA$,MRKT$,WTSE$,STSE$ .MCALL CSI$,CSI$1,CSI$2,GCML$,GCMLB$,GCMLD$,CSI$SW,CSI$SV,CSI$ND,QIOW$C FCSMC$ CSI$ GCMLD$ ; Local macro to call subroutine checking QIO status .MACRO CHKQIO STATUS JSR R5,CHKQIO .WORD IS.'STATUS .ENDM CHKQIO ; ASCII characters: ENQ=5 ACK=6 LF=12 CR=15 DC1=21 ESC=33 RS=36 SPACE=40 DOLLAR='$ PLUS='+ ; Boolean literals TRUE=-1 FALSE=0 ; I/O timeout intervals, in 10 sec units. STATMO=1 ; Status -- time for reply to get terminal type or enq/ack POSTMO=6 ; Position -- time to find a file RWTMO=3 ; Read/write -- time to transfer a record CONTMO=12. ; Condition -- can take 2 min if tape must rewind first ; Following macros give FCS -$R type support for QIOW$ device I/O: ; MOVB$M -- MOVE byte X to ADD, if X not blank. CLRB ADD if X=#0 .MACRO MOVB$M X,ADD .IIF B,X,.MEXIT .IF IDN,,<#0> CLRB ADD .IFF MOVB X,ADD .ENDC .ENDM MOVB$M ; MOVB$M -- MOVE word X to ADD, if X not blank. CLR ADD if X=#0 .MACRO MOVW$M X,ADD .IIF B,X,.MEXIT .IF IDN,,<#0> CLR ADD .IFF MOV X,ADD .ENDC .ENDM MOVW$M ; QIOW$M -- Just modify QIOW DPB .MACRO QIOW$M DPB,FNC,LUN,EFN,PRI,IOST,AST,PRMLST .IF B,DPB .ERROR ; MISSING ARGUMENT .IFF MOVW$M FNC,DPB+Q.IOFN MOVW$M LUN,DPB+Q.IOLU MOVB$M EFN,DPB+Q.IOEF MOVB$M PRI,DPB+Q.IOPR MOVW$M IOST,DPB+Q.IOSB MOVW$M AST,DPB+Q.IOAE .IF NB, $$$PRM=0 .IRP P, MOVW$M P,DPB+Q.IOPL+$$$PRM $$$PRM=$$$PRM+2 .IIF LE 12.-$$$PRM .MEXIT .ENDR .ENDC .ENDC .ENDM QIOW$M ; QIOW$R -- Modify QIOW DPB and issue QIO. .MACRO QIOW$R DPB,FNC,LUN,EFN,PRI,IOST,AST,PRMLST,ERR QIOW$M DPB,FNC,LUN,EFN,PRI,IOST,AST, DIR$ #DPB,ERR .ENDM QIOW$R .PSECT CODE,I,RO ; Return here on error, before asking for another command. CMDERR: QIOW$M ERQIOW,,,,,,,<#CMDERM,#CMDERL> ; Set up error message FATAL: DIR$ #ESTART ; Print start of error message DIR$ #ERQIOW ; and finish MOV #EX$ERR,EXSTAT ; No, set error exit status and continue ; Return here for a new command line. NXTCMD: MOV SPSAVE,SP ; Reset SP after possible error exception CLRB LSTCTL ; Clear list multiple files flag TSTB SWWRD ; Switches latched? BMI GETCMD ; Yes, don't reset defaults MOV #ELBIT,SWWRD ; Set default switches = /AS/-EL MOV #^RTXT,DEFNAM+N.FTYP ; Default output filetype .TXT MOV #^RTXT,DN+N.FTYP ; Default input filetype .TXT GETCMD: QIOW$R TOQIOW,#IO.WAL,,,,,,<#RESDVM,#RESDVL,#0> ; Make caps lock etc match buttons GCML$ #GC ; Get command line BCC CMDIN ; Branch if OK CMPB GC+G.ERR,#GE.EOF ; Control/Z? BNE CMDERR ; No, command error ; Task exit required. Reset caps lock, auto LF, and block mode status to values ; read on entry. Hopefully, this will reset them as the latching keys actually ; are, but since there doesn't seems to be any way to read the keys, only the ; device status, this can't be guaranteed. (Daren't use the soft reset command ; because it marks the tapes.) EXIT: MOV EXSTAT,%0 ; Load exit status EXIT0: QIOW$R TOQIOW,,,,,,,<#RESDVM,#RESDVL> ; Make caps lock etc match buttons EXIT1: QIOW$R SFQIOW,,,,,,,<#USERTT,#USERTL> ; Reset terminal characteristics QIOW$R SFQIOW,#IO.DET ; Finished with TI: JMP $EXST ; Exit with status (if supported), without if not CMDIN: QIOW$R TOQIOW,,,,,,,<#SETDVM,#SETDVL> ; Set caps lock etc to HPX needs CSI$1 #CSIBLK,GC+G.CMLD+2,GC+G.CMLD ; Pre-process command line BCS CMDERR ; Trap syntax error TST CSIBLK+C.CMLD ; Blank command line? BEQ GETCMD ; Yes, fetch another BIC #LTBIT!RTBIT!DIBIT!PRBIT,SWWRD ; Clear device spec bits CLRB RTFILE ; Zero /RT CLRB LTFILE ; and /LT switch value areas CLRB TOTERM ; Assume transfer is from terminal to file MOV #COMAND+2,%1 ; Address command string after initial ESC & MOVB #'p,(%1)+ ; Load a 'p' for device controls CSI$2 ,OUTPUT,#SWTAB ; Fetch output file and/or switches BCS CMDERJ ; Trap error again BITB #CS.MOR!CS.WLD,CSIBLK+C.STAT ; Only 1 output file, and no wildcards BNE CMDERJ ; Error if >1 file or wildcards ; Copy output file dataset descriptor, since CSIBLK's is destroyed by CSI$2 ; call for input device. MOV #CSIBLK+C.DSDS,%2 ; Address O/P file dataset descriptor MOV #6,%3 ; of 6 words MOV #TEMP&177776,%5 ; Address save area 15$: MOV (%2)+,(%5)+ ; Copy SOB %3,15$ BITB #CS.DVF!CS.DIF!CS.NMF,CSIBLK+C.STAT ; Any filename? BNE 16$ ; Yes, leave flag clear for terminal to file COMB TOTERM ; No, set flag -ve for file to terminal BITB #CS.EQU,CSIBLK+C.STAT ; But if no '=' BNE 16$ NEGB TOTERM ; Set it to +1 for position only 16$: MOV SWWRD,%2 ; Fetch switch word ; If printer output is required, make sure printer is attached. MOVB #'4,R4 ; Load printer code BIT #PRBIT,R2 ; Is printer required? BEQ 17$ ; No, don't test it JSR PC,GETSTA ; Get printer status RORB BUFFER+6 ; See if it's there BCS 17$ ; OK if so QIOW$M ERQIOW,,,,,,,<#NOPRIM,#NOPRIL> ; Else load "No printer" message JMP WARN ; Do error processing ; If either tape drive is in use, make sure there is a tape present. If TOTERM ; is set, that tape must be write-enabled. 17$: CMPB -(R4),-(R4) ; Set code of right tape ('2') MOV #RTFILE,R5 BIT #RTBIT,R2 ; If doing RH tape JSR PC,CHKTAP ; Check drive DECB R4 ; Switch to LH tape MOV #LTFILE,R5 BIT #LTBIT,R2 ; If doing LH tape JSR PC,CHKTAP ; Check LH tape TSTB TOTERM ; Tape position only? BLE 20$ ; No, branch JSR PC,VALID ; Yes, validate file-control strings JMP POSITN ; Just do tape-positioning 20$: BEQ FSTINP ; Skip device setup if from terminal (TOTERM=0) BIC #^C,%2 ; device bits BNE SETINP ; Must be at least one SDVERR: QIOW$M ERQIOW,,,,,,,<#SDVERM,#SDVERL> ; Error: no or too many devices JMP FATAL ; Print message and try again SETINP: MOV #4,%3 ; up to 4 "to" devices ; Put terminal "to" device(s) in set-up string. (R4 = '0' from above CHKTAPs.) 20$: ASR %2 ; Shift out a bit BCC 30$ ; Not set, go try next MOVB %4,(%1)+ ; Copy device code digit MOVB #'d,(%1)+ ; and postfix d 30$: INCB %4 ; Set digit for next possible device SOB %3,20$ ; Repeat until all found ; First input file. FSTINP: MOV %1,-(SP) ; Save device select pointer TSTB TOTERM ; Must be an '=' in this case BGT CMDERJ ; "Command error" if not ; Fetch input file or "from" device switches. CSI$2 ,INPUT ; Parse for input BCS CMDERJ ; Trap error JSR PC,VALID ; Validate tape file strings, return only if OK FDOP$R #FDB,,,,#FO.RD ; Set %0->FDB, and assume file input FDRC$R ,,#BUFFER ; to BUFFER TSTB TOTERM ; Are we writing to terminal? BEQ SETTTF ; No, go set up for terminal to file BIT #CMPBIT,SWWRD ; Yes, /CMP is illegal in this case BNE CMDERJ ; Command error BITB #CS.DVF!CS.DIF!CS.NMF,CSIBLK+C.STAT ; Must have a filename on RHS BEQ CMDERJ ; Error if not MOVB CSIBLK+C.STAT,LSTCTL ; OK, save CS.WLD!CS.MOR for list control JSR PC,SETWLD ; Start wildcard processing if required MOV (SP)+,%1 ; Restore file select string pointer BR SETDEV ; No "from" device to do CMDERJ: JMP CMDERR ; "Command error" (syntax) if not ; Set up for terminal to file. SETTTF: BITB #CS.DVF!CS.DIF!CS.NMF,CSIBLK+C.STAT ; Filename on RHS? BNE CMDERJ ; Error if so -- must be device only ; Put "from" device specification in setup command string. MOVB #'1,%4 ; Load code of first device: left tape MOV SWWRD,%2 ; Fetch switch word BIC #^C,%2 ; (note "from" can't be printer) BEQ SDVERR ; Must be at least 1 bit set 10$: ASR %2 ; Shift out a bit BCS 20$ ; Branch if found INCB %4 ; Set digit for next possible device BR 10$ ; Repeat until one found 20$: BNE SDVERR ; May be only one "from" device MOV (SP)+,%1 ; Restore file select string pointer MOVB %4,(%1)+ ; Copy device code digit MOVB #'s,(%1)+ ; and postfix s FDOP$R ,,#TEMP&177776 ; Open using saved dataset descriptor MOV SWWRD,%2 ; Get full switch word again BIT #CMPBIT,%2 ; Compare operation? BEQ 30$ ; No, open file for write FDRC$R ,,#CMPBUF ; Yes, open for read, to CMPBUF BR SETDEV ; Join common code 30$: FDOP$R ,,,,#FO.APD ; No, open for write (assume append mode) BIT #APBIT,%2 ; But is it append or write? BNE SETDEV ; Branch if append (c-c is as for old file) FDOP$R ,,,,#FO.WRT ; No, change to write new file mode FDAT$R ,,#0 ; Assume embedded carriage-control TST %2 ; if binary mode? BMI SETDEV ; Yes, done FDAT$R ,,#FD.CR ; ASCII, assume CR's and LF's to be added BIT #FOBIT,%2 ; But is FORTRAN carriage-control required? BEQ SETDEV ; No, done FDAT$R ,,#FD.FTN ; Yes, flag FORTRAN control ; Complete terminal device specification string and send it. SETDEV: BICB #40,-(%1) ; Make last letter UC as command terminator SUB #COMAND-1,%1 ; Compute length of device spec command string JSR PC,ENQACK ; Make sure terminal is ready QIOW$R TOQIOW,,,,,,,<#COMAND,%1> ; Set up devices CHKQIO SUC ; QIO must succeed ; Position tape(s). /xT:E and /xT:A require a search for e-o-d, followed by ; write file mark if /xT:E. For others, copy switch value string as {relative} ; file number. POSITN: MOVB #'0,%5 ; Load rewind command code JSR PC,TAPEOP ; Issue command(s) CMPB (R5)+,(R5)+ ; Set space files command ('2') JSR PC,TAPEOP ; To set starting files on tapes if reqd INCB %5 ; Change to '3' = seek e-o-d JSR PC,TAPEOP ; Required for /xT:A and /xT:E INCB R5 ; Change to '4 JSR PC,TAPEOP ; for /xT:C MOV #100000!'5,%5 ; Finally, '5', with conditional flag JSR PC,TAPEOP ; to terminate previous file with mark if /xT:E TSTB TOTERM ; Is there an '='? BLE OPNFIL ; Yes, go open file to start copy/compare JMP NXTCMD ; No, that's all there is to do ; Open file, mode already set up in FDB above. OPNWAI: WSIG$S ; Come back and wait here if no pool OPNFIL: OPEN$ #FDB ; Open file in mode set up above BCC START ; OK, start copy/compare CMPB FDB+F.ERR,#IE.NOD ; Failed due to no pool? BEQ OPNWAI ; Yes, just go back and wait for some OPNERR: MOV #OPNERN,%0 ; No, fatal, address error number location MOV #EX$ERR,EXSTAT ; Set ERROR exit status QIOW$M ERQIOW,,,,,,,<#OPNERM> ; Load error message JMP FILERN ; Put error number in string and send message ; Start copy/compare. Four modes: terminal-file/file-terminal, ASCII/binary. ; Print name of file we are about to copy if there could be more than one, ; especially wildcards, or /LI is set. START: MOV #BUFFER,%0 ; Point to I/O buffer QIOW$M TOQIOW,,,,,,,<%0> ; Where name will be stored BIT #NLBIT!CMPBIT,SWWRD ; Listing suppressed or compare? BNE 100$ ; Yes, don't display filename BITB #CS.WLD!CS.MOR,LSTCTL ; > 1 file, or wildcard operation? BEQ 100$ ; Don't print filename if not .IIF EQ V$$AX1, MOVB #LF,(R0)+ ; Have a new line MOV FDB+F.DSPT,%3 ; Get address of dataset descriptor MOV 4(%3),%4 ; Get length of directory descriptor BEQ 5$ ; Default if there isn't one -- don't print MOV 6(%3),%1 ; There is, get its address 3$: MOVB (%1)+,(%0)+ ; and copy it SOB %4,3$ 5$: MOV #3,%4 ; 3 words of filename MOV #FDB+F.FNAM,%3 ; in Radix-50 from filename block 10$: MOV (%3)+,%1 ; Load a word BEQ 20$ ; Don't output if just spaces JSR PC,$C5TA ; Else convert to ASCII 20$: DEC %4 ; Decrement counter BGT 10$ ; Repeat if more of name BMI 40$ ; -ve = done type 30$: CMPB -(%0),#SPACE ; End of name, trim trailing blanks BEQ 30$ INC %0 ; Point to end of name MOVB #'.,(%0)+ ; Put in a '.' BR 10$ ; and repeat once for filetype 40$: MOVB #';,(%0)+ ; Finally, prefix version no with ';' MOV (%3)+,%1 ; Fetch it CLR %2 ; Suppress blanks .IF EQ V$$AX1 JSR PC,$CBOMG ; in octal magnitude .IFF JSR PC,$CBDMG ; in decimal magnitude .IFTF MOVB #CR,(R0)+ ; Append CR .IFF MOVB #LF,(R0)+ ; LF .ENDC SUB #BUFFER,%0 ; Compute length of string QIOW$R TOQIOW,,,,,,,<,%0> ; and display filename 100$: MOV #FDB,%0 ; Reload FDB pointer MOV FDB+F.FTYP,DEFNAM+N.FTYP ; Copy filetype for next output file MOV FDB+F.FTYP,DN+N.FTYP ; and input file MOV SWWRD,%2 ; Put switch word in a register MOV #COMAND+3,%1 ; Address command string (already starts ESC&p) TSTB TOTERM ; Terminal to file mode? BNE F.TO.T ; No, file to terminal JMP T.TO.F ; Yes, branch F.TO.T: BIT #LTBIT!RTBIT,%2 ; Writing to tape? BEQ 7$ ; No, don't need to check MOVB #'0,R4 ; Yes, load code for LH tape ; Turn on write-backspave-read mode if required. MOV #COMAND+3,%1 ; Address command buffer MOVB #'9,(%1)+ ; Assume write-backspace-read mode on reqd BIT #WBRBIT,%2 ; But is it? BNE 5$ ; Yes, branch MOVB #'1,-1(%1) ; No, turn it off MOVB #'0,(%1)+ ; with control mode 10 5$: QIOW$M TIQIOW,,,,,,,<,,#STATMO> ; Short timeout for set status JSR PC,TAPEOC ; Complete command and send it. 7$: QIOW$M TIQIOW,#IO.RLB!TF.RNE!TF.TMO,,,,,,<,,#RWTMO> ; and replies TST %2 ; Binary or ASCII? BMI F.TO.B ; Branch if binary ; ASCII transfer from file(s) to terminal. QIOW$M TOQIOW,,,,,,,<#WRTSEQ> ; Prompt is data preceded by esc&pW QIOW$M TIQIOW,,,,,,,<,,#STATMO> ; Set receive timeout 10$: GET$ ; Get record BCS GETERR ; Trap error MOV FDB+F.NRBD,%2 ; Fetch count of bytes read MOVB #CR,BUFFER(%2) ; Terminate with CR MOVB #LF,BUFFER+1(%2) ; and LF MOVB #DC1,BUFFER+2(%2) ; and DC1 to enable reply ADD #,%2 ; Include extra bytes of prefix + suffix QIOW$M TOQIOW,,,,,,,<,%2> ; Send data as prompt JSR PC,SNDCMD ; Receive reply, returning only if it works BR 10$ ; Back for next line ; Binary transfer from file(s) to terminal. F.TO.B: QIOW$M TIQIOW,,,,,,,<,,#RWTMO> ; Set read/write timeout 1$: GET$ #FDB ; Get record BCS GETERR ; Trap error MOV FDB+F.NRBD,%5 ; Get byte count BNE 10$ ; Branch if non-zero CLRB BUFFER ; Zero-length records can't be written to terminal INC %5 ; Write 1 null instead 10$: MOV %5,%1 ; Make a copy of count MOV #COMAND+3,%0 ; Put in buffer as a CLR %2 ; zero-suppressed JSR PC,$CBDMG ; ASCII string MOVB #'W,(%0)+ ; Terminated with 'W' SUB #COMAND,%0 ; Compute length of prompt QIOW$R TOQIOW,,,,,,,<#COMAND,%0> ; Send it CHKQIO SUC ; QIO should succeed JSR PC,ENQACK ; Make sure device is ready MOVB #DC1,BUFFER(%5) ; Send DC1 after data to trigger status reply INC %5 ; Include it in byte count QIOW$M TOQIOW,,,,,,,<#BUFFER,%5> ; Send data + trigger JSR PC,SNDCMD ; Get reply, returning only if successful BR 1$ ; Repeat ; Error from GET$. See if just e-o-f, or something more serious. GETERR: CMPB FDB+F.ERR,#IE.EOF ; Error, just e-o-f? BEQ 5$ ; Yes, continue JMP FIOERR ; No, report I/O error 5$: JSR PC,CLOSPL ; End of input file. Close it, spooling if reqd QIOW$M TIQIOW,,,,,,,<#BUFFER> ; Reset buffer pointer QIOW$M TOQIOW,,,,,,,<#COMAND> ; and prompt string MOVB #'5,%5 ; Load write end-of-file control code JSR PC,TAPEOP ; Write tape mark(s) TSTB ENFLAG ; Wildcard processing active? BEQ 3$ ; No, look for another file JSR PC,ENEXT ; Yes, look for next wildcard file BCC 40$ ; Go open it if there is one CMPB FDB+F.ERR,#IE.NSF ; Failed because there isn't? BEQ 3$ ; Yes, go see if more JMP OPNERR ; No, file open failed 3$: BITB #CS.MOR,CSIBLK+C.STAT ; Any more inputs? BNE 10$ ; Yes, go look for one JMP NXTCMD ; No, go get another command line 10$: CSI$2 #CSIBLK,,#NXINSW ; Fetch next input file. Only /LA/AS/BI allowed BCC 30$ ; Continue if OK JMP CMDERR ; CSI failed, say "Command error" 30$: JSR PC,SETWLD ; Initialise wildcard processing if required 40$: JMP OPNFIL ; Go open next file ; Terminal to file mode. Only one file to write or compare. T.TO.F: CLR DIFCNT ; Zero difference count BIT #DIBIT,%2 ; Is source the display? BEQ 10$ ; No, no setup prompt required QIOW$R TOQIOW,,,,,,,<#RESDVM,#RESDVL> ; Yes, make caps lock etc match buttons QIOW$R ERQIOW,#IO.RPR!TF.RNE,,,,,,<#TEMP,#1> ; Print edit prompt QIOW$M ERQIOW,#IO.CCO ; Reset QIO DPB QIOW$R TOQIOW,,,,,,,<#SETDVM,#SETDVL> ; Set caps lock etc for HPX CHKQIO SUC 10$: QIOW$M TIQIOW,,,,,,,<,#256.,#RWTMO> ; Set buffer size & timeout count .IF NE V$$AX1 QIOW$R SFQIOW,,,,,,,<#SETRPA> ; Set read-pass-all (thru in V2.1 ff) CHKQIO SUC .ENDC TST %2 ; Binary or ASCII? BMI B.TO.F ; Branch if binary ; ASCII transfer from terminal to file. ; We need to allow for embedded escape sequences, CR, etc., but there isn't a ; way to ask long the line is. Simplistically, we could read 1 character at a time ; until CR and there are no more characters in the type-ahead buffer. However, ; this involves a lot of QIOs, so the method is to ask how many characters are in ; the type-ahead buffer, read them, and repeat until the answer is 0, and the ; last character in the buffer was CR. ; ; For "real" RSX, we must set read-pass-all here so that anything that goes ; into the typeahead buffer (e.g. ^O) isn't interpreted by the terminal driver. ; VAX-11 RSX needs read-pass-all for both binary and ASCII modes, so it gets ; set above. "Real" RSX mustn't have it set for binary, as the byte count fetch ; is ASCII. .IIF LE V$$AX1-10,A.TO.F: QIOW$M TIQIOW,#IO.RPB!TF.RNE!TF.TMO!TF.RAL ; Set read function .IIF EQ V$$AX1-20,A.TO.F: QIOW$M TIQIOW,#IO.RPB!TF.RNE!TF.TMO ; Set read function .IIF GE V$$AX1-21,A.TO.F: QIOW$M TIQIOW,#IO.RAL!TF.RNE!TF.TMO ; Set read function QIOW$M TOQIOW,,,,,,,<#ASCTRM,#ASCTRL> ; Set for trigger output .IF EQ V$$AX1 QIOW$R SFQIOW,,,,,,,<#SETRPA> ; Set read-pass-all CHKQIO SUC .ENDC QIOW$M SFQIOW,,,,,,,<#FLUSH> ; Set to read type-ahead count .IIF NE V$$AX1, QIOW$M SFQIOW,,,,,,,<,#2> ; 2-byte buffer 10$: JSR PC,ENQACK ; Make sure terminal is ready DIR$ #TOQIOW ; Output trigger CHKQIO SUC ; Check for success MOV #BUFFER,%1 ; Address start of buffer 14$: QIOW$M TIQIOW,,,,,,,<,#1> ; Get single char 1st time 15$: QIOW$R TIQIOW,,,,,,, ; Read character(s) CHKQIO SUC ; Check QIO for read terminated OK on count ADD IOSTAT+2,R1 ; Advance buffer pointer QIOW$R SFQIOW,#SF.GMC ; See if any more in type-ahead buffer QIOW$M SFQIOW,#SF.SMC ; Reset DPB CHKQIO SUC ; Test for success MOVB FLUSH+1,TIQIOW+Q.IOPL+2 ; Copy type-ahead count BNE 15$ ; <>0, go get more CMPB -1(R1),#CR ; =0, end of line? BNE 14$ ; No, get another 1 character or timeout MOV R1,R2 ; Yes, end of line (probably) SUB #BUFFER+1,R2 ; Compute length CMP R2,#1 ; Single-character line? BNE 20$ ; No, real, even if it starts RS CMPB BUFFER,#RS ; Yes, file mark read? BEQ EOF ; Stop here if so 20$: JSR PC,PUTCMP ; No, put or compare real record BR 10$ ; Returning to repeat if it worked ; Binary transfer from terminal to file. ; TOQIOW is used to fetch the length, and TIQIOW the actual data. B.TO.F: QIOW$M TOQIOW,#IO.RPR!TF.RNE!TF.TMO,,,,,,<#BUFFER,#256.,#RWTMO,#BINTRM,#BINTRL> .IIF NE V$$AX1-20, QIOW$M TIQIOW,#IO.RPR!TF.RNE!TF.TMO!TF.RAL,,,,,,<,,,#BINTRN,#1> 10$: JSR PC,ENQACK ; Make sure terminal is ready DIR$ #TOQIOW ; Request byte count CHKQIO CR ; Should end CR MOV #BUFFER,%1 ; Address reply buffer CMPB @%1,#RS ; File mark read? BEQ EOF ; Yes, finished MOV #4,R4 ; No, should have had 4 bytes CMP IOSTAT+2,R4 ; Make sure we did BEQ 20$ ; Continue if OK JMP DEVERR ; Error if not 20$: MOVB (%1)+,%3 ; Fetch byte count nybble BIC #^C^B1111,%3 ; in lo 4 bits only .IF DF M$$EIS!R$$EIS ASH #4,%2 ; Make space for them .IFF .REPT 4 ; Make space for them ASL %2 .ENDR .ENDC BIS %3,%2 ; Put in latest nybble SOB %4,20$ ; Repeat QIOW$M TIQIOW,#IO.RPR!TF.RNE!TF.TMO!TF.RAL,,,,,,<,,,#BINTRN,#1> .IF EQ V$$AX1-20 QIOW$R TIQIOW,#IO.WLB,,,,,,<#BINTRN,#1,#0> ; Send DC1 prompt CHKQIO SUC QIOW$R TIQIOW,#IO.RPB!TF.RNE!TF.TMO,,,,,,<#BUFFER,R2,#RWTMO> ; Get data .IFF QIOW$R TIQIOW,,,,,,,<,%2> ; Get data .ENDC CHKQIO SUC ; Must return exact no of bytes JSR PC,PUTCMP ; Put or compare records BR 10$ ; Repeat if it worked ; End of terminal file on write or compare. EOF:.IIF GE V$$AX1-21,QIOW$M SFQIOW,,,,,,,<,#RPALEN> ; Set buffer length QIOW$R SFQIOW,,,,,,,<#NORPA> ; Cancel read-pass-all in ASCII transfer BIT #CMPBIT,SWWRD ; Comparing? BNE 5$ ; Yes, branch JMP CLOSE ; No, just close 5$: GET$ ; Get next record CMPB FDB+F.ERR,#IE.EOF ; Should be end-of-disk-file BEQ 10$ ; OK if so INC DIFCNT ; Add 1 to differences count if not BR 5$ ; for every extra line we have in file 10$: MOV #DIFFCT,%0 ; Address space for count MOV DIFCNT,%1 ; Fetch no of differences BNE 20$ ; Branch if any MOVB #'N,(%0)+ ; If none, say "N MOVB #'o,(%0)+ ; o" BR 30$ 20$: CLR %2 ; Give number JSR PC,$CBDMG ; in decimal MOVB #'.,(%0)+ ; with trailing '.' 30$: SUB #DIAGM,%0 QIOW$M ESTART,,,,,,,<#DIAGM,%0> ; at start of error message QIOW$M ERQIOW,,,,,,,<#DIFFM,#DIFFL> ; End with "differing records" DEC DIFCNT ; Test count again BMI MESAGE ; Output message if zero BNE WARN ; Keep trailing 's' if >1 DEC ERQIOW+Q.IOPL+2 ; Leave 's' off if only one difference BR WARN ; Else change exit status to EX$WAR too ; Check QIO for directive accepted, with expected return status. ; Call as: JSR %5,CHKQIO ; or use macro: CHKQIO xxx ; .WORD IS.xxx ; where IS.xxx is the expected return code, usually IS.SUC or IS.CR. CHKQIO: BCC 10$ ; First make sure directive itself was OK MOV #DSWERN,%0 ; No, address error number string MOV @#$DSW,%1 ; Get binary value QIOW$M ERQIOW,,,,,,,<#DSWERM> ; Load message BR ERRNO ; Put in string and print message 10$: CMP (%5)+,IOSTAT ; Yes, did we have expected reply? BNE QIOERR ; No, report device error exception RTS %5 ; Yes, return to caller QIOERR: QIOW$M ERQIOW,,,,,,,<#QIOERM> ; Load message MOVB IOSTAT,%1 ; Load error code, with sign-extend MOV #QIOERN,%0 ; and place to put value .IF EQ V$$AX1-10 CMPB %1,#IE.TMO ; But was it a device timeout? .IFF CMPB %1,#IS.TMO ; But was it a device timeout? .ENDC BNE ERRNO ; No, keep default message DEVTMO: QIOW$M ERQIOW,,,,,,,<#TMOERM,#TMOERL> ; Yes, change it to timeout MOVB TIQIOW+Q.IOPL+4,R1 ; Get the period itself MOV #TMOERN,R0 ; Place to insert in buffer MOV #^B1011000001010,R2 ; Load conversion control mask JSR PC,$CBTA ; Do 2-digit conversion BR ERROR ; Print and abandon ; Device error -- unexpected reply. Report and abandon current operation(s). DEVERR: QIOW$M ERQIOW,,,,,,,<#DEVERM,#DEVERL> ; Load message BR ERROR ; and go output ; File I/O error, report and give up. FIOERR: MOV #IOERRN,%0 ; Address error number string QIOW$M ERQIOW,,,,,,,<#IOERRM> ; Load message for file I/O error FILERN: MOVB FDB+F.ERR,%1 ; Get binary value TSTB FDB+F.ERR+1 ; But if F.ERR+1<>0 BEQ ERRNO QIOW$M ERQIOW,,,,,,,<#DSWERM> ; It's a directive error MOV #DSWERN,%0 ; instead ; Insert decimal error number, in %1, where %0 points. ERRNO: CLR %2 ; Zero-suppress JSR PC,$CBDSG ; Convert to ASCII MOVB #'.,(%0)+ ; Show it's decimal SUB ERQIOW+Q.IOPL,%0 ; Compute length of string QIOW$M ERQIOW,,,,,,,<,%0> ; to complete DPB ERROR: JSR PC,KILLIO ; Kill pending I/O WARN: DEC EXSTAT ; Try to change EX$SUC=1 to EX$WARN=0 BEQ MESAGE ; OK if succeeded INC EXSTAT ; Else restore some worse error ; Print error or comparison message. MESAGE: DIR$ #ESTART ; Print message start: "HPX *FATAL*-" or QIOW$M ESTART,,,,,,,<#ESTARM,#ESTARL> ; "*DIAG*-...". Reset if latter DIR$ #ERQIOW ; Then message itself MOVB #SPACE,DEVERN ; Reset device error code if used ; Close file, spooling if required. CLOSE: JSR PC,CLOSPL ; Close or spool JMP NXTCMD ; Get next command line or exit .IF DF A$$BRT ; Trap here on abort by CLI. This will kill any pending I/O, to stop the ; task hanging. No attempt is made to reset terminal characteristics. ABORT: JSR PC,KILLIO ; Kill all currently pending I/O MOV #10$,2(SP) ; Fake a return .IIF DF R$$MPL, BIS #170000,4(SP) ; in user mode ASTX$S ; after acknowledging request 10$: DIR$ #ESTART ; Print start of error message QIOW$R ERQIOW,,,,,,,<#ABORTM,#ABORTL> ; and "Aborted by CLI" MOV #EX$SEV,%0 ; Set severe error status JMP EXIT0 ; and exit with it .ENDC ; SUBROUTINES ; =========== ; Perform operation on output tape(s), according to code in %5: ; '0'=rewind recognised if we have /xT:R ; '2'=space files ; '3'=seek e-o-d recognised if we have /xT:A or /xT:E ; '5'=write e-o-f 100000!'5 is recognised only with /xT:A ; Exit abnormally to DEVERR if an error occurs. TAPEOP: MOV #LTFILE,%2 ; Left tape file number string MOV #LTBIT,%3 ; Left tape bit mask MOVB #'1,%4 ; Load device code for left tape JSR PC,DEVCMD ; Set up control code if required for this tape TAPEOR: MOV #RTFILE,%2 ; Address RH tape file number CMPB (%4)+,(%3)+ ; %4:='2' = right tape code, %3:= 2 = RTBIT ; Put tape control instruction into device command buffer and execute, if required. ; %2-> LTFILE or RTFILE switch value string ('A', 'C', 'E', 'R', or number) ; %3= LTBIT or RTBIT mask ; %4= '1' (left tape) or '2' (right tape) ; %5= control code ; Command format is esc&p { p} u C DC1 DEVCMD: BIT %3,SWWRD ; Is this device specified? BEQ 3$ ; (RTSPC) ; No, nothing to do QIOW$M TIQIOW,,,,,,,<,,#POSTMO> ; Set timeout, usually for position MOV #COMAND+3,%1 ; Address control buffer, already starts esc&p CMPB %5,#'3 ; Seek e-o-d? BNE 2$ ; No, see if space files ; Seek e-o-d: /xT:A or /xT:E CMPB @%2,#'A ; Yes, append mode? BEQ 25$ ; Yes, set up code CMPB @%2,#'E ; No, try add to end of tape .IF NE V$$AX1-20 BNE RTSPC ; Do nothing if not .IFF BNE 16$ ; Do nothing if not .ENDC 2$: CMPB %5,#'2 ; Space files control code? BNE 15$ ; No, parameter not needed ; Space files: /xT:n TSTB @%2 ; Yes, was there an explicit value? 3$: BEQ RTSPC ; No, default to next file CMPB @%2,#'A ; Append, condition, or rewind modes? BHIS RTSPC ; Yes, they're done separately 10$: MOVB (%2)+,(%1)+ ; Copy string BNE 10$ ; Until terminating null MOVB #'p,-1(%1) ; Replace null with 'p' postfix character, 15$: CMPB R5,#'4 ; Condition mode? BNE 17$ ; No, try rewind ; Condition and rewind: /xT:C CMPB (R2),#'C ; Yes, condition required? 16$: BNE RTSPC ; No, done. QIOW$M TIQIOW,,,,,,,<,,#CONTMO> ; Yes, increase timeout ; BR 25$ ; Remaining tests fail to 25$ 17$: CMPB %5,#'0 ; Rewind mode? BNE 20$ ; No, branch ; Rewind: /xT:R CMPB @%2,#'R ; No, rewind specified? BNE RTSPC ; No, nothing to do 20$: CMP %5,#100000!'5 ; Conditional file mark? BNE 25$ ; No, definately have a command string ; Mark tape. CMPB @%2,#'E ; Yes, mark file only if /xT:E BNE RTSPC ; Just exit otherwise 25$: MOVB %4,(%1)+ ; device number, MOVB #'u,(%1)+ ; 'u' postfix, MOVB %5,(%1)+ ; control code, JSR PC,TAPEOC ; Complete and output command ; Successful return from TAPEOC just means the command was accepted, not ; necessarily that it has completed. Wait for completion by polling on the tape ; busy bit until clear. MOV TIQIOW+Q.IOPL+4,%1 ; Load timeout counter for position ASL R1 ; Double for 5sec waits BR 35$ ; Don't wait first time 30$: DIR$ #MRKT ; Mark time DIR$ #WAIT5 ; 5 sec 35$: JSR PC,GETSTA ; Get device status RORB BUFFER+5 ; Check busy bit in reply byte 1 BCC RTSPC ; Done, return ; Device busy, wait 5 sec and try again, unless we have already waited POSTMO/CONTMO ; * 10 sec, in which case give timeout error. SOB %1,30$ ; Go wait if still allowed JMP DEVTMO ; Error exit to timeout message ; Send command to terminal, and expect reply of S. Exit abnormally to ; DEVERR if anything else received. Normal entry is at SNDCMD. TAPEOC is a ; special entry from DEVCMD and for write-backspace-read setup. ; An appropriate timeout count should be set up in TIQIOW. TAPEOC: MOVB #'C,(%1)+ ; and 'C' control code flag MOVB #DC1,(%1)+ ; DC1 to ask for success/failure when done SUB #COMAND,%1 ; Compute length of command string QIOW$M TOQIOW,,,,,,,<#COMAND,%1> ; Set up prompt SNDCMD: DIR$ #TOQIOW ; Do prompt CHKQIO SUC ; Make sure it works QIOW$R TIQIOW,#IO.RNE!TF.TMO,,,,,,<#BUFFER,#2> ; Expect 1 char + CR CHKQIO CR ; Check that QIO succeeded, terminating on CR DEC IOSTAT+2 ; 1 byte BNE 10$ ; Error if not -- show 1st char CMPB BUFFER,#'S ; Should be 'S' BEQ RTSPC ; Exit OK if so 10$: MOVB BUFFER,DEVERN ; Copy error code to message if not DEVERJ: JMP DEVERR ; Exit to DEVERR ; Get device status to 1st 7 bytes of BUFFER. R4 is device code. Reply must ; start esc\px, where x is device code. See manual pp 6-11/12 for status bits. GETSTA: MOVB %4,DEVSTN ; Set up tape number MOV R1,-(SP) ; Save R1 MOV #BUFFER+8.,R1 ; As BUFFER pointer .REPT 4 ; Clear reply area CLR -(R1) .ENDR ; Request device status: .IF NE V$$AX1-20 QIOW$C IO.RPR!TF.RNE!TF.RAL!TF.TMO,3,3,,IOSTAT,,,CODE .IFF QIOW$C IO.WLB,3,3,,IOSTAT,,,CODE ; Output prompt CHKQIO SUC ; Make sure it went QIOW$C IO.RPB!TF.RNE!TF.TMO,3,3,,IOSTAT,,,CODE ; Fetch reply .ENDC CHKQIO SUC ; QIO must return with exact no of bytes CMP (R1)+,#<'\*400>!ESC ; Check that reply began esc \ BNE DEVERJ ; Try again later if not CMP (R1)+,DEVSTM+2 ; Also check device code in reply BNE DEVERJ ; = "p"<%4> MOV (SP)+,R1 ; OK, restore R1 RTSPC: RTS PC ; If tape is in use (Z clear from previous BIT on SWWRD), check that tape R4 is ; present. Tape must also be write-enabled if TOTERM < 0, or TOTERM = 0 and ; mark tape (/xT:E) specified. Issue error message and abort if check(s) fail. CHKTAP: BEQ RTSPC ; Return if this drive not in use JSR PC,GETSTA ; Get device status MOVB #'L,NOTERN ; Set letter CMPB R4,#'1 ; for LH tape BEQ 10$ ; if R4='1' MOVB #'R,NOTERN ; Else RH 10$: QIOW$M ERQIOW,,,,,,,<#NOTERM,#NOTERL> ; Load message RORB BUFFER+6 ; If bit 0 of byte 6 is clear BCC 20$ ; there's no tape in the drive TSTB TOTERM ; Tape write required? BEQ RTSPC ; No, tape can be write-protected BMI 15$ ; Must be write-enabled if terminal output CMPB (R5),#'E ; Position only needs write-enable if /xT:E BNE RTSPC 15$: BITB #^B100,BUFFER+5 ; Yes, see if write-locked BEQ RTSPC ; Return normally if not QIOW$M ERQIOW,,,,,,,<#WPERRM,#WPERRL> ; Else load message MOVB NOTERN,WPERRN ; Set letter 20$: JMP WARN ; Output message and give up ; Make sure file number switch values for /LT: and /RT: are in a valid ; format: 'A', 'E', 'dddd', '+ddd', '-ddd', where d is a decimal digit. ; Just delete string to default to current file if /xT:0, /xT:+0, etc.. ; Exits abnormally if string is invalid, returns if OK. VALID: MOV #LTFILE,%5 ; Left tape JSR PC,10$ ; Check it, return only if OK MOV #RTFILE,%5 ; Address right tape value, repeat, 10$: TSTB @%5 ; Null string? BEQ RTSPC ; Yes, OK CMPB @%5,#'A ; 'A', for append to last file? BEQ RTSPC ; Yes, OK, return carry clear CMPB @%5,#'C ; 'C'? BEQ RTSPC ; Yes, OK too CMPB @%5,#'E ; 'E'? BEQ RTSPC ; Yes, OK too CMPB @%5,#'R ; 'R'? BEQ RTSPC ; Yes, OK too TSTB 4(%5) ; Must be number. Did it overflow buffer? BNE ILLVAL ; Error if so MOV %5,%0 ; Copy address of start of number CMPB @%5,#'+ ; '+'? BEQ 20$ ; is OK as first char CMPB @%5,#'- ; So is '-' BNE 30$ ; Not special starter, try null string or number 20$: INC %0 ; '+' or '-' must be followed by number 30$: JSR PC,$CDTB ; Fetch decimal number to TSTB %2 ; see if it ended on null BNE ILLVAL ; Error if not TST %1 ; OK, was it 0 = keep current position BNE RTSPC ; No, return CLRB @%5 ; Yes, just delete string RTS PC ; Return ILLVAL: QIOW$M ERQIOW,,,,,,,<#ILPOSM,#ILPOSL> ; "Illegal tape position" JMP FATAL ; Reject command ; Do an ENQ/ACK handshake with terminal. Called before each QIO to make sure ; the terminal is ready for it. This should prevent problems when running at ; high speeds, or on slow processors/interfaces (e.g. 11/23+ with DLV-11J). ENQACK: CLRB ACKBUF ; Clear reply byte for handshake: .IF NE V$$AX1-20 QIOW$C IO.RPR!TF.RNE!TF.RAL!TF.TMO,3,3,,IOSTAT,,,CODE .IFF QIOW$C IO.WLB,3,3,,IOSTAT,,,CODE ; Send ENQ CHKQIO SUC QIOW$C IO.RPB!TF.RNE!TF.TMO,3,3,,IOSTAT,,,CODE ; Get reply .ENDC CMPB IOSTAT,#IS.SUC ; Success? BNE 10$ ; No, error CMPB ACKBUF,#ACK ; Yes, with ACK reply? BEQ RTSPC ; Yes, exit JMP DEVERR ; No, error .IF EQ V$$AX1-10 10$: CMPB IOSTAT,#IE.TMO ; Error. Timed out? .IFF 10$: CMPB IOSTAT,#IS.TMO ; Error. Timed out? .ENDC BEQ ENQACK ; Repeat forever if timeout JMP QIOERR ; Some other error. Report and abandon ; Called after .CSI2 to initialise wild-card processing. SETWLD: FDOP$R #FDB,,#CSIBLK+C.DSDS ; Reset filename block, and put R0->FDB JSR PC,ENOPEN ; Initialise wildcard processing BCC 10$ ; Branch if OK JMP CMDERR ; Else command syntax error 10$: JSR PC,ENEXT ; Parse for first file BCC 20$ ; OK if there is one JMP OPNERR ; File open error if not 20$: RTS PC ; If copy mode, PUT$ record just read to disk file, exiting to FIOERR if a ; write error occurs. ; If compare mode, make sure record just read is identical to next in file, ; noting first different line number if not. ; On entry, record read from terminal is in BUFFER, no of bytes in %2. PUTCMP: MOV R2,F.NRBD(R0) ; Load byte count BEQ 41$ ; Don't check empty line BIT #ELBIT!ASBIT,SWWRD ; End emphasis/char set in ASCII mode? BNE 41$ ; No, output/compare record as is ; Special character sets and emphasis automatically go off at the end of a line ; on the terminal, but not on HP's 2686 LaserJet printer, which carries them ; forward from line-to-line. So that files (especially forms) can be created ; on the screen and printed on the LaserJet, the following code appends to ; the current record: ; ctrl/N if there was a ctrl/O not followed by ctrl/N (set selection) ; esc&d@ if there was any of esc&dA to esc&dO not followed by esc&d@ ; One might also consider cancelling protection and alpha/numeric field ; attributes, but since these are meaningless to the laser printer, it isn't ; really necessary. It might be if some other HP device didn't lose them at ; end of line, in which case: ; esc6 or esc7 needs esc8 ; and esc] or esc{ needs esc] ; See pp 2.6-2.9 of the HP2648a reference manual. MOV R2,R3 ; Compute end of buffer pointer ADD #BUFFER,R3 MOV R3,R4 ; Make a copy of pointer MOV R2,R5 ; and count ; Look backwards for ^N or ^O 2$: CMPB -(R3),#'N&37 ; Control-N? BNE 4$ ; No, keep looking MOVB #'O&37,(R4)+ ; Yes, need ^O INC F.NRBD(R0) ; Count it BR 10$ ; No need to look further back 4$: CMPB (R3),#'O&37 ; Control-O? BEQ 10$ ; Yes, don't need another SOB R2,2$ ; Neither, keep searching ; Look backwards for esc&dx, where x is @ or A-O 10$: MOV R4,R2 ; Copy end pointer SUB #4,R5 ; Reduce count by length of escape sequence BMI 40$ ; <4 can't hasn't room for one 20$: CMPB -(R4),#'d ; Look for penultimate d BNE 30$ ; Start again if not CMPB -1(R4),#'& ; Else look for & BNE 30$ CMPB -2(R4),#ESC ; and escape BNE 30$ CMPB 1(R4),#'@ ; Found esc&dx. Is x @? BEQ 40$ ; Yes, don't need another BLO 30$ ; Less is an invalid sequence. Look further CMPB 1(R4),#'O ; >'O' is also invalid BHI 30$ ; 'A'-'O' is an emphasis needing resetting: CMPB -(R4),-(R4) ; Point to start of esc&d emphasis string MOVB (R4)+,(R2)+ ; Copy it in MOVB (R4)+,(R2)+ MOVB (R4)+,(R2)+ MOVB #'@,(R2)+ ; But with terminating '@' to cancel emphasis ADD #4,F.NRBD(R0) ; Adjust length, and output BR 40$ ; Go output record 30$: SOB R5,20$ ; Keep looking if no emphasis found 40$: MOV F.NRBD(R0),R2 ; Fetch {adjusted} length 41$: BIT #CMPBIT,SWWRD ; Compare mode? BNE 50$ ; Yes, branch PUT$ ; No, just write record BCC 300$ ; Return to caller if OK BR 60$ ; (FIOERR) ; Else to FIOERR JMP FIOERR ; Else to FIOERR 50$: GET$ ; Fetch record to CMPBUF BCC 70$ ; Make sure GET worked CMPB FDB+F.ERR,#IE.EOF ; Premature end-of-file? BEQ 200$ ; Yes, count as a "different" line 60$: JMP FIOERR ; No, file I/O error 70$: CMP %2,FDB+F.NRBD ; Should be same length as that from terminal BNE 200$ ; Files are different if not MOV #CMPBUF,%4 ; Address file read buffer MOV #BUFFER,%5 ; and terminal read buffer 100$: DEC %2 ; Decrement byte count BMI 300$ ; If we pass 0, records are the same CMPB (%4)+,(%5)+ ; Compare bytes BEQ 100$ ; Keep comparing if same 200$: INC DIFCNT ; Else count a difference 300$: RTS PC ; and return ; Close current file, spooling if required. CLOSPL: MOV #FDB,%0 ; Reload FDB pointer BIT #SPBIT,SWWRD ; Spool required? BEQ 10$ JMP .PRINT ; Yes, spool and return 10$: JMP .TRNCL ; No, close, truncating if appropriate ; Kill any pending I/O, and flush anything returned already. KILLIO: QIOW$R SFQIOW,#IO.KIL ; Kill all currently pending I/O QIOW$R SFQIOW,#IO.WAL,,,,,,<#BINTRN,#1> ; Trigger any pending O/P QIOW$R SFQIOW,#SF.SMC,,,,,,<#NORPA,#RPALEN+2> ; Flush input & cancel pass all QIOW$R SFQIOW,#SF.SMC,,,,,,<,#RPALEN> ; Reset DPB size RTS PC ; and return .PSECT RODATA,D,RO ; Read-only data area MRKT: MRKT$ 4,5,2 ; Mark time 5 sec .IF DF S$$TOP WAIT5: STSE$ 4 ; Stop for it .IFF WAIT5: WTSE$ 4 ; Wait for it .ENDC .MACRO STRING NAME,TEXT,SUFFIX NAME'M: .ASCII TEXT .IIF NB,^|SUFFIX|,NAME'N: .ASCII SUFFIX NAME'L=.-NAME'M .ENDM .MACRO MESSAG NAME,ABBREV,TEXT,SUFFIX NAME'M: .IIF NE V$$AX1, .ASCII "ABBREV, " .IIF NB,^|TEXT|, .ASCII TEXT .IIF NB,^|SUFFIX|,NAME'N: .ASCII SUFFIX NAME'L=.-NAME'M .ENDM MESSAG .IF NE V$$AX1 STRING ESTAR,^/"%HPX-F-"/ ; Start of all error messages .IFF STRING ESTAR,^/"HPX -- *FATAL*-"/ ; Start of all error messages .ENDC MESSAG CMDER,CMDERR,<"Command line error"> MESSAG SDVER,INVDEV,<"Invalid terminal device(s)"> MESSAG ILPOS,ILLPOS,<"Illegal tape position"> MESSAG NOPRI,NOPRIN,<"No printer"> .IIF DF A$$BRT, MESSAG ABORT,ABORTED,<"Aborted by CLI"> STRING EDIT,^/"L""&dCEdit display, position cursor, press a key""&d@""G"/ STRING HOMDN,^/"F"/ ; Cursor home down STRING GETST,^/"^"/ ; Get primary terminal status STRING ASCTR,^/"&pR"/ ; ASCII transfer trigger STRING BINTR,^/"&p2R"/,^// ; Binary transfer trigger STRING SETDV,^/"&k"/,<"0c0b0A"> ; Set caps/block/auto LF ENQBUF: .BYTE ENQ ; ENQ for ENQ/ACK handshake .EVEN LTBIT=1 ; /Left Tape (device bits must be in this order) RTBIT=2 ; /Right Tape DIBIT=4 ; /DIsplay PRBIT=10 ; /PRinter SPBIT=20 ; /SPool output APBIT=40 ; /APend output FOBIT=100 ; /FOrtran carriage-control output LABIT=200 ; /LAtch switches (must be bit 7) CMPBIT=400 ; /CoMpare WBRBIT=1000 ; /Write-Backspace-Read NLBIT=2000 ; /-LIst files on multiple copies LIBIT=NLBIT ; /LIst files on multiple copies ELBIT=4000 ; /Emphasis & char set of at end of Line BIBIT=100000 ; /BInary = /-ASCII (must be bit 15) ASBIT=BIBIT ; /ASCII = /-BInary SWTAB: CSI$SW LT,LTBIT,SWWRD,SET,,LTDES ; Left Tape CSI$SW RT,RTBIT,SWWRD,SET,,RTDES ; Right Tape CSI$SW DI,DIBIT,SWWRD,SET ; Display CSI$SW PR,PRBIT,SWWRD,SET ; Printer CSI$SW SP,SPBIT,SWWRD,SET,NEG ; Spool CSI$SW AP,APBIT,SWWRD,SET,NEG ; Append CSI$SW FO,FOBIT,SWWRD,SET,NEG ; FORTRAN carriage-control CSI$SW CM,CMPBIT,SWWRD,SET,NEG ; CoMpare mode CSI$SW WB,WBRBIT,SWWRD,SET,NEG ; Write-Backspace-read ; Only the following are allowed on input files after the first: NXINSW: CSI$SW LI,NLBIT,SWWRD,CLEAR,NEG ; List CSI$SW LA,LABIT,SWWRD,SET,NEG ; Latch CSI$SW BI,BIBIT,SWWRD,SET,NEG ; Binary CSI$SW AS,ASBIT,SWWRD,CLEAR,NEG ; ASCII = -Binary CSI$SW EL,ELBIT,SWWRD,CLEAR,NEG ; End Line emphasis/char set off CSI$ND LTDES: CSI$SV ASCII,LTFILE,5 ; L-H tape switch value CSI$ND RTDES: CSI$SV ASCII,RTFILE,5 ; R-H tape switch value CSI$ND ; 16-WORD terminator character flag buffer for read-with-special-terminators. TERMIN: .WORD 20000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; Only CR (code 15) allowed .PSECT RWDATA,D,RW ; Read/write data area ; QIO DPBs for terminal I/O. Initialised for once only use at startup. ; Terminal input, initially, get terminal type: TIQIOW: QIOW$ IO.RPR!TF.RNE!TF.TMO,3,3,,IOSTAT,, ; Terminal output, initially, get latching key settings: .IF NE V$$AX1-20 TOQIOW: QIOW$ IO.RPR!TF.RNE!TF.TMO!TF.RAL,3,3,,IOSTAT,, .IFF TOQIOW: QIOW$ IO.WLB,3,3,,IOSTAT,, .ENDC ; Terminal setup, initially, attach TI:, later, SF.SMC/SF.GMC SFQIOW: QIOW$ IO.ATT,3,3,,IOSTAT,, ; Error message start ESTART: QIOW$ IO.CCO,3,3,,IOSTAT,, ; Error message finish, also used for edit read-after-prompts ERQIOW: QIOW$ IO.WLB,3,3,,IOSTAT,, ; Terminal (re)set commands. Note that FLUSH should follow NORPA. ; USERTT contains user's terminal setups, reset on exit USERTT: .BYTE TC.ACR,0 ; Wraparound .BYTE TC.HFL,0 ; Fill on CR .IF DF R$$MPL .BYTE TC.TBF,0 ; Typeahead buffer .IFF .IIF NE V$$AX1-10,USERAT: .BYTE TC.RAT,0 ; Typeahead buffer .ENDC .BYTE TC.SMR ; Case conversion .BYTE TC.VFL ; Fill on LF .IF GE V$$AX1-21 .BYTE TC.NBR,0 ; Nobroadcast status .BYTE TC.8BC,0 ; Pass 8 bits on read NORPA: .BYTE TC.TSY,1 ; Reset TTsync, unless user had it cancelled USERTL=.-USERTT ; Length of user's terminal setup store .BYTE TC.PTH,0 ; Cancel read-pass-thru FLUSH: .BYTE TC.TBF,0 ; Flush type-ahead buffer SETRPA: .BYTE TC.PTH,1 ; Set read-pass-thru .BYTE TC.TSY,0 ; Pass ^S and ^Q too .IFF USERTL=.-USERTT ; Length of user's terminal setup store NORPA: .BYTE TC.BIN,0 ; Cancel read-pass-all FLUSH: .BYTE TC.TBF,0 ; Flush type-ahead buffer SETRPA: .BYTE TC.BIN,1 ; Set read-pass-all .ENDC RPALEN=.-SETRPA SPSAVE: .BLKW 1 ; Initial stack pointer IOSTAT: .BLKW 2 ; I/O status block EXSTAT: .WORD EX$SUC ; Exit status, assume success SWWRD: .WORD 0 ; Switch word FSRSZ$ 1,,RWDATA ; 1 file open FDB: FDBDF$ ; Set up file descriptor block FDAT$A R.VAR FDRC$A ,BUFFER,256. FDOP$A 2,CSIBLK+C.DSDS,DEFNAM DEFNAM: NMBLK$ HPX,TXT,0,SY,0 ; Default output filename SY0:HPX.TXT;0 GC: GCMLB$ 1,HPX ; GCML control block DIFCNT: .BLKW 1 ; No of different lines in compare ; Byte data CSIBLK: .BLKB C.SIZE ; CSI control block RTFILE: .BYTE 0,0,0,0,0 ; R-H tape file number LTFILE: .BYTE 0,0,0,0,0 ; L-H tape file number TOTERM: .BLKB 1 ; -1 = file->terminal, 0 = terminal->file, +1 = position LSTCTL: .BLKB 1 ; CS.MOR!CS.WLD<>0 to list files as they are copied ACKBUF: .BLKB 1 ; Space for ACK reply to ENQ .IF NE V$$AX1 STRING DIAG,^/"%HPX-I-MATCH, "/ ; Start of comparison message .IFF STRING DIAG,^/"HPX -- *DIAG*- "/ ; Start of comparison message .ENDC DIFFCT: .ASCII "????." ; Space for no of differences STRING DIFF,<" differing records"> ; Suffix for compare message MESSAG DEVER,DEVERR,<"Terminal device error ">,<" "> MESSAG QIOER,QIOERR,<"QIO error ">,<"????."> MESSAG DSWER,DIRERR,<"Directive error ">,<"????."> MESSAG OPNER,OPNERR,<"File open error ">,<"????."> MESSAG IOERR,FILERR,<"File I/O error ">,<"????."> MESSAG TMOER,TIMEOUT,<"Timed out after ">,<"??0. sec"> MESSAG WPERR,WRTPROT,,<"xH tape is write-protected"> MESSAG NOTER,NOTAPE,<"No tape in ">,<"xH drive"> STRING RESDV,^/"&k"/,<"0c0b0A"> ; Reset caps/block/auto LF .EVEN ; so DEVSTN can be TSTed STRING DEVST,^/"&p"/,^@"1^"@ ; Get device status ; Device command buffer, initially: ; ESC Z Display functions off ; ESC * s1 ^ Reply with terminal type COMAND: .ASCII "&p" ; Start of command buffer STRING ASKDV,^/"Z""&s0p0Q""*s1^"/,^// ; ASKDVN->DC1 MESSAG ILLDV,NOT2648,<"TI: not a ">,<"2648A"> ; TI: device name, for startup check .EVEN ; may be overwritten for later long commands WRTSEQ: .ASCII "&pW" ; Prefix to BUFFER for ASCII write mode .IIF NE .-WRTSEQ-4, .ERROR .-WRTSEQ ; INVALID ASSUMPTION, LEN(WRTSEQ)<>4 BUFFER: .BLKB 256. ; Terminal I/O buffer TEMP: .BLKB 2 ; 2 spare bytes (must follow BUFFER) CMPBUF: .BLKB 256. ; File comparison buffer ; One-time startup code, overlays buffer space. .=BUFFER+40 ; Enough room for initial I/O HPX: MOV SP,SPSAVE ; Save SP for error recovery MOV #^RHPX,DN+N.FNAM ; Default input filename .IIF DF A$$BRT, DIR$ #SREA ; Define abort trap DIR$ #SFQIOW ; Attach to TI: QIOW$R SFQIOW,#SF.GMC ; Get user's terminal characteristics .IF EQ V$$AX1-23 COMB USERAT+1 ; Bit returned inverted for VAX-11 RSX V2.3! BICB #^C1,USERAT+1 ; Invert it back for SF.SMC on exit .ENDC QIOW$R SFQIOW,#SF.SMC,,,,,,<#HPXTTC,#HPXTTL> ; Set characteristics to HPX needs 5$: JSR PC,KILLIO ; Reset terminal and flush any pending output DIR$ #TIQIOW ; Make sure this is an HP2648a BCS 5$ ; Repeat if QIO itself fails CMPB IOSTAT,#IS.SUC ; Make sure not just timeout BNE ILLDEV ; Say illegal device if don't get success MOV #BUFFER,%1 ; Address reply buffer MOV #ILLDVN,%2 ; and expected device name ("2648A") MOV #5,%3 ; and its length, 5 bytes 10$: CMPB (%1)+,(%2)+ ; Compare reply with expected one BNE ILLDEV ; Error if any bytes don't match SOB %3,10$ ; Repeat until end ; Get initial setting of the latching caps lock, auto LF, and block mode keys, ; and set up appropriate escape sequence to reset them on exit. CLR R0 ; Default to all up DIR$ #TOQIOW ; Get key settings BCS 20$ ; Ignore error CMPB IOSTAT,#IS.SUC ; of any kind BNE 20$ .IF EQ V$$AX1-20 QIOW$R TOQIOW,#IO.RPB!TF.RNE!TF.TMO,,,,,,<#BUFFER,#10.,#STATMO> BCS 20$ CMPB IOSTAT,#IS.SUC BNE 20$ .ENDC CMP BUFFER,#<'\*400>!ESC ; Reply should start esc\ BNE 20$ ; Ignore anything else MOVB BUFFER+5,%0 ; Save byte 3 -- latching keys' status 20$: QIOW$R TOQIOW,#IO.WAL,,,,,,<#SETDVM,#SETDVL,#0> ; Set to HPX's needs ; Change 0's to 1's in the RESDV string where any of caps lock/auto LF/block ; mode were found to be set on entry. This will be used task exit and whenever ; keyboard input is expected. MOV #RESDVN,%1 ; Address first 0 reset command string 30$: RORB %0 ; Shift out a bit of latched key flag ADCB (%1)+ ; Set means turn it on by changing '0' code to '1' INC %1 ; Skip command character CMP %1,#RESDVM+SETDVL ; Reached end of command string? BLO 30$ ; No, check next bit FINIT$ ; Terminal setup done. Initialise FCS JMP NXTCMD ; and go get command ; Exit with severe error if TI: device isn't a 2648a ILLDEV: JSR PC,KILLIO ; Reset the terminal DIR$ #ESTART ; Print start of error message DIR$ #ERQIOW ; and "not 2648A" MOV #EX$SEV,%0 ; Set exit status JMP EXIT1 ; and exit with it .IIF DF A$$BRT,SREA: SREA$ ABORT ; Specify abort trap ; SF.SMC buffer for HPX's needs. HPXTTC: .BYTE TC.ACR,0 ; No wraparound .BYTE TC.HFL,0 ; No fill on CR .IF DF R$$MPL .BYTE TC.TBS,255. ; Maximum typeahead buffer .IFF ; Note: The flipping of these bits in versions 2.0 - 2.2 is a VAX-11 RSX bug, ; which DEC corrected (for SF.SMC ONLY) in V2.3 .IF EQ ** .BYTE TC.RAT,0 ; Typeahead buffer .IFF .IIF NE V$$AX1-10, .BYTE TC.RAT,1 ; Typeahead buffer .ENDC .ENDC .BYTE TC.SMR,1 ; No uppercase conversion .BYTE TC.VFL,0 ; No fill on LF .IF GE V$$AX1-21 .BYTE TC.NBR,1 ; Nobroadcast .BYTE TC.8BC,1 ; Pass 8 bits on (binary) read .ENDC HPXTTL=.-HPXTTC .END HPX