.TITLE MTEXCH - Read or Write Foreign Magtapes .IDENT /2.06/ ;++ ; Title: ; MTEXCH - Read or Write Foreign Magtapes ; ; Facility: ; Utility for reading or writing magnetic tapes in non-VAX ; formats. ; ; Abstract: ; MTEXCH is a general utility for copying files between disk and magnetic ; tapes in non-VAX formats. The goal in creating MTEXCH was to provide ; a utility that was easy to use, provided reasonable feedback to the ; user, and could be easily modified to add new record formats. ; ; The tape to be processed by MTEXCH must be mounted with the ; /FOREIGN qualifier and with the correct value of the /BLOCKSIZE ; qualifier. The tape is considered to consist of one or more files ; delimited by tape marks. A double tape mark is considered to mark ; the end of the tape. Each file is considered to consist of a string ; of blocks. MTEXCH has no knowledge of internal file structure or ; labels on tape. ; ; MTEXCH can be run either as a foreign command, or as a program ; with commands read from SYS$INPUT. When reading from SYS$INPUT, ; the user is prompted with a "*". Error messages are issued by ; signalling a condition and are written to SYS$OUTPUT and SYS$ERROR ; by the system default condition handler. ; ; A command to MTEXCH consists of: ; o EXIT (to terminate MTEXCH) ; o tape_device_name: /positioning_qualifiers ; o disk_filespec /qualifiers = tape_device_name /qualifiers ; o tape_device_name /qualifiers = disk_filespec /qualifiers ; ; Tape_device_name consists of a physical or logical device name ; which must be terminated by a colon. Disk_filespec is any valid ; VMS filespec (including full wildcarding) which refers to a disk ; device. ; ; For command of the form tape_device_name: /positioning_qualifiers ; no data is read or written. The specified tape device is repositioned ; as specified by the qualifers. ; ; The last two command formats are used to copy a file from tape to ; disk or vice versa. The file is read from the source specified to ; the right of the equal sign and is written to the destination ; specified on the left of the equal sign. Exactly one file is ; transferred for each command. For each record on the source ; file, exactly one record is written on the destination file. ; The records on tape must be in one of the formats known to MTEXCH ; and must be specified by a qualifer following the tape_device_name. ; The records on disk must be in a format understood by VAX RMS which ; is used to read or write the disk files. ; ; For further information on how to use this program, consult the ; documentation. ; ; MTEXCH must be assembled with the macro library ; DEV$SSG:[SSG.SOURCE.SMAC]SMAC.MLB]. It must be linked with the ; object file created from the message definition file MTXMSG.MSG. ; The traceback handler should be excluded at link time. ; ; Commands of the following form should be used: ; $MACRO/LIST MTEXCH+SMAC/LIB ; $MESSAGE/LIST MTXMSG ; $LINK/NOTRACE MTEXCH,MTXMSG ; ; Environment: ; Native Mode. No other considerations. ; ; Author: ; Gary L. Grebus, Creation date: 19-Sep-1979 ; Battelle Columbus Labs ; ; Modified by: ; Gary L. Grebus, 02-Feb-1982 ; 2.00 - Major rewrite to use QIO for tape handling and to ; improve command parsing. Added VARIABLE, ANSID, and ; VB record formats. ; ; Gary L. Grebus, 18-Feb-1982 ; 2.01 - Fixed endless loop on wildcard disk file spec. ; ; Gary L. Grebus, 05-Mar-1982 ; 2.02 - Added $DASSGN of tape channel after each set of files ; processed. Fixes "no I/O channel available" problem. ; ; Gary L. Grebus, 13-Jul-1982 ; 2.03 - Fixed problem of logical name processing in DEV_TYPE ; not allowing for long equivalence names. ; ; Gary L. Grebus, 25-Jul-1982 ; 2.05 - Fixed problem of "invalid record attributes" reading back ; a FORTRAN carriage control file just written to tape. ; The RAT field of DISK_FAB wasn't getting cleared. ; ; Gary L. Grebus, 25-Oct-1982 ; 2.06 - Added new character set "PRIME" which is ASCII with the ; high order bit always set. ;-- .PAGE .SBTTL Local macros .MACRO SIGNAL CODE1, F1, CODE2, F2 ;; Macro to generate a message vector and signal a condition. ;; Up to two message sequences are allowed. Each sequence may have up to ;; four FAO parameters. Sequences for RMS and SS error codes are correctly ;; generated. Parameters must not reside R1 which is modified. R0 is ;; preserved. .IF BLANK, ;; CODE1 must be specified .ERROR ; Message code must be specified .MEXIT .ENDC PUSHL R0 ; Preserve condition value CLRL R1 ; Clear argument count MSG.. CODE2,F2 ; Process both message sequences MSG.. CODE1,F1 CALLS R1,G^LIB$SIGNAL ; Signal the condition POPL R0 ; Restore condition value .ENDM SIGNAL .MACRO MSG.. CODE,FW,FX,FY,FZ,?L1 .IF NB, ;; If there is a message code ..FLEN=0 ;; Count of FAO parameters .IRP F, ;; Stack parameters in reverse order .IF NB, ;; If parameter supplied .NTYPE ..TYP,F ;; Get addressing type ..TYP = ..TYP@-4&^XF ..FLG = 0 .IIF LE,..TYP-1, ..FLG=1 .IIF EQ,..TYP-5, ..FLG=1 .IF EQ,..FLG ;; If mode is an address PUSHAL F .IF_FALSE ;; Else push value PUSHL F .ENDC ..FLEN = ..FLEN + 1 .ENDC .ENDR PUSHL CODE ; Put message code on stack. ; (must be in memory for CMPZV) CMPZV #STS$V_FAC_NO,- #STS$S_FAC_NO,- (SP),#1 ; Is code a system or RMS code? BLEQ L1 ; Branch if so MOVAB 4(SP),SP ; Pop CODE off stack. PUSHL #..FLEN ; Push FAO list length INCL R1 PUSHL CODE ; Put message code back on stack L1: ADDL2 #..FLEN+1,R1 ; Bump argument count .ENDC .ENDM MSG.. .PAGE .SBTTL Symbol definitions .ENABLE DEBUG ; System symbols $DIBDEF ; Symbols for device characteristics $DEVDEF ; Likewise $TPADEF ; TPARSE symbol definitons $STSDEF ; Condition value definitions $NAMDEF ; $NAM and file spec symbols $CHFDEF ; Condition handler symbols ; Local symbols CMD_BUF_SZ = 255 ; Max size of command buffer EQUIV_NAME_SZ = 64 ; Max size for equivalence names $EQULST MTX_C_,,1,1,- ; Codes for character sets <- - - - ; Funny ASCII from PR1ME's > $EQULST MTX_C_,,1,1,- ; Codes for record formats <- - - - - - - > MTX_C_MAXRFMT = MTX_C_VB ; Max code used for record format $EQULST QUAL_C_,,1,1,- <- ; Qualifier classes used to detect - ; duplicate qualifiers. - - - - - > MAX_REC_SZ = 32767 ; Maximum record size MAX_BLK_SZ = 65532 ; Maximum tape block size MIN_BLK_SZ = 14 ; Minimum tape block size CH_CR = ^O15 ; ASCII carriage return CH_LF = ^O12 ; ASCII line feed ANSID_PAD_CH = ^A/^/ ; ANSID block padding char ; Various attribute defaults DEF_TAPE_RECSZ = 80 ; Default record size for tape files DEF_TAPE_RECFMT = MTX_C_FIXED ; Default record format for tape DEF_DISK_RECFMT = MTX_C_VARIABLE ; Default record format for disk ; Offsets into file vectors. These vectors are used to hold all status ; and attribute information about the files being processed. $DEFINI VEC $DEF VEC_L_XLATE .BLKL 1 ; Translation table address $DEF VEC_L_BLKSZ .BLKL 1 ; Block size (if tape) $DEF VEC_L_RECSZ .BLKL 1 ; Record size $DEF VEC_L_RECFMT .BLKL 1 ; Record format $DEF VEC_L_STS .BLKL 1 ; Status flags _VIELD MTX,1,<- ; Definition of flag bits ,- ; Device is tape - ; /REWIND was requested - ; Wildcard processing needed - ; In GET vector-no GET spec seen > $DEF VEC_L_CC .BLKL 1 ; Carriage control code (FAB$M_xxx) $DEF VEC_L_SKP .BLKL 1 ; File skip count (for tape) $DEF VEC_Q_FSDESC .BLKQ 1 ; Descriptor for file spec $DEF VEC_T_FSPEC .BLKB NAM$C_MAXRSS ; Space for file spec $DEF VEC_Q_DEVDESC .BLKQ 1 ; Descriptor for device name $DEF VEC_T_DEVNAME .BLKB EQUIV_NAME_SZ ; Space for device name $DEF VEC_T_DEVCHAR .BLKB DIB$K_LENGTH ; Space for device characteristics $DEF VEC_C_LENGTH ; Length of structure $DEFEND VEC .PAGE .SBTTL Read only data areas .PSECT RODATA RD,NOWRT,NOEXE,SHR,LONG ; Read only data areas PROMPT_STR: .ASCII /*/ ; Next command prompt PROMPT_SZ = . - PROMPT_STR RT11TERM: PIP10TERM: .ASCII ; RT11 and PIP10 record terminator DEF_DISK: .LONG 20$-10$ ; Descriptor for string .ADDRESS 10$ 10$: .ASCII /SYS$DISK/ ; Logical name for default disk device 20$: MT_EFN: .LONG 7 ; Event flag numbers for tape QIO .LONG 8 MT_BUF_ADR: .ADDRESS BLK_BUF1 ; Vector of tape buffer addresses .ADDRESS BLK_BUF2 ANSID_PAD_LONG: .BYTE ANSID_PAD_CH[4] ; Longword of ANSID block padding ; Translation table addresses. Table addresses must be in same order ; as definitions of character sets in above $EQULST. FROM_ASCII_VEC: .LONG 0 ; ASCII-ASCII dummy entry .ADDRESS LIB$AB_ASC_EBC ; ASCII-EBCDIC table .ADDRESS ASCII_TO_PRIME ; ASCII to funny PR1ME ASCII ; Future entries go here TO_ASCII_VEC: .LONG 0 ; ASCII-ASCII dummy entry .ADDRESS LIB$AB_EBC_ASC ; EBCDIC-ASCII table .ADDRESS PRIME_TO_ASCII ; Funny PR1ME ASCII to real ASCII ; Future entries go here .PAGE .SBTTL Read/write data .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG ; Read/write data ; FAB and RAB for command file IN_FAB: $FAB - FNM=,- FAC=GET,ORG=SEQ ; FAB for command input file IN_RAB: $RAB - FAB=IN_FAB,- PBF=PROMPT_STR,- PSZ=PROMPT_SZ,- ROP=,- UBF=CMD_BUF,USZ=CMD_BUF_SZ ; RAB for command input file ; Skeleton RMS data structures for disk file being processed DISK_FAB: $FAB NAM=DISK_NAM,- XAB=DISK_XABFHC,- FOP= ; FAB for disk file DISK_RAB: $RAB FAB=DISK_FAB,- MBF=2,- MBC=2,- ROP=,- UBF=REC_BUF,- RBF=REC_BUF,- USZ=MAX_REC_SZ ; RAB for disk file DISK_NAM: $NAM ESA=DISK_ESA,- RSA=DISK_RSA,- ESS=NAM$C_MAXRSS,- RSS=NAM$C_MAXRSS ; Skeleton NAM block DISK_XABFHC: $XABFHC DISK_RSA: .BLKB NAM$C_MAXRSS ; Buffer for resultant file name DISK_ESA: .BLKB NAM$C_MAXRSS ; Buffer for expanded file name RSA_DESC: .LONG 0 .ADDRESS DISK_RSA ; Skeleton descriptor for RSA ; File vectors. Used to hold parse and status info for the GET (source) and ; PUT (destination) files. GVEC: .BLKB VEC_C_LENGTH ; Vector for GET file PVEC: .BLKB VEC_C_LENGTH ; Vector for PUT file ; Buffer for command lines CMD_BUF: .BLKB CMD_BUF_SZ CMD_BUF_DESC: .LONG CMD_BUF_SZ .ADDRESS CMD_BUF ; Descriptor for above buffer CMD_LEN: .BLKL 1 ; Length of command in buffer ; Control info for filling or emptying block buffer BLK_FIL_LC: .BLKL 1 ; Number of bytes remaining in block BLK_FIL_PTR: .BLKL 1 ; Address of next byte in block buffer ; Counters for reads and writtens REC_CNT: .BLKL 1 ; Count of number of records processed BLK_CNT: .BLKL 1 ; Count of number of blocks processed ; Storage for tape QIO processing MT_CHAN: .BLKW 1 ; Channel for tape operation MT_IOSB: .BLKQ 2 ; Two IO status blocks ; Parameter block for calling LIB$TPARSE TPARSE_BLK: .LONG TPA$K_COUNT0 ; Longword count .LONG TPA$M_ABBREV ; Allow most unique abbrev .BLKL TPA$K_LENGTH0-8 ; Space for remainder of block CURRENT_VEC: .BLKL 1 ; Address of vector currently ; being filled. SKIP_SIGN: .BLKL 1 ; Buffer to remember sign seen on ; skip count QUAL_FLAG: .BLKL 1 ; Flags set during parsing to avoid ; duplicate or conflicting qualifers PARSE_MSG_FLAG: .BLKL 1 ; Flag set if an error message is ; issued by parser action routine. ; Avoids extraneous messages. FLAG_QUAL: .BLKL 1 ; Flag for supressing individual ; record warning messages. EXIT_FLAG: .BLKL 1 ; Flag that EXIT command seen. ; I/O buffers BLK_BUF1: .BLKB MAX_BLK_SZ ; 2 buffers for largest possible block BLK_BUF2: .BLKB MAX_BLK_SZ REC_BUF: .BLKB MAX_REC_SZ ; Buffer for largest possible record ; Translation tables for processing funny ASCII character set used by ; PR1ME computers. In this absurd set, the high order bit of each character ; is set. PRIME_TO_ASCII: ; PR1ME ASCII to real ASCII .REPEAT 2 ..CHAR = 0 .REPEAT 128 .BYTE ..CHAR ..CHAR = ..CHAR + 1 .ENDR .ENDR ASCII_TO_PRIME: ; Real ASCII to PR1ME ASCII .REPEAT 2 ..CHAR = 128 .REPEAT 128 .BYTE ..CHAR ..CHAR = ..CHAR + 1 .ENDR .ENDR .PAGE .SBTTL Parse Tables ; Parser tables .PSECT RODATA RD,NOWRT,NOEXE,SHR,LONG COMMA = ^A/,/ SEMI = ^A/;/ LANGBRK = ^A// $INIT_STATE MTX_STATE,MTX_KEY $STATE BEGIN $TRAN !EXIT_CMD,TPA$_EXIT,,1,EXIT_FLAG $TRAN TPA$_LAMBDA,DEST_FILE $STATE EXIT_CMD $TRAN 'EXIT' $STATE $TRAN TPA$_EOS,TPA$_EXIT $STATE DEST_FILE $TRAN !FILE_SPEC,DEST_SW,,,PVEC+VEC_Q_FSDESC $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADDEST $STATE DEST_SW $TRAN '/',SWITCH_D $TRAN '=',SRC_FILE $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADSOURCE $STATE DEST_SW1 $TRAN '/',SWITCH_D $TRAN '=',SRC_FILE $TRAN TPA$_EOS,TPA$_EXIT,,MTX_M_NOGET,PVEC+VEC_L_STS $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADSOURCE $STATE SWITCH_D $TRAN 'ANSID',DEST_SW1,CHECK_DUP,MTX_C_ANSID,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'ASCII',DEST_SW1,CHECK_DUP,MTX_C_ASCII,- PVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'BLOCKSZ',BLKNUM_D,CHECK_DUP,,,QUAL_C_BLKSZ $TRAN 'CR',DEST_SW1,CHECK_DUP,FAB$M_CR,- PVEC+VEC_L_CC,QUAL_C_CC $TRAN 'EBCDIC',DEST_SW1,CHECK_DUP,MTX_C_EBCDIC,- PVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'FIXED',DEST_SW1,CHECK_DUP,MTX_C_FIXED,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'FLAG_RECORDS',DEST_SW1,,0,FLAG_QUAL $TRAN 'FORTRAN',DEST_SW1,CHECK_DUP,FAB$M_FTN,- PVEC+VEC_L_CC,QUAL_C_CC $TRAN 'NOFLAG_RECORDS',DEST_SW,,1,FLAG_QUAL $TRAN 'PIP10',DEST_SW1,CHECK_DUP,MTX_C_PIP10,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'PRIME',DEST_SW1,CHECK_DUP,MTX_C_PRIME,- PVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'RECLENGTH',RECNUM_D,CHECK_DUP,,,QUAL_C_RECSZ $TRAN 'REWIND',DEST_SW1,,MTX_M_REWIND,PVEC+VEC_L_STS $TRAN 'RT11',DEST_SW1,CHECK_DUP,MTX_C_RT11,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'SKIPFILE',SKIPNUM_D,CHECK_DUP,,,QUAL_C_SKP $TRAN 'VARIABLE',DEST_SW1,CHECK_DUP,MTX_C_VARIABLE,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'VB',DEST_SW1,CHECK_DUP,MTX_C_VB,- PVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_UNKQUAL $STATE BLKNUM_D $TRAN !BLKNUMCOM,DEST_SW1 $STATE RECNUM_D $TRAN !RECNUMCOM,DEST_SW1 $STATE SKIPNUM_D $TRAN !SKIPNUMCOM,DEST_SW1 $STATE BLKNUMCOM $TRAN ':' $TRAN '=' $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_VALREQ $STATE $TRAN TPA$_DECIMAL,TPA$_EXIT,STORE_VAL,,,VEC_L_BLKSZ $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADVAL $STATE RECNUMCOM $TRAN ':' $TRAN '=' $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_VALREQ $STATE $TRAN TPA$_DECIMAL,TPA$_EXIT,STORE_VAL,,,VEC_L_RECSZ $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADVAL $STATE SKIPNUMCOM $TRAN ':' $TRAN '=' $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_VALREQ $STATE $TRAN '+',,,+1,SKIP_SIGN $TRAN '-',,,-1,SKIP_SIGN $TRAN TPA$_LAMBDA,,,+1,SKIP_SIGN $STATE $TRAN TPA$_DECIMAL,TPA$_EXIT,SKIP_STORE $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADVAL $STATE SRC_FILE $TRAN TPA$_LAMBDA,,RESET_CURVEC $TRAN !FILE_SPEC,SRC_SW,,,GVEC+VEC_Q_FSDESC $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_BADSOURCE $STATE SRC_SW $TRAN '/',SWITCH_S $TRAN TPA$_EOS,TPA$_EXIT $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_ENDJNK $STATE SWITCH_S $TRAN 'ANSID',SRC_SW,CHECK_DUP,MTX_C_ANSID,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'ASCII',SRC_SW,CHECK_DUP,MTX_C_ASCII,- GVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'BLOCKSZ',BLKNUM_S,CHECK_DUP,,,QUAL_C_BLKSZ $TRAN 'CR',SRC_SW,PARSE_WARN,,,MTX_CCWARN $TRAN 'EBCDIC',SRC_SW,CHECK_DUP,MTX_C_EBCDIC,- GVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'FIXED',SRC_SW,CHECK_DUP,MTX_C_FIXED,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'FLAG_RECORDS',SRC_SW,,0,FLAG_QUAL $TRAN 'FORTRAN',SRC_SW,PARSE_WARN,,,MTX_CCWARN $TRAN 'NOFLAG_RECORDS',SRC_SW,,1,FLAG_QUAL $TRAN 'PIP10',SRC_SW,CHECK_DUP,MTX_C_PIP10,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'PRIME',SRC_SW,CHECK_DUP,MTX_C_PRIME,- GVEC+VEC_L_XLATE,QUAL_C_XLATE $TRAN 'RECLENGTH',RECNUM_S,CHECK_DUP,,,QUAL_C_RECSZ $TRAN 'REWIND',SRC_SW,,MTX_M_REWIND,GVEC+VEC_L_STS $TRAN 'RT11',SRC_SW,CHECK_DUP,MTX_C_RT11,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'SKIPFILE',SKIPNUM_S,CHECK_DUP,,,QUAL_C_SKP $TRAN 'VARIABLE',SRC_SW,CHECK_DUP,MTX_C_VARIABLE,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN 'VB',SRC_SW,CHECK_DUP,MTX_C_VB,- GVEC+VEC_L_RECFMT,QUAL_C_RECFMT $TRAN TPA$_LAMBDA,TPA$_FAIL,PARSE_ERR,,,MTX_UNKQUAL $STATE BLKNUM_S $TRAN !BLKNUMCOM,SRC_SW $STATE RECNUM_S $TRAN !RECNUMCOM,SRC_SW $STATE SKIPNUM_S $TRAN !SKIPNUMCOM,SRC_SW ; Parse table for a standard file spec $STATE FILE_SPEC $TRAN !NODE $TRAN TPA$_LAMBDA $STATE $TRAN !DEVICE,,STORE_DEV_NAME $TRAN TPA$_LAMBDA $STATE $TRAN !DIRECTORY $TRAN TPA$_LAMBDA $STATE $TRAN !FILE_NAME,TPA$_EXIT $TRAN TPA$_LAMBDA,TPA$_EXIT ; $STATE NODE $TRAN TPA$_SYMBOL $STATE $TRAN ':' $STATE $TRAN ':',TPA$_EXIT ; $STATE DEVICE $TRAN TPA$_SYMBOL $STATE $TRAN ':',TPA$_EXIT ; $STATE DIRECTORY $TRAN '[' $TRAN LANGBRK $STATE $TRAN !UIC_NAME $TRAN !DIRECT_NAME $STATE $TRAN ']',TPA$_EXIT $TRAN RANGBRK,TPA$_EXIT ; $STATE UIC_NAME $TRAN TPA$_DECIMAL $STATE $TRAN COMMA $STATE $TRAN TPA$_DECIMAL,TPA$_EXIT ; $STATE DIRECT_NAME $TRAN TPA$_STRING $TRAN '*' $STATE SUB_DIRECT $TRAN '.' $TRAN TPA$_LAMBDA,TPA$_EXIT $STATE $TRAN TPA$_STRING,SUB_DIRECT $TRAN '*',SUB_DIRECT ; $STATE FILE_NAME $TRAN TPA$_STRING $TRAN '*' $STATE $TRAN '.' $TRAN TPA$_LAMBDA,TPA$_EXIT $STATE $TRAN TPA$_STRING $TRAN '*' $TRAN TPA$_LAMBDA,TPA$_EXIT $STATE $TRAN SEMI $TRAN TPA$_LAMBDA,TPA$_EXIT $STATE $TRAN TPA$_DECIMAL,TPA$_EXIT $TRAN '*',TPA$_EXIT $TRAN TPA$_LAMBDA,TPA$_EXIT .PAGE .SBTTL TPARSE Action routines .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; TPARSE action routines ; Register usage ; R0 - success/failure return status ; R1 - Scratch ; Routine to store a numeric value in the current vector ; The offset to receive the value is given by the parameter. .ENTRY STORE_VAL,^M<> ADDL3 TPA$L_PARAM(AP),- CURRENT_VEC,R1 ; Get address of destination in ; current vector MOVL TPA$L_NUMBER(AP),(R1) ; Store the value RET ; Return the success. ; Routine to store the skip count. The destination field has already ; been set to plus or minus one depending on the sign of this value. .ENTRY SKIP_STORE,^M<> MOVL CURRENT_VEC,R1 ; Get address of currrent vector MULL3 TPA$L_NUMBER(AP),- SKIP_SIGN,- VEC_L_SKP(R1) ; Multiply value times sign RET ; Return success ; Routine to reset the CURRENT_VEC when switching from processing ; the PUT file to the GET file .ENTRY RESET_CURVEC,^M<> MOVAL GVEC,CURRENT_VEC ; Change the address CLRL QUAL_FLAG ; Forget all qualifiers seen for other ; spec CLRL R0 ; Fake a failure so another transition ; is searched for RET ; Routine to issue an error message including the token matched at the ; error position .ENTRY PARSE_ERR,^M<> IF THEN ; If no message issued yet for this error, issue one MOVL TPA$L_PARAM(AP),R0 ; Get the error code IF THEN ; If AMBIG bit set, take this failure as an ambiguous keyword. MOVL #MTX_AMBIG,R0 ; Change error code ENDIF SIGNAL - ; Signal the error CODE1=R0,- F1= ; Signal the error CLRL R0 ; Fail the transition ENDIF RET ; Routine to issue a warning message and accept the transition .ENTRY PARSE_WARN,^M<> SIGNAL - CODE1=TPA$L_PARAM(AP),- F1= ; Signal the error MOVZWL #SS$_NORMAL,R0 ; Make this a match RET ; Routine to remember the device name as it is parsed .ENTRY STORE_DEV_NAME,^M<> MOVL CURRENT_VEC,R1 ; Get base of current vector MOVQ TPA$L_TOKENCNT(AP),- VEC_Q_DEVDESC(R1) ; Put descriptor into vector RET ; Routine to detect duplicate switches .ENTRY CHECK_DUP,^M<> BBCS TPA$L_PARAM(AP),- QUAL_FLAG,10$ ; Branch if not a duplicate SIGNAL - CODE1=#MTX_DUPCON,- F1= ; Signal the error MOVZBL #1,PARSE_MSG_FLAG ; Set message flag CLRL R0 10$: RET .PAGE .SBTTL MTEXCH - Main program .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY MTEXCH,^M ; Register usage: ; R0-R8 - Scratch ; R9 - Address of put file vector (PVEC) ; R10 - Address of get file vector (GVEC) ; R11 - Tape I/O index. Used to indicate which set of I/O data ; areas are in use during asynch. tape I/O. ; Initialization ; Open command file $OPEN FAB=IN_FAB ; Open command input file BLBS R0,10$ ; Branch if success BRW IN_ERR 10$: $CONNECT RAB=IN_RAB ; Connect record stream BLBS R0,20$ ; Branch if success BRW IN_ERR 20$: MOVAL PVEC,R9 ; Setup base registers for file MOVAL GVEC,R10 ; vectors CLRL R11 ; Use first set of tape I/O areas ; Get foreign command line CALL G^LIB$GET_FOREIGN,- CMD_BUF_DESC,- #0,- CMD_LEN ; Get the command IF THEN SIGNAL - CODE1=#MTX_BADFOR,- CODE2=R0 ; Signal the error BRW ERR_EXIT ENDIF IF THEN ; If no foreign command, BRW READ_A_CMD ; Go read one from input ENDIF ; Process current command PROCESS_CMD: MOVC5 #0,.,#0,#VEC_C_LENGTH,- (R10) ; Zero GET file vector MOVC5 #0,.,#0,#VEC_C_LENGTH,- (R9) ; Zero PUT file vector MOVL R9,CURRENT_VEC ; Parsing begins with PUT file vector CLRL QUAL_FLAG ; Clear flags of qualifiers seen CLRL PARSE_MSG_FLAG ; Clear "message issued" flag. CLRL FLAG_QUAL ; Set individual record warning status ; to /FLAG_RECORDS CLRL EXIT_FLAG ; Clear EXIT command flag MOVL CMD_LEN,- TPARSE_BLK+TPA$L_STRINGCNT ; Set command length for TPARSE IF THEN ; If null command BRW READ_A_CMD ; Go for another command ENDIF MOVAL CMD_BUF,- TPARSE_BLK+TPA$L_STRINGPTR ; likewise for command address CALL G^STR$UPCASE ,- TPARSE_BLK+TPA$L_STRINGCNT,- TPARSE_BLK+TPA$L_STRINGCNT ; Force the command to upper case CALL G^LIB$TPARSE,- TPARSE_BLK,- MTX_STATE,- MTX_KEY ; Parse the command IF THEN ; If unable to parse BRW READ_A_CMD ; Message already issued. Go again. ENDIF IF THEN BRW NORM_EXIT ; If EXIT command entered, exit. ENDIF ; Do one-time initialization for GET and PUT files BSBW SETUP_PUT ; Setup for PUT file IF THEN BRW READ_A_CMD ; If error, go for next command. ENDIF IF THEN ; If NOGET bit is set, no GET spec was seen in parsing the command. This ; is taken to be a request for positioning of the PUT file (tape) only. BRW READ_A_CMD ENDIF BSBW SETUP_GET ; Setup for GET file IF THEN BRW READ_A_CMD ; If error, go for next command ENDIF ; Verify that both the GET and PUT files do not reside on the same device ; type. IF AND - THEN SIGNAL - CODE1=#MTX_BOTHTAPE ; Issue error - both are tape BRW READ_A_CMD ENDIF IF AND - THEN SIGNAL - CODE1=#MTX_BOTHDISK ; Issue error - both are disk BRW READ_A_CMD ENDIF REPEAT ; Setup next PUT file BSBW NEXT_PUT ; Setup for next PUT file BREAK IF ; Break out if an error ; Setup next GET file BSBW NEXT_GET ; Determine next GET spec BREAK IF ; Break out if an error or no more ; files ; Copy the file we just set up CLRL BLK_CNT ; Clear record and block counts CLRL REC_CNT BSBW MOVE_RECORDS ; Go copy the file BREAK IF ; Break out if an error ; Close this set of files and issue statistics BSBW CLOSE_FILES ; Clean up this pair UNTIL ; All done if no wildcard ; If file left open, close them IF THEN BSBW CLOSE_FILES ; Close file pair ENDIF ; Deassign tape channel $DASSGN_S CHAN=MT_CHAN ; Prompt and read next command line READ_A_CMD: $GET RAB=IN_RAB ; Prompt and read BLBS R0,10$ ; Branch if success CMPL R0,#RMS$_EOF ; End of file? BNEQ IN_ERR ; If not, some other I/O error BRW NORM_EXIT ; Normal exit on EOF 10$: MOVZWL IN_RAB+RAB$W_RSZ,- CMD_LEN ; Set length of command BRW PROCESS_CMD ; and loop to process it .PAGE .SBTTL Exit branches ; IN_ERR taken if an error occurs on processing SYS$INPUT ; R0 contains the error code ; Issue a message and take ERR_EXIT path IN_ERR:: SIGNAL - CODE1=#MTX_CMDERR,- CODE2=R0 ; Signal the error BRB ERR_EXIT ; Do an error exit ; Branch to ERR_EXIT when it is not possible to continue. R0 ; contains the error code. Attempts to close everything and then ; exits with the error status. ERR_EXIT:: MOVL R0,R2 ; Save the condition value ; Close up everything. Don't check for errors $DASSGN_S - CHAN=MT_CHAN ; Deassign tape channel $CLOSE FAB=DISK_FAB ; Close disk file $CLOSE FAB=IN_FAB ; Close command input file BISL3 #STS$M_INHIB_MSG,- R2,R0 ; Restore condition value with ; inhibit message bit set RET ; Branch to NORM_EXIT for normal termination exit. Close command ; input file and make sure tape channel is deassigned. NORM_EXIT:: $DASSGN_S - CHAN=MT_CHAN ; Deassign tape channel $CLOSE FAB=IN_FAB ; Close command input file MOVL #SS$_NORMAL,R0 ; Signal successful completion RET .PAGE .SBTTL SETUP_GET - Do one-time setup for GET files ;++ ; Functional Description: ; This routine is used to do the one-time setup for all of the source ; or GET files which may be processed. This routine should perform ; any setup which must be done because the file (be it tape or disk) ; is a source of input. This routine therefore manipulates GVEC to ; set various attributes. ; ; Calling Sequence: ; BSBW SETUP_GET ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; GVEC - GET file vector. ; ; Implicit Outputs: ; GVEC - GET file vector. ; ; Procedures called: ; DEV_TYPE, DEFAULT_TAPE, DEFAULT_DISK, SYS$ASSIGN, MT_POSITION ; ; Completion Status: ; Returns condition values returned by any routines called. Error ; messages are issued for any error conditions encountered. ; ; Side Effects: ; If GET file is on tape, any requested tape positioning functions ; are done. ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R8 - Scratch ; R10 - Address of GET file vector (not modified) SETUP_GET:: MOVL R10,R6 ; Param is address of GET file vector BSBW DEV_TYPE ; Get device type info IF THEN SIGNAL - CODE1=#MTX_DEVTYPERR,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ENB_LONG ; Enable long branches in SMAC IF THEN ; GET file device is tape. Perform tape things. MOVC3 VEC_Q_FSDESC(R10),- @VEC_Q_FSDESC+4(R10),- VEC_T_FSPEC(R10) ; Move filespec into the vector MOVAL VEC_T_FSPEC(R10),- VEC_Q_FSDESC+4(R10) ; And adjust address in descriptor BISL2 #MTX_M_TAPE,- VEC_L_STS(R10) ; Set "tape" bit in status longword LOCC #^A/*/,- VEC_Q_FSDESC(R10),- @VEC_Q_FSDESC+4(R10) ; Is there a wildcard following the ; device name? IF THEN ; If one found BISL2 #MTX_M_WILD,- VEC_L_STS(R10) ; Set flag bit ENDIF ; Set default values for tape attributes and validate all attributes MOVL R10,R6 ; Param is address of GVEC BSBW DEFAULT_TAPE ; Set defaults for the tape file. IF THEN ; DEFAULT_TAPE issues own error RSB ; messages. Just return on error. ENDIF ; Setup translation table address if requested and if translating from ; something into ASCII IF AND - THEN SUBL3 #MTX_C_ASCII,- VEC_L_XLATE(R10),R0 ; Get character set code less ; base code MOVL TO_ASCII_VEC[R0],- VEC_L_XLATE(R10) ; Move table address into vector. ELSE CLRL VEC_L_XLATE(R10) ; Clear any unprocessed character ; set codes ENDIF ; Assign channel on tape device $ASSIGN_S - DEVNAM=VEC_Q_DEVDESC(R10),- CHAN=MT_CHAN ; Get a channel IF THEN ; If an error SIGNAL - CODE1=#MTX_ASGERR,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ; Do tape positioning functions if requested MOVL R10,R6 ; Param is address of GVEC BSBW MT_POSITION ; Do positioning IF THEN ; MT_POSITION issues own error RSB ; messages. Return the condition ; value. ENDIF ELSE ; GET file device is disk. ; Set default values for disk file attributes and validate all attributes. MOVL R10,R6 ; Param is address of GVEC BSBW DEFAULT_DISK ; Set attributes IF THEN ; DEFAULT_DISK issues own error RSB ; messages. Just return on error. ENDIF ; Do initial $PARSE of disk file spec. MOVB VEC_Q_FSDESC(R10),- DISK_FAB+FAB$B_FNS ; Set size and address of file spec MOVL VEC_Q_FSDESC+4(R10),- DISK_FAB+FAB$L_FNA ; into FAB $PARSE - FAB=DISK_FAB ; Do the parse IF THEN SIGNAL - CODE1=#MTX_DISKPARSE,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ; Record wildcard status in file vector IF THEN ; If wildcard BISL2 #MTX_M_WILD,- VEC_L_STS(R10) ; Set our wildcard bit ENDIF ENDIF DSB_LONG ; Disable long branches for SMAC MOVZWL #SS$_NORMAL,R0 ; Return success RSB .PAGE .SBTTL SETUP_PUT - Do one-time setup for PUT files ;++ ; Functional Description: ; This routine is used to do the one-time setup for all of the ; destination or PUT files which may be processed. This routine ; should perform any setup which must be done because the file ; (be it tape or disk) is a destination for data. This routine ; therefore manipulates PVEC to set various attributes. ; ; Calling Sequence: ; BSBW SETUP_PUT ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; PVEC - PUT file vector ; ; Implicit Outputs: ; PVEC - PUT file vector ; ; Procedures called: ; DEV_TYPE, DEFAULT_TAPE, DEFAULT_DISK, SYS$ASSIGN, MT_POSITION ; ; Completion Status: ; Returns condition values returned by any routines called. Error ; messages are issued for any error conditions encountered. If ; successful, SS$_NORMAL is returned. ; ; Side Effects: ; If PUT file is on tape, any requested tape positioning is done. ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R8 - Scratch. Modified. ; R9 - Address of PUT file vector (not modified) SETUP_PUT:: MOVL R9,R6 ; Param is address of PUT file vector BSBW DEV_TYPE ; Get device type info IF THEN SIGNAL - CODE1=#MTX_DEVTYPERR,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ENB_LONG ; Enable long branches for SMAC IF THEN ; PUT file device is tape. Perform tape things. MOVC3 VEC_Q_FSDESC(R9),- @VEC_Q_FSDESC+4(R9),- VEC_T_FSPEC(R9) ; Move filespec into the vector MOVAL VEC_T_FSPEC(R9),- VEC_Q_FSDESC+4(R9) ; And adjust address in descriptor BISL2 #MTX_M_TAPE,- VEC_L_STS(R9) ; Set "tape" bit in status longword LOCC #^A/*/,- VEC_Q_FSDESC(R9),- @VEC_Q_FSDESC+4(R9) ; Is there a wildcard in the ; device name? IF THEN SIGNAL - CODE1=#MTX_WILDERR,- F1= ; Signal the error CLRL R0 ; Return failure status RSB ENDIF ; Set default values for tape attributes and validate all attributes. MOVL R9,R6 ; Param is address of PVEC BSBW DEFAULT_TAPE ; Set defaults for the tape ; file IF THEN ; DEFAULT_TAPE issues own error RSB ; messages. Just return on error. ENDIF ; Setup the translation table address if requested and if translating ; to something besides ASCII. IF AND - THEN SUBL3 #MTX_C_ASCII,- VEC_L_XLATE(R9),R0 ; Get char set code less base code MOVL - FROM_ASCII_VEC[R0],- VEC_L_XLATE(R9) ; Move table address into vector ELSE CLRL VEC_L_XLATE(R9) ; Clear any unprocessed char set codes ENDIF ; Assign channel on tape device $ASSIGN_S - DEVNAM=VEC_Q_DEVDESC(R9),- CHAN=MT_CHAN ; Get a channel IF THEN ; If an error SIGNAL - CODE1=#MTX_ASGERR,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ; Do tape positioning functions if requested MOVL R9,R6 ; Param is address of PVEC BSBW MT_POSITION ; Do positioning IF THEN ; MT_POSITION issues own error RSB ; messages. Just return on error. ENDIF ELSE ; PUT file device is disk ; Set defaults for disk attributes and validate all attributes MOVL R9,R6 ; Param is address of PVEC BSBW DEFAULT_DISK ; Set attributes IF THEN ; DEFAULT_DISK issues own error RSB ; messages. Just return on error. ENDIF ; If disk record size is fixed, warn if tape record size exceeds it IF AND - THEN SIGNAL - CODE1=#MTX_FIXLONG ; Signal warning ENDIF ; Do initial $PARSE of disk file MOVB - VEC_Q_FSDESC(R9),- DISK_FAB+FAB$B_FNS ; Set size address of file spec MOVL VEC_Q_FSDESC+4(R9),- DISK_FAB+FAB$L_FNA $PARSE - FAB=DISK_FAB ; Parse the spec IF THEN SIGNAL - CODE1=#MTX_DISKPARSE,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ; Issue error if wildcard specified IF THEN ; If wildcard SIGNAL - CODE1=#MTX_WILDERR,- F1= ; Signal the error CLRL R0 ; Return failure status RSB ENDIF ENDIF DSB_LONG ; Disable long branches for SMAC MOVZWL #SS$_NORMAL,R0 ; Return success RSB .PAGE .SBTTL NEXT_GET - Setup next GET file ;++ ; Functional Description: ; Routine to setup next GET file. No work done if GET file is from ; tape. If GET file is disk, does $SEARCH to locate next (or ; only) instance of input file. Opens the file for read access. ; Does any error checking that requires data set by the $OPEN. ; This routine should do any file specific setting of FAB and RAB ; fields. ; ; Calling Sequence: ; BSBW NEXT_GET ; ; Input Parameters: ; R9 - Address of PUT file vector. ; R10 - Address of GET file vector. ; ; Output Parameters: NONE ; ; Implicit Inputs: ; DISK_FAB, DISK_RAB, DISK_NAM - RMS structures for disk file ; ; Implicit Outputs: ; Above RMS structures ; ; Procedures called: ; SYS$SEARCH, SYS$OPEN, SYS$CONNECT ; ; Completion Status: ; Returns RMS error code for last file operation attempted ; ; Side Effects: ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R3 - Scratch ; R9 - Address of PUT file vector (Not modified.) ; R10 - Address of GET file vector (Not modified.) NEXT_GET:: ENB_LONG ; Enable long branches for macros IF THEN ; GET file is from disk MOVAL DISK_FAB,R2 ; Get pointer to FAB BISB2 #FAB$M_GET,- FAB$B_FAC(R2) ; Access is read-only $SEARCH FAB=DISK_FAB ; Look for the file IF THEN IF THEN ; If error other than end of wildcards MOVZBL - DISK_NAM+NAM$B_RSL,- RSA_DESC ; Build desc for file spec SIGNAL - CODE1=#MTX_DISKPARSE,F1=,- CODE2=R0,F2= ; Signal error ENDIF RSB ENDIF $OPEN FAB=DISK_FAB ; Open the file IF THEN MOVZBL - DISK_NAM+NAM$B_RSL,- RSA_DESC ; Build desc for file spec SIGNAL - CODE1=#MTX_DISKPARSE,F1=,- CODE2=R0,F2= ; Signal error RSB ENDIF $CONNECT RAB=DISK_RAB ; Connect record stream IF THEN MOVZBL - DISK_NAM+NAM$B_RSL,- RSA_DESC ; Build desc for file spec SIGNAL - CODE1=#MTX_DISKPARSE,F1=,- CODE2=R0,F2= ; Signal error RSB ENDIF ; Perform any error checking that needs successful $OPEN MOVZWL DISK_XABFHC+XAB$W_LRL,R2 ; Get longest record length IF THEN IF OR - THEN ; Largest record cannot exceed blocksize for FIXED and ANSID formats MOVL #MTX_RECTOOBIG,R0 ; Signal and return error status SIGNAL - CODE1=R0 RSB ENDIF ENDIF IF AND - THEN ; Warn about records too long for fixed record size. SIGNAL - CODE1=#MTX_FIXLONG ENDIF IF AND - THEN ; Warn about records too long for ANSI format SIGNAL - CODE1=#MTX_ANSILONG ENDIF ENDIF DSB_LONG ; Disable long branches for macros RSB .PAGE .SBTTL NEXT_PUT - Setup next PUT file ;++ ; Functional Description: ; Routine to setup the next file to receive output. This corresponds ; to the next GET file specified. No work is needed if the PUT file ; is on tape. If it is on disk, the new file is $CREATE'd. Routine ; moves any file specific information from the file vector to the ; FAB and RAB. ; ; Calling Sequence: ; BSBW NEXT_PUT ; ; Input Parameters: ; R9 - Address of PUT file vector. ; ; Output Parameters: NONE ; ; Implicit Inputs: ; DISK_FAB, DISK_RAB, DISK_NAM - RMS structures for disk file ; ; Implicit Outputs: ; Above RMS structures. ; ; Procedures called: ; SYS$SEARCH, SYS$CREATE, SYS$CONNECT ; ; Completion Status: ; Returns RMS code for last file operation performed ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage ; R0-R3 - Scratch ; R9 - Address of PUT file vector (not modified) NEXT_PUT:: ENB_LONG ; Enable long branches for macros IF THEN ; PUT file is disk MOVAL DISK_FAB,R2 ; Get address of disk FAB BISB2 #FAB$M_PUT,- FAB$B_FAC(R2) ; We are going to write the file CVTLW VEC_L_RECSZ(R9),- FAB$W_MRS(R2) ; Set record size in FAB MOVB VEC_L_CC(R9),- FAB$B_RAT(R2) ; Set carriage control CVTLB VEC_L_RECFMT(R9),- FAB$B_RFM(R2) ; Set record format $CREATE - FAB=DISK_FAB ; Create the file BLBC R0,10$ ; Branch if error MOVAL DISK_RAB,R2 ; Point R2 at the RAB $CONNECT - RAB=DISK_RAB ; Connect a record stream BLBC R0,10$ ; Branch if an error BRB 20$ ; Issue message for error 10$: MOVZBL DISK_NAM+NAM$B_RSL,- RSA_DESC ; Build descriptor for file spec ASSUME FAB$L_STV EQ RAB$L_STV SIGNAL - CODE1=#MTX_DISKPARSE,- F1=,- CODE2=R0,- F2= ; Signal error 20$: ENDIF DSB_LONG ; Disable long branches for macros RSB .PAGE .SBTTL CLOSE_FILES - Close set of GET/PUT files ;++ ; Functional Description: ; This routine is used to perform end-of-file processing on a GET/PUT ; file pair. This consists of closing the file for a disk file and ; writing and EOF marker for a tape output file. This routine also ; performs the special processing for detecting an end-of-tape when ; doing a tape wildcard input. ; ; Calling Sequence: ; BSBW CLOSE_FILES ; ; Input Parameters: ; R9 - Address of PUT file vector ; R10 - Address of GET file vector ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R11 - Tape I/O index ; MT_CHAN, MT_IOSB - Tape I/O structures ; DISK_FAB - RMS structure for disk file ; REC_CNT, BLK_CNT - Record/block statistic counters ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$QIOW, SYS$CLOSE ; ; Completion Status: ; RMS or system return status from last I/O operation. ; ; Side Effects: ; May delete the last disk file created if it caused by ; the end_of_tape. ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R1 - Scratch ; R9 - Address of PUT file vector (not modified) ; R10 - Address of GET file vector (not modified) ; R11 - Tape I/O index (not modified) CLOSE_FILES:: ENB_LONG ;; Enable long branches for macros IF THEN ; PUT file is tape. ; Write double EOF to end the file and backup over last EOF $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- FUNC=#IO$_WRITEOF,- IOSB=MT_IOSB[R11] ; Do an EOF $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- FUNC=#IO$_WRITEOF,- IOSB=MT_IOSB[R11] ; Do an EOF $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- FUNC=#IO$_SKIPFILE,- P1=-1 ; Backspace $CLOSE FAB=DISK_FAB ; Close the disk file SIGNAL - CODE1=#MTX_COUNTSW,- F1=<@REC_CNT,@BLK_CNT> ; Issue block and record stats ELSE ; GET file is tape IF AND - THEN ; If doing wildcard input from tape, a zero length file is taken as the ; double end_of_file mark terminating the tape. The just created disk file ; is therefore bogus. BISL2 - #FAB$M_DLT,- DISK_FAB+FAB$L_FOP ; Set the DELETE bit for bogus disk ; file $CLOSE - FAB=DISK_FAB ; Close and delete it BICL2 - #MTX_M_WILD,- VEC_L_STS(R10) ; Done with wildcards ELSE ; Nothing to do for tape file. Just close disk file. $CLOSE - FAB=DISK_FAB ; Close disk file SIGNAL - CODE1=#MTX_COUNTSR,- F1=<@REC_CNT,@BLK_CNT> ; Issue block and record stats ENDIF ENDIF DSB_LONG ;; Disble long branches for macros RSB .PAGE .SBTTL DEFAULT_TAPE - Handle attributes for tape file ;++ ; Functional Description: ; This routine is called by whichever one-time initialization routine ; is processing the tape file. Here is handled all setup specific to ; the file which is on tape. We fill in any uninitialized fields in ; the file vector with the appropriate defaults for tape. Then we ; validate all the fields in the vector. ; ; Calling Sequence: ; MOVAL vector,R6 ; BSBW DEFAULT_TAPE ; ; Input Parameters: ; R6 - Address of file vector to be processed ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: ; Various fields in the specified vector are altered. ; ; Procedures called: NONE ; ; Completion Status: ; Returns SS$_NORMAL if all attributes are valid. Returns zero if ; invalid attributes are found. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage ; R0-R1 - Scratch ; R6 - Address of file vector being processed ; R7 - Condition value to be returned. DEFAULT_TAPE:: MOVZWL #SS$_NORMAL,R7 ; Assume success ; First set unspecified attributes. IF THEN MOVZWL - VEC_T_DEVCHAR+DIB$W_DEVBUFSIZ(R6),- VEC_L_BLKSZ(R6) ; For blocksize, use value from MOUNT ENDIF IF THEN MOVZWL - #DEF_TAPE_RECSZ,- VEC_L_RECSZ(R6) ; Supply default record size ENDIF IF THEN MOVZWL - #DEF_TAPE_RECFMT,- VEC_L_RECFMT(R6) ; Set default record format ENDIF ; Now validate all attributes in the vector ; Verify that blocksize is in range IF OR - THEN SIGNAL - CODE1=#MTX_BLKRANGE ; Signal the error CLRL R7 ; Set error flag ENDIF ; Verify that record size is in range IF THEN SIGNAL CODE1=#MTX_RECRANGE ; Issue error message CLRL R7 ; Set error flag ENDIF ; Verify that tape was mounted with requested blocksize MOVZWL VEC_T_DEVCHAR+DIB$W_DEVBUFSIZ(R6),- R2 ; Get blocksize used on MOUNT IF THEN SUBL3 VEC_L_BLKSZ(R6),R2,R1 ; Compute difference in sizes IF THEN ; /BLOCKSZ qualifier value greater than MOUNT blocksize. This can't work. SIGNAL - CODE1=#MTX_BLKRQERR,- F1=<@VEC_L_BLKSZ(R6),R2> ; Signal error CLRL R7 ; Set error status ELSE ; /BLOCKSZ qualifier less than MOUNT blocksize. This could be legitimate ; because MOUNT may have rounded up the blocksize without giving a warning. ; If the difference is more than the max roundup, we will issue a warning. IF THEN SIGNAL - CODE1=#MTX_BLKMISM,- F1=<@VEC_L_BLKSZ(R6),R2> ; Signal the error ENDIF ENDIF ENDIF ; If record format is PIP10, verify that blocksize is multiple of five. IF THEN DIVL3 #5,VEC_L_BLKSZ(R6),R0 ; Divide blocksize/5 MULL2 #5,R0 ; And multiply back IF THEN ; If unequal, not a multiple SIGNAL - CODE1=#MTX_PIP10BLK ; Signal error CLRL R7 ; Set error flag ENDIF ENDIF ; Bypass following tests if only tape positioning functions are being ; done. These block/record attributes are irrelevant if no copying ; is being done. IF THEN ; If a GET file specified ; If record format if FIXED, verify that blocksize is even multiple of ; record size. IF THEN DIVL3 VEC_L_RECSZ(R6),- VEC_L_BLKSZ(R6),- R0 ; Divide blocksize/recordsize MULL2 VEC_L_RECSZ(R6),R0 ; And multiply back IF THEN ; If unequal, not a multiple SIGNAL - CODE1=#MTX_FIXBLK,- F1=<@VEC_L_BLKSZ(R6),@VEC_L_RECSZ(R6)> ; Issue warning ENDIF ENDIF ENDIF ; Return accumulated error status MOVL R7,R0 RSB .PAGE .SBTTL DEFAULT_DISK - Handle attributes for disk ;++ ; Functional Description: ; This routine is called by whichever one-time initialization routine ; is processing the disk file. Here is handled all setup specific to ; the file which is on disk. We fill in any uninitialized fields in ; the file vector with the apropriate defaults for disk. Then we ; validate all the fields in the vector. ; ; Calling Sequence: ; MOVAL vector,R6 ; BSBW DEFAULT_DISK ; ; Input Parameters: ; R6 - Address of file vector to be processed ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: ; Various fields in specified vector are altered. ; ; Procedures called: NONE ; ; Completion Status: ; Returns SS$_NORMAL is all attributes are valid. Returns zero if ; invalid attributes are found. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage ; R0-R1 - Scratch ; R6 - Address of file vector being processed. ; R7 - Condition value to be returned. DEFAULT_DISK:: MOVZWL #SS$_NORMAL,R7 ; Assume success ; First set unspecified attributes IF THEN MOVZWL #DEF_DISK_RECFMT,- VEC_L_RECFMT(R6) ; Supply default record format ENDIF IF THEN MOVL #FAB$M_CR,- VEC_L_CC(R6) ; Default carriage control to CR ENDIF ; Default record size is left zero (unspecified) for disk files ; Now validate all attributes in the vector ; Issue warning if any blocksize specified IF THEN SIGNAL CODE1=#MTX_BLKIGN ; Issue warning ENDIF ; Verify that record size is in range IF THEN SIGNAL CODE1=#MTX_RECRANGE ; Issue error message CLRL R7 ; Set error flag ENDIF ; Issue warning if /REWIND or /SKIPFILE specified IF OR - THEN SIGNAL CODE1=#MTX_POSIGN ; Issue warning ENDIF ; Error if unsupported record format on disk IF AND - THEN SIGNAL CODE1=#MTX_UNSUPFMT ; Issue error message CLRL R7 ; Set error flag ENDIF ; Issue warning if disk file specified as non-ASCII IF AND - THEN SIGNAL CODE1=#MTX_ONLYASC ; Issue warning ENDIF CLRL VEC_L_XLATE(R6) ; Clear out any character set code ; Return accumulated error status MOVL R7,R0 RSB .PAGE .SBTTL MT_POSITION - Do positioning functions for tape ;++ ; Functional Description: ; This routine performs any tape rewinding or file skipping as specified ; in the file vector passed as a parameter. ; ; Calling Sequence: ; MOVAL vector,R6 ; BSBW MT_POSITION ; ; Input Parameters: ; R6 - Address of file vector to be processed ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R11 - Tape I/O index ; ; Implicit Outputs: ; MT_IOSB[R11] - Left with status of last QIO ; ; Procedures called: ; SYS$QIOW, QIO_ERR_CHK ; ; Completion Status: ; Returns SS$_NORMAL if all requests successful. Returns error from ; $QIOW or from IOSB if an error. Error messages are issued for any ; I/O errors. ; ; Side Effects: ; Tape position may be altered. ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R2 - Scratch ; R6 - Address of file vector being processed. ; R11 - Tape I/O index (not modified) MT_POSITION:: MOVZWL #SS$_NORMAL,R0 ; Assume success in case there's no ; work ; Do rewind if requested ENB_LONG ;; Enable long branches for macros IF THEN $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- FUNC=#IO$_REWIND,- IOSB=MT_IOSB ; Do the rewind BSBW QIO_ERR_CHK ; Handle any errors IF THEN RSB ; Return if any errors found ENDIF ENDIF ; Do file skipping if requested IF THEN IF THEN DECL VEC_L_SKP(R6) ; If skip count negative, bump by one ENDIF $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- IOSB=MT_IOSB[R11],- FUNC=#IO$_SKIPFILE,- P1=@VEC_L_SKP(R6) ; Do the skip BSBW QIO_ERR_CHK ; Handle any I/O errors IF THEN RSB ; Return if any errors ENDIF IF THEN ; For negative skips, we are positioned just before the end of the file ; before the desired one, or we are at BOT. MNEGL VEC_L_SKP(R6),R1 ; Get ABS(skip count) MOVAQ MT_IOSB[R11],R0 ; Get address of IOSB field IF THEN ; Does skip count match nr of EOF's ; skipped? ; If so, skip one EOF to reach desired position. Otherwise, we must ; be at BOT. $QIOW_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- IOSB=MT_IOSB[R11],- FUNC=#IO$_SKIPFILE,- P1=1 ; Skip one EOF BSBW QIO_ERR_CHK ; Handle any I/O errors IF THEN RSB ; Return if any errors ENDIF ENDIF ENDIF ENDIF DSB_LONG ;; Disable long branches RSB .PAGE .SBTTL QIO_ERR_CHK - Check for error on tape QIO ;++ ; Functional Description: ; This routine is called when it is desired to check the success ; of a $QIOW operation on the tape device. We check R0 to see if ; the $QIOW was successfully executed. Then the IOSB checked to ; see if the I/O operation successfully completed. R0 is set to ; the $QIOW or IOSB contents if an error is detected. ; Note this routine cannot be used for the asynch. tape I/O. ; ; Calling Sequence: ; $QIOW_S....... ; BSBW QIO_ERR_CHK ; ; Input Parameters: ; R0 - Condition value from $QIOW. ; R6 - Address of vector for tape file. ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R11 - Tape I/O index ; ; Implicit Outputs: NONE ; ; Procedures called: NONE ; ; Completion Status: ; R0 is returned unchanged if a $QIO error was detected. R0 contains ; the error status from the IOSB if the I/O failed. Otherwise, ; the input value from R0 is returned. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0 - Input/output parameter. ; R1-R2 - Scratch ; R6 - Input parameter. Address of vector for tape file ; R11 - Tape I/O index (not modified) QIO_ERR_CHK:: ; Check status of system service call IF THEN SIGNAL - CODE1=#MTX_QIOERR,- F1=,- CODE2=R0 ; Signal the error ELSE ; $QIOW worked. Now see if I/O completed successfully. MOVAQ MT_IOSB[R11],R0 ; Get address of IOSB MOVZWL - (R0),R0 ; Get completion status from IOSB IF AND - THEN ; If I/O error SIGNAL - CODE1=#MTX_TIOFAIL,- F1=,- CODE2=R0 ; Signal error ENDIF ENDIF RSB ; Return error status if any .PAGE .SBTTL DEV_TYPE - Determine type info for a device ;++ ; Functional Description: ; This routine is called by the one-time setup routines to determine ; the type of the device they are setting up. This type is ; either disk or tape and is returned by filling in the device ; characteristics buffer (VEC_T_DEVCHAR) in the vector passed as ; a parameter. The buffer if filled with all the information obtained ; by doing a $GETDEV service on the device name. The device name ; is obtained by doing a complete logical name translation on the ; device name specified by the VEC_Q_DEVDESC field of the vector. ; If this field is not filled in, there is no explicit device name ; in the file spec. An attempt is made to translate the entire file ; spec as a logical name. If this fails, the file is assumed to reside ; on the default disk device. ; ; Calling Sequence: ; MOVAL vector,R6 ; BSBW DEV_TYPE ; ; Input Parameters: ; R6 - Address of file vector for file to be processed. ; ; Output Parameters: NONE ; ; Implicit Inputs: ; DEF_DISK - Descriptor of default disk string. ; ; Implicit Outputs: ; VEC_T_DEVDESC, VEC_T_DEVNAME, and VEC_T_DEVCHAR fields of input ; file vector are set. ; ; Procedures called: ; SYS$TRNLOG, SYS$GETDEV ; ; Completion Status: ; Returns any condition values from SYS$TRNLOG or SYS$GETDEV otherwise ; returns SS$_NORMAL. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R5 - Scratch ; R6 - Address of file vector being processed ; R8 - Address of temporary descriptor built on the stack DEV_TYPE:: IF THEN ; No device name obtained from vector. Try translating the entire file spec. MOVZWL #EQUIV_NAME_SZ,- VEC_Q_DEVDESC(R6) ; Build desc of device name buffer MOVAL VEC_T_DEVNAME(R6),- VEC_Q_DEVDESC+4(R6) $TRNLOG_S - LOGNAM=VEC_Q_FSDESC(R6),- RSLLEN=VEC_Q_DEVDESC(R6),- RSLBUF=VEC_Q_DEVDESC(R6) ; Try translation. IF THEN ; If not completely successful, assume device is default disk. MOVQ DEF_DISK,- VEC_Q_DEVDESC(R6) ; Point descriptor at def disk string ENDIF ENDIF ; Now we are sure we have some sort of device name located by the descriptor ; in the vector. Move the name into the vector so we can use a fixed ; descriptor to point to the name MOVC3 VEC_Q_DEVDESC(R6),- @VEC_Q_DEVDESC+4(R6),- VEC_T_DEVNAME(R6) ; Move the name MOVAL VEC_T_DEVNAME(R6),- VEC_Q_DEVDESC+4(R6) ; And adjust descriptor to point to it SUBL2 #8,SP ; Allocate space for output descriptor MOVL SP,R8 ; R8 points to this desc. MOVZWL #EQUIV_NAME_SZ,(R8) ; Make this desc point to the space MOVAL VEC_T_DEVNAME(R6),4(R8) ; in the vector REPEAT ; Strip off anything after a device name (including colon) LOCC #^A/:/,- VEC_Q_DEVDESC(R6),- @VEC_Q_DEVDESC+4(R6) ; Look for the colon (R0 is nr of ; chars after end of name) SUBW2 R0,- VEC_Q_DEVDESC(R6) ; Shorten string to stop after colon $TRNLOG_S - LOGNAM=VEC_Q_DEVDESC(R6),- RSLLEN=VEC_Q_DEVDESC(R6),- RSLBUF=(R8) ; Translate current name overwriting ; old name in file vector. BREAK IF OR - ; Stop if all done or error UNTIL ; Loop doing repeated translation ; All translations done or an error occured. IF THEN ; If no error MOVZWL - #DIB$K_LENGTH,(R8) ; Reuse temp descriptor to point MOVAL VEC_T_DEVCHAR(R6),4(R8) ; to device char buffer $GETDEV_S - DEVNAM=VEC_Q_DEVDESC(R6),- PRIBUF=(R8) ; Get device type and other info ENDIF ADDL2 #8,SP ; Free stack space used. RSB ; Return current condition value in R0 .PAGE .SBTTL MOVE_RECORDS - Move all records from source to dest ;++ ; Functional Description: ; This routine is called to move all records from the currently open ; source file to the currently open destination file. ; This routine also establishes a condition handler to be while ; record processing is in progress. This handler is used to trap ; the individual record warning messages as controlled by the ; /FLAG_RECORDS qualifier. ; ; Calling Sequence: ; BSBW MOVE_RECORDS ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R10 - Address of GET file vector ; R11 - Tape I/O index ; MT_EFN ; ; Implicit Outputs: ; R11 - Tape I/O index ; ; Procedures called: ; DISK_TO_TAPE, TAPE_TO_DISK, FLUSH_BLK, SYS$SETEF, SYS$WAITFR ; ; Completion Status: ; Returns any status returned by the routines called. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R10 - Address of GVEC (Not modified) ; R11 - Tape I/O index MOVE_RECORDS:: MOVAB WARN_HANDLER,(FP) ; Establish handler $SETEF_S - EFN=MT_EFN ; Set tape I/O event flags $SETEF_S - EFN=MT_EFN+4 ; to known state MOVW #SS$_NORMAL,- MT_IOSB ; Likewise with IOSB's MOVW #SS$_NORMAL,- MT_IOSB+8 IF THEN ; GET file is tape. Go move records from tape to disk. BSBW TAPE_TO_DISK ELSE ; GET file is disk. Go move records from disk to tape. BSBW DISK_TO_TAPE IF THEN BSBW FLUSH_BLK ; If copy worked, flush last buffer. ENDIF ENDIF ; Wait for all asynch I/O to complete. $WAITFR_S - EFN=MT_EFN $WAITFR_S - EFN=MT_EFN+4 CLRL R11 ; Reset tape I/O index to known state CLRL (FP) ; Remove handler RSB ; Condition handler for handling warning messages ; Resignals all conditions, except for warnings. Warnings are ignored only ; if the /NOFLAG_RECORDS qualifier has been given as indicated by a non-zero ; FLAG_QUAL. .ENTRY WARN_HANDLER,^M<> MOVL CHF$L_SIGARGLST(AP),R0 ; Get signal argument list EXTZV #STS$V_SEVERITY,- #STS$S_SEVERITY,- CHF$L_SIG_NAME(R0),R0 ; Extract severity code IF AND - THEN MOVL #SS$_CONTINUE,R0 ; Ignore warnings ELSE MOVL #SS$_RESIGNAL,R0 ; Resignal all others ENDIF RET .PAGE .SBTTL DISK_TO_TAPE - Move all records from disk to tape ;++ ; Functional Description: ; This routine is used when the source file is disk and the destination ; file is tape. It moves all records from the currently open disk file ; to the tape. ; ; Calling Sequence: ; BSBW DISK_TO_TAPE ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PUT file vector ; R10 - Address of GET file vector ; R11 - Tape I/O index ; REC_CNT, BLK_FIL_LC, BLK_FIL_PTR, MT_BUF_ADR ; ; Implicit Outputs: NONE ; ; Procedures called: ; FILL_BLK_XLAT, FILL_BLK ; ; Completion Status: ; Returns SS$_NORMAL or RMS error codes. Any I/O errors are signalled. ; RMS$_EOF is considered success. ; ; Side Effects: NONE ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG ; Local storage used to process ANSID records ANSI_BUF: .BLKB 4 ; Buffer for record length string ANSI_BUF_D: .LONG 4 ; Descriptor for above .ADDRESS ANSI_BUF ANSI_FAO: .ASCID /!4ZW/ ; Local storage used to process VB records VB_BUF: .BLKB 4 ; Buffer for record descriptor .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R8 - Scratch ; R9 - Address of PVEC (Not modified) ; R10 - Address of GVEC (Not modified) ; R11 - Tape I/O index DISK_TO_TAPE:: ; Setup block buffer status MOVL MT_BUF_ADR[R11],- BLK_FIL_PTR ; Set fill ptr to beginning of current ; buffer MOVL VEC_L_BLKSZ(R9),- BLK_FIL_LC ; All characters in block available ; Dispatch based on tape record type CASEL VEC_L_RECFMT(R9),#1,#MTX_C_MAXRFMT 10$: .WORD FIX_RTB-10$ .WORD VAR_RTB-10$ .WORD RT11_RTB-10$ ; RT-11 .WORD RT11_RTB-10$ ; PIP-10 .WORD ANSID_RTB-10$ .WORD VB_RTB-10$ ; Here if bad record format code MOVL #MTX_INTERRRFM,R0 ; Return internal error status SIGNAL - CODE1=R0 RSB ENB_LONG ;; Enable long branches for macros ; Handle FIXED format records ; Record length and format come from PVEC FIX_RTB:: REPEAT $GET RAB=DISK_RAB ; Get next record IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Remap EOF to success ELSE SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal error ENDIF RSB ENDIF MOVL VEC_L_RECSZ(R9),R6 ; Get fixed record length MOVAB REC_BUF,R7 ; Get buffer address IF THEN ; Block too full to hold this record. Flush it an put record in next block. BSBW FLUSH_BLK ; Flush buffer IF THEN RSB ENDIF ENDIF IF THEN ; Record shorter than fixed length. Blank fill it. MOVC5 DISK_RAB+RAB$W_RSZ,- (R7),#^A/ /,- R6,(R7) ; Blank fill ELSE IF THEN ; If input record too long, issue warning ADDL3 #1,REC_CNT,R2 ; Compute current record number SIGNAL - CODE1=#MTX_OUTTRUN,- F1= ; Signal the warning ENDIF ENDIF BSBW FILL_BLK_XLAT ; Move record to block buffer w/ INCL REC_CNT ; Count the record ; translation if needed. UNTIL ; Loop through all records RSB ; Return with any error status ; Handle VARIABLE records. VAR_RTB:: REPEAT $GET RAB=DISK_RAB ; Get the next record IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Remap EOF to success ELSE SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal error ENDIF RSB ENDIF ; Stuff 2 byte binary length into buffer. IF THEN BSBW FLUSH_BLK ; If no room, flush the block IF THEN RSB ; Return is error ENDIF ENDIF MOVAB DISK_RAB+RAB$W_RSZ,R7 ; Point to binary length MOVZBL #2,R6 ; Length of count is two bytes BSBW FILL_BLK ; Move bytes to buffer. No translation. IF THEN RSB ; Return if error ENDIF ; Stuff the data into the buffer MOVZWL DISK_RAB+RAB$W_RSZ,R6 ; Get record length MOVAB REC_BUF,R7 ; Point to start of buffer BSBW FILL_BLK_XLAT ; Move data w/ translation INCL REC_CNT ; Count the record UNTIL ; Loop thru all records on file RSB ; Return with any status ; Handle RT11 and PIP10 type records RT11_RTB:: REPEAT $GET RAB=DISK_RAB ; Get the next record IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Remap EOF to success ELSE SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal error ENDIF RSB ENDIF MOVZWL DISK_RAB+RAB$W_RSZ,R6 ; Get record length MOVAB REC_BUF,R7 ; Point to the data BSBW FILL_BLK_XLAT ; Move and translate data IF THEN RSB ; Return if error ENDIF MOVL #2,R6 ; Terminatior is 2 characters. MOVAB RT11TERM,R7 ; Point to terminatior BSBW FILL_BLK_XLAT ; Move data w/ translation INCL REC_CNT ; Count the record. UNTIL ; Loop thru all records in file RSB ; Return with any status ; Handle ANSI D format records ANSID_RTB:: REPEAT $GET RAB=DISK_RAB ; Get the next record IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Remap EOF to success ELSE SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal error ENDIF RSB ENDIF MOVZWL DISK_RAB+RAB$W_RSZ,R2 ; Get record length ADDL2 #4,R2 ; plus 4 for length string IF THEN ; Limit of 9999 char records for ANSI_D ADDL3 #1,REC_CNT,R3 ; Compute current record count SIGNAL - CODE1=#MTX_ANSITRUN,- F1= ; Signal the warning MOVZWL #9999,R2 ; Truncate the record ENDIF $FAO_S - CTRSTR=ANSI_FAO,- OUTBUF=ANSI_BUF_D,- P1=R2 ; Format record length string IF THEN SIGNAL - CODE1=#MTX_ANSIFAO,- CODE2=R0 ; Signal the error RSB ; Return with status ENDIF PUSHL R2 ; Save the (truncated) record length IF THEN ; If record won't fit in this block, pad and flush block. BSBW PAD_BLK IF THEN POPL R2 ; Cleanup stack RSB ENDIF ENDIF ; Move the record length string to the buffer MOVL #4,R6 ; Point to length string MOVAL ANSI_BUF,R7 BSBW FILL_BLK_XLAT ; Move the string POPL R6 ; Restore saved record length IF THEN ; If error moving string RSB ; Return with status ENDIF ; Move the data to the buffer. SUBL2 #4,R6 ; Data really 4 bytes shorter than ; record length MOVAL REC_BUF,R7 ; Point at the data BSBW FILL_BLK_XLAT ; Move the data INCL REC_CNT ; Count this record UNTIL ; Loop thru records. RSB ; Return with any status ; Handle VB format records VB_RTB:: ; Leave space in first block for block descriptor CLRL @BLK_FIL_PTR ; Zero the space ADDL2 #4,BLK_FIL_PTR ; and adjust pointer and length SUBL2 #4,BLK_FIL_LC REPEAT $GET RAB=DISK_RAB ; Get the next record IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Remap EOF to success ELSE SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal error ENDIF RSB ENDIF ; Stuff record descriptor into buffer MOVZWL DISK_RAB+RAB$W_RSZ,R5 ; Get length of data ADDL2 #4,R5 ; Plus length of descriptor IF THEN BSBW FLUSH_BLK ; If no room, flush block IF THEN RSB ENDIF ENDIF MOVB R5,VB_BUF+1 ; Store LSB of length into buffer ASHL #-8,R5,R5 ; Get MSB into low order byte MOVB R5,VB_BUF ; Store MSB, thus reversing count MOVZBL #4,R6 ; Length of record desc MOVAB VB_BUF,R7 ; and address of record desc BSBW FILL_BLK ; Move descriptor w/o translation IF THEN RSB ; Return if error ENDIF ; Stuff the data into the buffer MOVZWL - DISK_RAB+RAB$W_RSZ,R6 ; Get data length MOVAB REC_BUF,R7 ; Point to start of buffer BSBW FILL_BLK_XLAT ; Move data with translation INCL REC_CNT ; Count the record UNTIL ; Loop through all records on ; file RSB ; Return with any status DSB_LONG ;;Disable long branches for macros .PAGE .SBTTL FILL_BLKxxx - Store bytes in tape block buffer ;++ ; Functional Description: ; This routine moves a specified number of bytes into the tape block ; buffer. If the data will not fit into the current buffer, it ; is written and the remaining data is placed into the next block. ; If a record format does not permit spanned blocks the routine which ; calls here must make sure the data will fit into the current buffer. ; This routine is actually two entry points: FILL_BLK which moves ; the data without translation (used for binary data in the block) and ; FILL_BLK_XLAT which takes into account any translation specified for ; the data. ; ; Calling Sequence: ; MOVL length,R6 ; MOVL pointer,R7 ; BSBW FILL_BLK or BSBW FILL_BLK_XLAT ; ; Input Parameters: ; R6 - Length of data to be transferred ; R7 - Address of data to be transferred ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PUT file vector ; FROM_ASCII_VEC, BLK_FIL_PTR, BLK_FIL_LC, BLK_BUF ; ; Implicit Outputs: ; BLK_FIL_LC, BLK_FIL_PTR ; ; Procedures called: ; FLUSH_BLK ; ; Completion Status: ; Returns SS$_NORMAL, or RMS error code from flushing block. ; ; Side Effects: NONE ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG XLAT_ADR_F: .BLKL 1 ; Space for translation table address .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R5, R8 - Scratch ; R6-R7 - Input parameters. Modified. ; R9 - Address of PUT file vector (not modified) FILL_BLK_XLAT:: ; Fill block buffer with optional translation MOVL VEC_L_XLATE(R9),- XLAT_ADR_F ; Get translation table address BRB FILL_BLK_COM FILL_BLK:: ; Fill block with no translation CLRL XLAT_ADR_F ; Zero implies no translation FILL_BLK_COM:: WHILE DO ; While data remains to be moved MOVL BLK_FIL_LC,R8 ; Get nr of free bytes in buffer ; To be used as destination length IF THEN ; If there is enough space for data MOVL R6,R8 ; Make dest length same as source ENDIF IF THEN ; If a translation needed MOVTC R6,(R7),- #^A/ /,@XLAT_ADR_F,R8,- @BLK_FIL_PTR ; Move data with translation ELSE MOVC5 R6,(R7),#^A/ /,R8,- @BLK_FIL_PTR ; Move text with no translation ENDIF SUBL2 R8,BLK_FIL_LC ; Update buffer byte count ADDL2 R8,BLK_FIL_PTR ; and next free byte pointer ; MOVxx left R0 and R1 set to ; remaining data. MOVL R0,R6 ; Update remaining length MOVL R1,R7 ; Update pointer to data IF THEN BSBW FLUSH_BLK ; Flush the current block IF THEN RSB ; Return if error ENDIF ENDIF ENDWHILE MOVZBL #1,R0 ; Signal success RSB .PAGE .SBTTL FLUSH_BLK - Write block buffer to tape ;++ ; Functional Description: ; This routine initiates a write of the current buffer contents to ; tape. It then switches buffers and if the previous write was ; successful, returns the empty buffer. ; This routine also handles any special conversion or compression that ; must be done on the entire block, such as PIP10 formatting or block ; descriptors. ; ; Calling Sequence: ; BSBW FLUSH_BLK ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PUT file vector ; R11 - Tape I/O index ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF, BLK_CNT ; ; Implicit Outputs: ; R11 - Tape I/O index ; BLK_FIL_LC, BLK_FIL_PTR ; ; Procedures called: ; PAK10, SYS$QIO, SYS$WAITFR ; ; Completion Status: ; Returns error status from QIO operation. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R3 - Scratch ; R9 - Address of PVEC (Not modified) ; R11 - Tape I/O index (modified) FLUSH_BLK:: SUBL3 BLK_FIL_LC,- VEC_L_BLKSZ(R9),R2 ; Compute nr of bytes in block MOVL MT_BUF_ADR[R11],R3 ; Get address of full buffer IF THEN CALL PAK10 R2,- R3 ; If PIP10 tape, do buffer packing ENDIF IF THEN ; If a VB record format, must fill in the space left for the block ; Note that the least and most significant bytes of the count must ; be interchanged. MOVB R2,1(R3) ; LSB of block length into block ASHL #-8,R2,R0 ; Get MSB of block length MOVB R0,0(R3) ; Store it ENDIF $QIO_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- IOSB=MT_IOSB[R11],- FUNC=#IO$_WRITEVBLK,- P1=(R3),- P2=R2 ; Write the block IF THEN SIGNAL - CODE1=#MTX_QIOERR,- F1=,- CODE2=R0 ; Signal the error RSB ENDIF ; Time to switch buffers, etc. Must wait until last QIO on the new ; buffer finished. IF THEN ; Switch index INCL R11 ELSE CLRL R11 ENDIF $WAITFR_S - EFN=MT_EFN[R11] ; Wait for last use of this buffer MOVAQ MT_IOSB[R11],R0 ; Get address of that IOSB MOVZWL (R0),R0 ; Get I/O status from IOSB IF THEN SIGNAL - CODE1=#MTX_QIOERR,- F1=,- CODE2=R0 RSB ENDIF ; Reset buffer status MOVL VEC_L_BLKSZ(R9),- BLK_FIL_LC ; Make buffer empty MOVL MT_BUF_ADR[R11],- BLK_FIL_PTR ; Set fill pointer to start of buffer IF THEN ; Leave space for block descriptor CLRL @BLK_FIL_PTR ; Zero space for the descriptor ADDL2 #4,BLK_FIL_PTR ; Update pointer and length SUBL2 #4,BLK_FIL_LC ENDIF INCL BLK_CNT ; Count the block RSB .PAGE .SBTTL PAD_BLK - Pad remainder of current block ;++ ; Functional Description: ; This routine pads the unused bytes of the current block buffer ; with binary zeros. Since the block is then full, it calls ; FLUSH_BLK to write the block. ; ; Calling Sequence: ; BSBW PAD_BLK ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PVEC ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Implicit Outputs: ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Procedures called: ; FLUSH_BLK ; ; Completion Status: ; Returns error status from FLUSH_BLK ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R5 - Scratch ; R9 - Address of PVEC (Not modified) PAD_BLK:: MOVC5 #0,.,#ANSID_PAD_CH,- BLK_FIL_LC,- @BLK_FIL_PTR ; Zero fill buffer. CLRL BLK_FIL_LC ; Make buffer full BSBW FLUSH_BLK ; Flush the full buffer RSB .PAGE .SBTTL TAPE_TO_DISK - Move all records from tape to disk. ;++ ; Functional Description: ; This routine is used when the source file is on tape and the ; destination on disk. All records from the current tape file ; are copied to disk. ; ; Calling Sequence: ; BSBW TAPE_TO_DISK ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PUT file vector ; R10 - Address of GET file vector ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Implicit Outputs: ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF, REC_BUF ; ; Procedures called: ; NEW_BLK, EMPTY_BLK_XLAT, EMPTY_BLK ; ; Completion Status: ; Returns SS$NORMAL or RMS error codes. End of file is considered ; success. ; ; Side Effects: NONE ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG ANSID_SCR: .BLKB 4 ; Space for ANSI length string VB_SCR: .BLKB 4 ; Scratch space for VB and VARIABLE ; length fields .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R8 - Scratch ; R9 - Address of PVEC (Not modified) ; R10 - Address of GVEC (Not modified) TAPE_TO_DISK:: ; Setup block buffer status CLRL BLK_FIL_LC ; Mark buffer as empty MOVL MT_BUF_ADR[R11],- BLK_FIL_PTR ; Set fill ptr to beginning of ; first buffer to be filled. ; Start up first read to we will have data when we get there. BSBW FIRST_BLK ; Fire up first read IF THEN ; Return if error with QIO RSB ENDIF ; Dispatch based on tape record type CASEL VEC_L_RECFMT(R10),- #1,#MTX_C_MAXRFMT 10$: .WORD FIX_BTR-10$ .WORD VAR_BTR-10$ .WORD RT11_BTR-10$ ; RT-11 .WORD RT11_BTR-10$ ; PIP-10 .WORD ANSID_BTR-10$ .WORD VB_BTR-10$ ; Here is bad record format code MOVL #MTX_INTERRRFM,R0 ; Return internal error status SIGNAL - CODE1=R0 RSB ENB_LONG ;; Enable long branches for macros ; Handle FIXED format records FIX_BTR:: MOVL VEC_L_RECSZ(R9),R8 ; Get disk record size IF THEN MOVL VEC_L_RECSZ(R10),- R8 ; If no disk record size given, ; assume it is tape record size. ENDIF CVTLW R8,DISK_RAB+RAB$W_RSZ ; Set record size in RAB REPEAT MOVL VEC_L_RECSZ(R10),R6 ; Get tape record size IF AND - THEN ; A partial record remains in the buffer. Return it with a warning. SIGNAL - CODE1=#MTX_RECFRAG ; Give warning MOVL BLK_FIL_LC,R6 ; Adjust length to that of frag. ENDIF MOVAL REC_BUF,R7 ; Set destination address BSBW EMPTY_BLK_XLAT ; Get the record into REC_BUF IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Map end-of-file to success ENDIF RSB ENDIF $PUT RAB=DISK_RAB ; Write record to disk IF THEN SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal the error RSB ENDIF INCL REC_CNT ; Count the record UNTIL ; Handle VARIABLE format records VAR_BTR:: REPEAT IF THEN ; If not enough bytes left CLRL BLK_FIL_LC ; Discard remainder of this block ENDIF ; Get count field of record MOVZBL #2,R6 ; Count field is two bytes MOVL R6,R8 ; Return into two byte field MOVAB VB_SCR,R7 ; in scratch space BSBW EMPTY_BLK ; Get length/ no translation IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Map EOF to success ENDIF RSB ENDIF ; Get data part of record MOVZWL VB_SCR,R6 ; Record length given by count MOVL VEC_L_RECSZ(R9),R8 ; Get disk record length IF THEN ; If no disk record length MOVL R6,R8 ; Return complete record ENDIF IF THEN ; If record exceeds max allowed MOVL #MAX_REC_SZ,R8 ; Truncate it ENDIF CVTLW R8,DISK_RAB+RAB$W_RSZ ; Set actual record length in RAB MOVAB REC_BUF,R7 ; Point to buffer BSBW EMPTY_BLK_XLAT ; Get the data w/ optional translation IF THEN IF THEN MOVL #MTX_BADVARCNT,R0 ; EOF means bad length SIGNAL - CODE1=R0 ; Count was incorrect ENDIF RSB ENDIF $PUT RAB=DISK_RAB ; Write the record to disk IF THEN SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal the error RSB ENDIF INCL REC_CNT ; Count the record UNTIL ; Handle RT11 and PIP 10 format records RT11_BTR:: REPEAT MOVL VEC_L_RECSZ(R9),R8 ; Get output record size MOVAB RT11TERM,R5 ; Get terminator address MOVZBL #2,R6 ; Get terminator length MOVAB REC_BUF,R7 ; Get buffer address BSBW EMPTY_TO_TERM ; Return data up to but excluding ; terminator IF THEN IF THEN MOVL #SS$_NORMAL,R0 ; Map EOF to success ENDIF RSB ; Return if error ENDIF ; Record is in buffer. Write it to disk. Length returned in R8 CVTLW R8,- DISK_RAB+RAB$W_RSZ ; Set record length in RAB $PUT RAB=DISK_RAB ; Write the record IF THEN SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal the error RSB ENDIF INCL REC_CNT ; Count the record UNTIL ANSID_BTR:: REPEAT IF THEN ; If not enough bytes for a count CLRL BLK_FIL_LC ; Discard remainder of this block ENDIF MOVZBL #4,R6 ; Obtain next 4 bytes of data MOVL R6,R8 ; returned in 4 bytes MOVAB ANSID_SCR,R7 ; into scratch area BSBW EMPTY_BLK_XLAT ; Get the data IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Map EOF to success ENDIF RSB ENDIF IF THEN ; Four bytes of padding returned. Nothing left in this block CLRL BLK_FIL_LC ; Make the buffer empty ELSE ; Length string returned. Decode it. MOVAB ANSID_SCR,R0 ; Get address first digit MOVZBL #4,R1 ; Number of bytes to convert CLRL R6 ; Decode length into R6 CLRL R2 ; Clear scratch reg WHILE DO MULL2 #10,R6 ; Compute next decade SUBB3 #^A/0/,(R0)+,- R2 ; Get value of next digit IF OR THEN ; If not a digit, signal an error. ADDL3 #1,REC_CNT,R3 ; Compute record number MOVL #MTX_ANSIJNK,R0 SIGNAL - CODE1=R0,- F1= ; Signal the error RSB ENDIF ADDL2 R2,R6 ; Sum in this digit DECL R1 ; Decr count ENDWHILE SUBL2 #4,R6 ; Subtract off length of count field MOVAB REC_BUF,R7 ; Return data into record buffer MOVL VEC_L_RECSZ(R9),- R8 ; Set destination length IF THEN MOVL R6,R8 ; If no length specified, return it ; all ENDIF CVTLW R8,DISK_RAB+RAB$W_RSZ ; Set length of record in RAB BSBW EMPTY_BLK_XLAT ; Get the data IF THEN IF THEN MOVL #MTX_BADVARCNT,R0 ; If EOF, a count was bogus SIGNAL - CODE1=R0 ; Signal the error ENDIF RSB ENDIF $PUT RAB=DISK_RAB ; Write the record IF THEN SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal the error RSB ENDIF INCL REC_CNT ; Count the record ENDIF UNTIL ; Handle VB format records VB_BTR:: REPEAT IF THEN ; If not enough bytes left CLRL BLK_FIL_LC ; Discard remainder of block ENDIF ; Get count field of record MOVZBL #4,R6 ; Field is 4 bytes MOVL R6,R8 ; returned in 4 byte MOVAB VB_SCR,R7 ; scratch space. BSBW EMPTY_BLK ; Get length/ no translation IF THEN IF THEN MOVZWL #SS$_NORMAL,R0 ; Map EOF to success ENDIF RSB ENDIF ; Get data part of record CLRL R6 ; Clear space for length MOVB VB_SCR,R6 ; Get MSB of length ASHL #8,R6,R6 ; Position it MOVB VB_SCR+1,R6 ; Get LSB SUBL2 #4,R6 ; Subtract descriptor length MOVL VEC_L_RECSZ(R9),R8 ; Get disk record length IF THEN ; If no disk record length MOVL R6,R8 ; Return complete record ENDIF IF THEN MOVL #MAX_REC_SZ,R8 ; Truncate it ENDIF CVTLW R8,DISK_RAB+RAB$W_RSZ ; Start data length in RAB MOVAB REC_BUF,R7 ; Point to buffer BSBW EMPTY_BLK_XLAT ; Move the data IF THEN IF THEN MOVL #MTX_BADVARCNT,R0 ; EOF means a bad length SIGNAL - CODE1=R0 ; Signal that error ENDIF RSB ENDIF $PUT RAB=DISK_RAB ; Write the record IF THEN SIGNAL - CODE1=#MTX_DIOFAIL,- F1=,- CODE2=R0,- F2= ; Signal the error RSB ENDIF INCL REC_CNT ; Count the record UNTIL DSB_LONG ;; Disable macro long branches .PAGE .SBTTL EMPTY_BLKxxx - Remove bytes from tape block buffer ;++ ; Functional Description: ; This routine moves a specified number of bytes from the current ; tape block buffer. Source and destination lengths are supplied. ; The data source data is truncated or filled as required to match ; the destination length. If enough data is not available from the ; current buffer, the next tape block is read. If a record format ; does not allow spanned blocks, the calling routine must check the ; size of available data and handle accordingly. This routine actually ; has two entry points: EMPTY_BLK which moves the data without ; translation and EMPTY_BLK_XLAT which takes into account any ; translation specified. ; ; Calling Sequence: ; BSBW EMPTY_BLK_XLAT or EMPTY_BLK ; ; Input Parameters: ; R6 - Number of bytes of data to return ; R7 - Address to receive returned data ; R8 - Size of area to receive returned data ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R9 - Address of PUT file vector ; R10 - Address of GET file vector ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Implicit Outputs: ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Procedures called: ; NEW_BLK ; ; Completion Status: ; Returns SS$NORMAL or RMS error codes from reading a block. ; ; Side Effects: NONE ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG SEGMENT_LEN: .BLKL 1 ; Scratch location for length of ; this segment of transfer DEST_SEG_LEN: .BLKL 1 ; Scratch location for length of ; destination area for this segment ; of transfer XLAT_ADR_E: .BLKL 1 ; Translation table address .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R5 - Scratch. ; R6, R7 - Input parameters. Modified. ; R8 - Input parameter. Not modified. ; R9 - Address of PUT file vector (not modified) ; R10 - Address of GET file vector (not modified) EMPTY_BLK_XLAT:: ; Empty block buffer to record buffer with optional translation MOVL VEC_L_XLATE(R10),- XLAT_ADR_E ; Get translation table address BRB EMPTY_BLK_COM EMPTY_BLK:: ; Empty block buffer to record buffer. No translation. CLRL XLAT_ADR_E ; Zero implies no translation EMPTY_BLK_COM:: ; Verify that destination length is long enough for data. IF THEN ADDL3 REC_CNT,#1,R3 ; Compute record count SIGNAL - CODE1=#MTX_OUTTRUN,- F1= ; Signal warning ENDIF MOVL R8,DEST_SEG_LEN ; Set destination area length ENB_LONG ;; Enable long branches for macros WHILE DO ; If block buffer empty, read a block IF THEN BSBW NEW_BLK ; Read the block IF THEN RSB ; Return with error status ENDIF ENDIF ; Compute number of bytes we can move and move them MOVL R6,SEGMENT_LEN ; Move only what exists IF THEN ; Not enough bytes in theis buffer MOVL BLK_FIL_LC,SEGMENT_LEN ; Move only what exists ENDIF IF THEN MOVTC SEGMENT_LEN,@BLK_FIL_PTR,- #^A/ /,@XLAT_ADR_E,- DEST_SEG_LEN,(R7) ; Move with translation ELSE MOVC5 SEGMENT_LEN,@BLK_FIL_PTR,- #^A/ /,- DEST_SEG_LEN,(R7) ; Move w/o translation ENDIF SUBL2 SEGMENT_LEN,BLK_FIL_LC ; Update tape buffer byte count ADDL2 SEGMENT_LEN,BLK_FIL_PTR ; And next byte pointer ADDL2 SEGMENT_LEN,R7 ; Update pointer into record buffer SUBL2 SEGMENT_LEN,DEST_SEG_LEN ; and destination length SUBL2 SEGMENT_LEN,R6 ; Compute bytes remaining to xfer ENDWHILE DSB_LONG ; Disable long branches for macros ; Here when all done with transfer. MOVZWL #SS$_NORMAL,R0 ; Signal success RSB .PAGE .SBTTL EMPTY_TO_TERM - Remove bytes from tape block ;++ ; Functional Description: ; This routine is an alternate flavor of EMPTY_BLK_XLAT. It returns ; data upto a specified terminator. Multiple disk blocks may be ; processed to return the data. The maximum length of the returned ; data can be constrained. The terminator is not returned. ; The data is always returned translated if a translation is specified. ; ; Calling Sequence: ; BSBW EMPTY_TO_TERM ; ; Input Parameters: ; R5 - Address of terminator ; R6 - Length of terminator ; R7 - Address of return buffer ; R8 - Maximum length of record to return. If zero, return up to ; MAX_REC_SZ. ; ; Output Parameters: ; R8 - Actual length of returned data. ; ; Implicit Inputs: ; R10 - Address of GET file vector ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF ; ; Implicit Outputs: ; BLK_FIL_LC, BLK_FIL_PTR ; ; Procedures called: ; NEW_BLK ; ; Completion Status: ; Returns status returned by NEW_BLK. ; ; Side Effects: NONE ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG REC_FIL_LC: .BLKL 1 ; Nr of bytes remaining in rec buffer SEG_LEN: .BLKL 1 ; Length of this segment of record TERM_FLAG: .BLKL 1 ; Flag that terminator seen TERM_ADDR: .BLKL 1 ; Address of terminator string TERM_LEN: .BLKL 1 ; Length of terminator .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R4 - Scratch. ; R5-R7 - Input parameters. Modified. ; R8 - Input/output parameter. Modified. ; R10 - Address of GVEC (Not modified) EMPTY_TO_TERM:: MOVL R6,TERM_LEN ; Save terminator length MOVL R5,TERM_ADDR ; Save terminator address CLRL TERM_FLAG ; No terminator seen yet MOVL #MAX_REC_SZ,- REC_FIL_LC ; Set nr of free bytes in record buf ENB_LONG ;; Enable long brances for macros WHILE DO ; Loop until terminator seen ; Make sure there is data in the buffer. IF THEN ; If buffer empty BSBW NEW_BLK ; Get new block IF THEN RSB ; Return on error ENDIF ENDIF MATCHC - TERM_LEN,@TERM_ADDR,- BLK_FIL_LC,@BLK_FIL_PTR ; Look for terminator IF THEN ; Terminator found. SUBL3 BLK_FIL_PTR,R3,R6 ; Compute length of segment ; including terminator SUBL3 TERM_LEN,R6,R2 ; Compute length w/o terminator INCL TERM_FLAG ; Set terminator seen flag ELSE ; Terminator not found in the buffer. MOVL BLK_FIL_LC,R6 ; Segment length is rest of buffer MOVL R6,R2 ; Length same with and w/o terminator ENDIF MOVL R2,SEG_LEN ; Length w/o term is segment length IF THEN ; Is there enough room in buff for ; this segment? MOVL REC_FIL_LC,- SEG_LEN ; If not, use space available ENDIF IF THEN ; If no translation table MOVC3 - SEG_LEN,@BLK_FIL_PTR,- (R7) ; Move this segment into rec buffer ; w/o translation ELSE MOVTC - SEG_LEN,@BLK_FIL_PTR,- #^A/ /,@VEC_L_XLATE(R10),- SEG_LEN,(R7) ; Move this segment into rec buffer. ; with translation ENDIF ADDL2 SEG_LEN,R7 ; Update record buffer pointer SUBL2 SEG_LEN,REC_FIL_LC ; and record buffer free space ADDL2 R6,BLK_FIL_PTR ; Adjust block pointer SUBL2 R6,BLK_FIL_LC ; and block bytes remaining ENDWHILE ; Record all moved to record buffer. SUBL3 REC_FIL_LC,#MAX_REC_SZ,R2 ; Compute total record length ; If no return length given, return length as entire record. Otherwise, ; say we returned just what we were asked (R8). IF THEN MOVL R2,R8 ; Total record length ENDIF IF THEN ; Actual length greater the our limit. Signal truncation ADDL3 #1,REC_CNT,R3 ; Compute record number SIGNAL - CODE1=#MTX_OUTTRUN,- F1= ; Signal warning ENDIF IF THEN ; If requested length was longer than actual, blank fill record. SUBL3 R2,R8,R3 ; Compute fill length MOVC5 #0,.,#^A/ /,R3,(R7) ; Blank fill ENDIF MOVZWL #SS$_NORMAL,R0 ; Return success RSB DSB_LONG ;; Disable long branchs for macros .PAGE .SBTTL NEW_BLK - Read in new block from tape ;++ ; Functional Description: ; This routine returns a pointer to the next tape block in a buffer. ; It then switches buffers and queues a read to place the next ; block into the new buffer. This routine must be called first ; at its entry point FIRST_BLK, to initiate reading on a file. ; It also handles any special conversion or compression that ; must be done on the entire block, such as PIP10 formatting or ; block descriptors. ; ; Calling Sequence: ; BSBW NEW_BLK ; BSBW FIRST_BLK ; ; Input Parameters: NONE ; ; Output Parameters: NONE ; ; Implicit Inputs: ; R10 - Address of GET file vector ; R11 - Tape I/O index ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF, MT_CHAN, MT_IOSB ; ; Implicit Outputs: ; R11 - Tape I/O index ; BLK_FIL_LC, BLK_FIL_PTR, BLK_BUF, MT_IOSB ; ; Procedures called: ; SYS$QIO, UNPK10, SYS$WAITFR ; ; Completion Status: ; Returns error status from QIO operation. ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG ; Register usage: ; R0-R3 - Scratch. ; R10 - Address of GVEC (not modified) ; R11 - Tape I/O index (modified) NEW_BLK:: MOVL MT_BUF_ADR[R11],R3 ; Get address of full buffer $WAITFR_S - EFN=MT_EFN[R11] ; Wait for I/O in progress on that ; buffer to finish MOVAQ MT_IOSB[R11],R1 ; Get addr of IOSB for that transfer MOVZWL (R1),R0 ; Get completion status IF THEN IF THEN SIGNAL - CODE1=#MTX_TIOFAIL,- F1=,- CODE2=R0 ; If I/O error, signal. ENDIF RSB ENDIF MOVZWL 2(R1),R2 ; Get actual transfer length IF THEN ; PIP10 format requires unpacking block. CALL UNPK10 R2,R3 ; Unpack in place entire buffer ENDIF MOVL R2,BLK_FIL_LC ; Set length of buffer MOVL R3,BLK_FIL_PTR ; and point to first byte INCL BLK_CNT ; Count this block IF THEN ; For VB tapes, check block descriptor MOVB (R3)+,R0 ; Get MSB of length ASHL #8,R0,R0 ; Position it MOVB (R3),R0 ; Get LSB of length IF THEN SIGNAL - CODE1=#MTX_VBBLKCNT,- F1= ; Signal warning if desc is wrong. ENDIF ADDL2 #4,BLK_FIL_PTR ; Adjust pointer and length past desc SUBL2 #4,BLK_FIL_LC ENDIF ; Swap I/O structures and perform next read IF THEN ; Switch index INCL R11 ELSE CLRL R11 ENDIF FIRST_BLK:: ; Entry point for first call MOVL MT_BUF_ADR[R11],R3 ; Get new buffer address $QIO_S - EFN=MT_EFN[R11],- CHAN=MT_CHAN,- IOSB=MT_IOSB[R11],- FUNC=#IO$_READVBLK,- P1=(R3),- P2=#MAX_BLK_SZ ; Start a read IF THEN SIGNAL - CODE1=#MTX_QIOERR,- F1=,- CODE2=R0 ; If QIO error, signal it. RSB ENDIF MOVZWL #SS$_NORMAL,R0 ; Return success RSB .PAGE .SBTTL UNPK10 - Unpack a PIP10 format tape block ;++ ; Functional Description: ; Procedure to unpack a PIP10 format tape block into a normal character ; stream. ; Tapes produced by the PIP10 utility on a PDP10 consist of the 36 ; bit PDP10 word packed into 5 tape bytes as follows: ; byte 1 - bits 0-7 ; byte 2 - bits 8-15 ; byte 3 - bits 16-23 ; byte 4 - bits 24-31 ; byte 5 - 2 unused bits / bits 30-35 ; Characters on the PDP10 are 7 bit ASCII with the 35th bit in ; each word unused. This procedure will unpack the seven bit ; characters into eight bit characters taking care of the split ; and overlapped bits in bytes 4 and 5. The unpacking is done ; in place. ; ; Calling Sequence: ; CALLS #2, UNPK10 ; ; Input Parameters: ; 4(AP) - Length of buffer contents (bytes) ; 8(AP) - Address of buffer to be unpacked ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: NONE ; ; Completion Status: NONE ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY UNPK10,^M ; Register usage: ; R0 - Hold extracted characters ; R1 - Hold fifth byte of five byte sequence ; R2 - Number of bytes left to unpack (must be multiple of 5) ; R3 - Address of next byte in buffer ; R4 - First four bytes of sequence in reversed order MOVL 4(AP),R2 ; Get number of bytes to unpack MOVL 8(AP),R3 ; Point to the buffer ; Loop unpacking 5 bytes into 5 ASCII characters 10$: INSV (R3),#24,#8,R4 ; Reverse order of first INSV 1(R3),#16,#8,R4 ; four bytes in this sequence INSV 2(R3),#8,#8,R4 INSV 3(R3),#0,#8,R4 MOVZBL 4(R3),R1 ; Save fifth byte in safe place ASHL #-1,R1,R1 ; And drop unused bottom bit EXTZV #25,#7,R4,R0 ; Extract first char MOVB R0,(R3)+ ; Store it EXTZV #18,#7,R4,R0 ; Extract second char MOVB R0,(R3)+ ; Store it EXTZV #11,#7,R4,R0 ; Extract third char MOVB R0,(R3)+ ; Store it EXTZV #4,#7,R4,R0 ; Extract fourth char MOVB R0,(R3)+ ; Store it BICL #^XFFFFFFF0,R4 ; Isolate last 4 bits ASHL #3,R4,R4 ; Position last 4 bits for overlap BISB3 R4,R1,(R3)+ ; OR with adjusted fifth byte for last ; char SUBL2 #5,R2 ; Decr byte count BGTR 10$ ; Branch if work remains RET .PAGE .SBTTL PAK10 - Pack characters into a PIP10 format block ;++ ; Functional Description: ; Procedure to pack a normal character string into a PIP10 format ; block. ; Tapes produced by the PIP10 utility on a PDP10 consist of the 36 ; bit PDP10 word packed into 5 tape bytes as follows: ; byte 1 - bits 0-7 ; byte 2 - bits 8-15 ; byte 3 - bits 16-23 ; byte 4 - bits 24-31 ; byte 5 - 2 unused bits / bits 30-35 ; Characters on the PDP10 are 7 bit ASCII with the 35th bit in ; each word unused. This procedure will pack the low seven bits ; of 5 eight bit characters into 5 bytes to be written to tape. ; The overlap and unused bits are handled. The packing is done ; in place. ; ; Calling Sequence: ; CALLS #2, PAK10 ; ; Input parameters: ; 4(AP) - Length of buffer contents (bytes) ; 8(AP) - Address of buffer to be packed ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: NONE ; ; Completion Status: NONE ; ; Side Effects: NONE ; ;-- .PSECT RWDATA NOSHR,RD,WRT,NOEXE,LONG L_TMP: .LONG 0 ; One longword temp buffer .PSECT CODE RD,NOWRT,SHR,LONG,EXE .ENTRY PAK10,^M ; Register usage: ; R0 - Hold first four bytes being constructed ; R1 - Hold fifth byte being constructed ; R2 - Pointer to next byte in buffer ; R3 - Count of bytes remaining to convert MOVL 4(AP),R3 ; Get number of bytes to pack MOVL 8(AP),R2 ; Point to the buffer ; Loop packing 5 ASCII chars into 5 bytes in the buffer 10$: INSV (R2),#25,#7,L_TMP ; Pack first char in temp buffer INSV 1(R2),#18,#7,L_TMP ; second char INSV 2(R2),#11,#7,L_TMP ; third char INSV 3(R2),#4,#7,L_TMP ; fourth char MOVZBL 4(R2),R1 ; Pick up fifth char ROTL #-3,R1,R1 ; Position to get high order 4 bits INSV R1,#0,#4,L_TMP ; Insert last 4 bits MOVB L_TMP+3,(R2) ; Store the completed four bytes MOVB L_TMP+2,1(R2) ; in reversed order MOVB L_TMP+1,2(R2) MOVB L_TMP,3(R2) EXTZV #28,#4,R1,R1 ; Position remaining 3 bits and ; unused zero bit MOVB R1,4(R2) ; Store them, along with unused bits, ; zeroed overlap bits, and zero ; leftover bit ADDL2 #5,R2 ; Point to next five bytes SUBL2 #5,R3 ; Decrement count of remaining chars BGTR 10$ ; Loop while work remains RET .END MTEXCH