.TITLE TCOPY - TAPE COPY PROGRAM .IDENT /4.00/ .SUBTITLE MACRO AND SYMBOL DEFINITIONS ;***************************************************************** ; ; THIS PROGRAM WILL MAKE AN IDENTICAL COPY OF A MAGNETIC TAPE. ; IT COPIES PHYSICAL RECORDS USING A DOUBLE BUFFERING SCHEME. ; IT WILL STOP WHEN IT ENCOUNTERS A DOUBLE EOF, BUT WILL GIVE THE ; OPTION TO CONTINUE. ALL ERRORS ARE REPORTED, BUT THE PROGRAM WILL ; GIVE THE OPTION TO CONTINUE IN SPITE OF ERRORS. ; ; AUTHOR : UNKNOWN DECUS WIZARD ; ; MODIFIED BY R. VENHOLA, 22-JUN-1988 VERSION 4.0 ; ; 1. FIXED A BUG WHEN COPYING TAPES THAT START WITH AN EOF MARK : THE ; PROGRAM WOULD NOT WRITE OUT THE EOF MARK, BUT SKIP IT AND START ; WRITING RECORDS ; 2. ADDED A CHECK FOR BATCH MODE ; 3. ON A PARITY ERROR IN BATCH THE PROGRAM NOW CONTINUES ; 4. FINAL MENU EXPANDED TO HANDLE FIFTH OPTION OF WRITING TWO EOFS ; TO THE OUTPUT TAPE AS SOME OF OUR DATA TAPES LACK PROPER EOFS ; 5. CHANGED DEFAULT DEVICES (INPUT MSA0:, OUTPUT MFA0:) ; ; NOTE TWO NEW SUBROUTINES WERE ADDED IN SECTION `E' ; ; ;***************************************************************** ; ; LOCAL MACRO DEFINITIONS ; ;***************************************************************** .MACRO IFABORT _DEST,?OKLBL BLBS CONTINUE,OKLBL ;;;; IS ABORT FLAG ON? .IF IDN,_DEST,RETURN RSB ;;;; YES - RETURN TO CALLER .IFF BRW _DEST ;;;; YES - JUMP .ENDC OKLBL: ;;;; NO - CONTINUE .ENDM ;***************************************************************** ; ; DEFINE MACRO SYMBOLS ; ;***************************************************************** $MTDEF ; MT$ SYMBOL DEFINITIONS $MNTDEF ; VOLUME MOUNT SYMBOL DEFINITIONS $JPIDEF ; JPI CODES REQUIRED FOR VERSION 4.0 .PAGE .SUBTITLE I/O BUFFERS ;***************************************************************** ; ; THIS PSECT CONTAINS THE TWO I/O BUFFERS. ; ;***************************************************************** .PSECT BUFFERS,NOEXE,PAGE IO_BUF_SIZE=65534 ; I/O BUFFER SIZE .ALIGN PAGE BUFFER1: .BLKB IO_BUF_SIZE .ALIGN PAGE BUFFER2: .BLKB IO_BUF_SIZE .PAGE .SUBTITLE READ/WRITE DATA ;***************************************************************** ; ; THIS PSECT CONTAINS READ/WRITE DATA ; ;***************************************************************** .PSECT READ_WRITE,NOEXE READ_EFN=1 ; EVENT FLAG NUMBER USED FOR READS WRITE_EFN=2 ; EVENT FLAG NUMBER USED FOR WRITES LF=^X0A ; LINE FEED CHARACTER CR=^X0D ; CHARRIAGE RETURN CHARACTER BELL=^X07 ; FOR RINGING TERMINAL BELL PRINT_NUM_RECS: .BLKB 1 ; PRINT NUMBER OF RECS IN EACH RECORD? Y/N NUM_FILES: .BLKL 1 ; NUMBER OF FILES TO COPY FILES_READ: .LONG 1 ; NUMBER OF FILES COPIED READ_IO_STATUS_BLOCK: ; READ STATUS RETURN .BLKQ 1 WRITE_IO_STATUS_BLOCK: ; WRITE STATUS RETURN .BLKQ 1 FORCE_PROMPT: .LONG 1 ; TO FORCE PROMPTING FROM LIB$GET_FOREIGN ; NOTE!! THE CONTENTS OF THE FOLLOWING TWO POINTERS ARE EXCHANGED ; AFTER EACH READ!! IN_BUF_PTR: .ADDRESS BUFFER1 ; INPUT BUFFER POINTER OUT_BUF_PTR: .ADDRESS BUFFER2 ; OUTPUT BUFFER POINTER READ_CHAN: .BLKL 1 ; READ I/O CHANNEL NUMBER WRITE_CHAN: .BLKL 1 ; WRITE I/O CHANNEL NUMBER CONTINUE: .LONG 1 ; CONTINUE FLAG: 1=CONTINUE, 0=ABORT READ_LENGTH: .BLKL 1 ; NUMBER OF BYTES LAST READ WRAPUP_ACTION_DESCR: ; DESCRIPTOR OF WRAPUP_ACTION .LONG 1 .ADDRESS WRAPUP_ACTION WRAPUP_ACTION: .BLKB 1 INDEV_DESCR: ; DESCRIPTOR OF INPUT DEVICE REPLY STRING .LONG 20 ; LENGTH OF NAME .ADDRESS INDEV ; ADR OF NAME INDEV: .BLKB 20 ; INPUT DEVICE NAME OUTDEV_DESCR: ; DESCRIPTOR OF OUTPUT DEVICE REPLY STRING .LONG 20 ; LENGTH OF NAME .ADDRESS OUTDEV ; ADR OF NAME OUTDEV: .BYTE ^A/ /[20] ; OUTPUT DEVICE NAME (INIT TO BLANKS) PRINT_NUM_RECS_LEN: .BLKW 1 ; LENGTH LENGTH OF REPLY NUM_FILES_REPLY: .BLKB 8 ; PUT ASCII REPLY HERE NUM_FILES_LEN: .BLKL 1 ; NUM CHARS PUT IN NUM_FILES_REPLY OUT_DENS_DESCR: ; DESCRIPTOR OF OUTPUT_DENSITY .LONG 4 .ADDRESS OUTPUT_DENSITY OUTPUT_DENSITY: ; ACTUAL DENSITY .ASCII / / OUT_DENS_PROMPT: ; PROMPT DESCRIPTOR .LONG ODP_END-OUT_DENS_PROMPT-8 ; PROMPT LENGTH .ADDRESS .+4 ; PROMPT ADDRESS .ASCII /** CAUTION ** Be sure output tape density is set to software / .ASCII /select or the correct density before continuing!/ .ASCII /Enter output tape density [DEFAULT / IN_DENS: ; FILL IN INPUT DENSITY AS DEFAULT .BLKB 4 .ASCII /] > / ; REST OF PROMPT ODP_END: SET_MODE_CHAR_BUF: ; CHARACTERISTICS TO BE SET .LONG 4 ; BUFFER LENGTH .BLKL 1 ; BUFFER CONTENTS NUMBER_OF_EOFS: .BYTE 0 ; COUNTS NUMBER OF CONSECUTIVE EOFS NUMBER_OF_RECORDS: .LONG 0 ; NUMBER OF RECORDS IN EACH FILE BUFFER_DESCR: ; DESCRIPTOR OF UNFORMATTED BUFFER .LONG 80 .ADDRESS FORMATTED_BUFFER FORMATTED_BUFFER: .BLKB 80 FORMATTED_DESCR: ; DESCRIPTOR OF FORMATTED OUTPUT .BLKW 1 ; LENGTH OF FORMATTED OUTPUT .BLKW 1 ; UNUSED .ADDRESS FORMATTED_BUFFER IN_MOUNT_LIST: ; ITEM LIST FOR MOUNTING INPUT DEVICE .BLKW 1 ; LENGTH OF INPUT DEVICE NAME (FILLED IN LATER) .WORD MNT$_DEVNAM ; DEVICE NAME CODE .ADDRESS INDEV ; LOCATION OF INPUT DEVICE NAME .LONG 0 ; UNUSED .WORD 4 ; FLAGS LENGTH .WORD MNT$_FLAGS ; MOUNT FLAGS CODE .ADDRESS IN_MOUNT_FLAGS ; ADR OF FLAGS .LONG 0 ; UNUSED .WORD 4 ; BLOCKSIZE LENGTH .WORD MNT$_BLOCKSIZE ; BLOCKSIZE CODE .ADDRESS MOUNT_BLOCKSIZE ; ADR OF BLOCKSIZE .LONG 0 ; UNUSED .WORD IN_COMMENT_LEN ; LENGTH OF MOUNT COMMENT .WORD MNT$_COMMENT ; MOUNT COMMENT FLAG .ADDRESS IN_COMMENT ; ADR OF COMMENT .LONG 0 ; UNUSED .LONG 0 ; END OF LIST OUT_MOUNT_LIST: ; ITEM LIST FOR MOUNTING OUTPUT DEVICE .BLKW 1 ; LENGTH OF OUTPUT DEVICE NAME (FILLED IN LATER) .WORD MNT$_DEVNAM ; DEVICE NAME CODE .ADDRESS OUTDEV ; LOCATION OF OUTPUT DEVICE NAME .LONG 0 ; UNUSED .WORD 4 ; FLAGS LENGTH .WORD MNT$_FLAGS ; MOUNT FLAGS CODE .ADDRESS OUT_MOUNT_FLAGS ; ADR OF FLAGS .LONG 0 ; UNUSED .WORD 4 ; BLOCKSIZE LENGTH .WORD MNT$_BLOCKSIZE ; BLOCKSIZE CODE .ADDRESS MOUNT_BLOCKSIZE ; ADR OF BLOCKSIZE .LONG 0 ; UNUSED .WORD OUT_COMMENT_LEN ; LENGTH OF MOUNT COMMENT .WORD MNT$_COMMENT ; MOUNT COMMENT FLAG .ADDRESS OUT_COMMENT ; ADR OF COMMENT .LONG 0 ; UNUSED .LONG 0 ; END OF LIST IN_COMMENT: .ASCII /Please mount input tape for TCOPY on / IN_COMMENT_DEV: .BLKB 5 ; NAME OF DRIVE GOES HERE IN_COMMENT_LEN=.-IN_COMMENT OUT_COMMENT: .ASCII /Please mount output tape for TCOPY on / OUT_COMMENT_DEV: .BLKB 5 ; NAME OF DRIVE GOES HERE OUT_COMMENT_LEN=.-OUT_COMMENT CONT_REPLY: .ASCID / / ; FOR THE Y OR N ; ********************************************************************** ; VERSION 4.00 READ/WRITE DATA IMPLEMENTED HERE JPI_ITEM_LIST: .WORD 4 ; GETJPIW ITEM LIST DATA STRUCTURE .WORD JPI$_MODE ; GET THE MODE OF OPERATION .ADDRESS USER_MODE ; WHERE TO WRITE THE RESULTS .ADDRESS USER_MODE_LEN ; THE LENGTH OF THE BUFFER .LONG 0 ; END OF THE ITEM LIST USER_MODE: .LONG 0 ; STORAGE FOR GETJPIW OUTPUT USER_MODE_LEN: .LONG 1 ; STORAGE FOR GETJPIW OUTPUT .PAGE .SUBTITLE READ ONLY DATA ;***************************************************************** ; ; READ ONLY DATA ; ;***************************************************************** .PSECT READ_ONLY,NOEXE,NOWRT WRAPUP_PROMPT_DESCR: ; DESCRIPTOR OF WRAPUP_PROMPT .LONG WRAPUP_PROMPT_LEN .ADDRESS WRAPUP_PROMPT WRAPUP_PROMPT: .ASCII /Type one of the following numbers to indicate / .ASCII /what you want done with the tapes:/ .ASCII / 1 - Rewind input, Dismount output (default)/ .ASCII / 2 - Dismount both tapes/ .ASCII / 3 - Rewind both tapes and leave online/ .ASCII / 4 - Leave tapes at current positions / .ASCII / 5 - Write double EOF to output and dismount both/ WRAPUP_PROMPT_LEN=.-WRAPUP_PROMPT ; LENGTH OF WRAPUP_PROMPT IN_REWIND_ERROR: .ASCID /Error while rewinding input tape/ OUT_REWIND_ERROR: .ASCID /Error while rewinding output tape/ IN_DISMOUNT_ERROR: .ASCID /Error while dismounting input tape/ OUT_DISMOUNT_ERROR: .ASCID /Error while dismounting output tape/ IN_DEASSIGN_ERROR: .ASCID /Error while deassigning input tape/ OUT_DEASSIGN_ERROR: .ASCID /Error while deassigning output tape/ WELCOME_MSG: .ASCID /TCOPY Tape to Tape Copy Program Version 4.0/ IN_DEV_PROMPT: .ASCID /Enter input device [DEFAULT MSA0:] > / MSA0: .ASCII /MSA0:/ MSA0_LEN=.-MSA0 MFA0: .ASCII /MFA0:/ MFA0_LEN=.-MFA0 OUT_DEV_PROMPT: .ASCID /Enter output device [DEFAULT MFA0:] > / OUT_DEV_ERROR: .ASCID /Input and output devices must be different/ PRINT_NUM_RECS_DESCR: ; DESCRIPTOR OF REPLY STRING .LONG 1 ; LENGTH OF REPLY STRING .ADDRESS PRINT_NUM_RECS ; ADR OF REPLY STRING PRINT_NUM_RECS_PROMPT: .ASCID #Print number of records in each file? (Y/N) [DEFAULT N] ># NUM_FILES_DESCR: ; DESCRIPTOR OF REPLY STRING .LONG 8 ; LENGTH OF REPLY STRING .ADDRESS NUM_FILES_REPLY ; ADR OF REPLY STRING NUM_FILES_PROMPT: .ASCID /How many files do you want to copy? [DEFAULT All files] > / IN_ASN_MSG: .ASCID #Error while assigning I/O channel to input device:# OUT_ASN_MSG: .ASCID #Error while assigning I/O channel to output device:# SENSE_MODE_ERROR: .ASCID /Error while reading input tape characteristics:/ OUTPUT_SENSE_MODE_ERROR: .ASCID /Error while reading output tape characteristics:/ SET_MODE_ERROR: .ASCID /Error while setting output tape characteristics:/ BAD_DENSITY: .ASCID /Illegal density. Legal values are 6250, 1600 and 800./ READ_ERROR: .ASCID /Read error:/ WRITE_ERROR: .ASCID /Write error:/ DOUBLE_EOF_MSG: .ASCID /Double EOF encountered on input tape. Possible end of data./ NUM_RECS_MSG: .ASCID /File number !UL contained !UL record!%S./ IN_MOUNT_FLAGS: .LONG ; INPUT FLAGS OUT_MOUNT_FLAGS: .LONG MNT$M_FOREIGN ; OUTPUT FLAGS MOUNT_BLOCKSIZE: .LONG IO_BUF_SIZE ; IO BLOCK SIZE IN_MOUNT_ERROR: .ASCID /Error mounting input tape/ OUT_MOUNT_ERROR: .ASCID /Error mounting output tape/ CONT_MSG: .ASCID %Do you want to continue? (Y/N) [DEFAULT N] >% JPI_ERROR_MSG: .ASCII /Error returned by GETJPIW for mode of operation/ BATCH_PARITY_MSG: .ASCII /Parity error in batch mode - TCOPY will continue/ BATCH_QUIT_MSG: .ASCII /Non-parity error in batch mode, TCOPY quits/ .PAGE .SUBTITLE AA - MAIN CODE ;***************************************************************** ; ; BACK TO OUR MAIN PSECT ; START OF CODE ; ;***************************************************************** .PSECT TCOPY:: .WORD 0 JSB BA_SETUP ; SET THINGS UP FOR THE COPY IFABORT AA_EXIT JSB BB_COPY ; COPY THE TAPE AA_EXIT: JSB BC_WRAPUP ; CLEAN THINGS UP $EXIT_S ; TELL VMS WE WANT TO STOP .PAGE .SUBTITLE BA - SETUP ;***************************************************************** ; ; SETUP SUBROUTINE - ; DETERMINE MODE OF OPERATION (VERSION 4.00 MOD) ; GET PARAMETERS FROM USER ; INITIALIZE I/O DEVICES ; INITIALIZE INPUT BUFFER ; ;***************************************************************** BA_SETUP: JSB CA_PRINT_WELCOME_MESSAGE ; TELL USER WHO WE ARE JSB EA_GET_USER_MODE ; DETERMINE USER MODE VIA GETJPIW JSB CB_GET_INPUT_DEVICE ; GET INPUT DEVICE NAME JSB CC_GET_OUTPUT_DEVICE ; GET OUTPUT DEVICE NAME IFABORT RETURN JSB CD_GET_PRINT_NUM_RECS ; PRINT NUMBER OF RECORDS? JSB CE_GET_NUM_FILES ; GET NUMBER OF FILES TO COPY JSB CF_ASSIGN_CHANNELS ; ASSIGN CHANNELS TO I/O TAPES IFABORT RETURN JSB CM_MOUNT_TAPES ; MOUNT TAPES IFABORT RETURN JSB CH_READ ; INITIALIZE INPUT BUFFER IFABORT RETURN JSB CJ_READ_WAIT ; WAIT FOR READ TO COMPLETE IFABORT RETURN JSB CG_SET_OUTPUT_DENSITY ; SET DENSITY OF OUTPUT DRIVE ; VERSION 4.00 CHANGE HERE - CALL THE EOF CHECK ROUTINE TO CHECK IF THE ; VERY FIRST RECORD READ WAS AN EOF. THE CL_CHECK_EOF WON'T DO AN THING ; IF THE INPUT BUFFER DOES NOT CONTAIN AN EOF. JSB CL_EOF_CHECK IFABORT RETURN RSB ; RETURN TO CALLER .PAGE .SUBTITLE BB - COPY TAPES ;***************************************************************** ; ; COPY SUBROUTINE - COPY THE TAPES ; ;***************************************************************** BB_COPY: JSB CI_WRITE ; START A WRITE IFABORT RETURN JSB CH_READ ; START A READ IFABORT RETURN JSB CK_WRITE_WAIT ; WAIT FOR THE WRITE TO COMPLETE IFABORT RETURN JSB CJ_READ_WAIT ; WAIT FOR THE READ TO COMPLETE IFABORT RETURN JSB CL_EOF_CHECK ; CHECK FOR EOFS IFABORT RETURN CMPL FILES_READ,NUM_FILES ; HAVE WE READ ENOUGH YET? BLEQ BB_COPY ; NO - DO IT AGAIN RSB ; YES - RETURN TO CALLER .PAGE .SUBTITLE BC - WRAPUP ;***************************************************************** ; ; WRAP THINGS UP AND STOP THIS PROGRAM ; ;***************************************************************** ; MODIFIED FOR VERSION 4.00 - THE FIFTH CASE OF WRITING A DOUBLE ; EOF ADDED TO THE MENU BC_WRAPUP: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL WRAPUP_ACTION_DESCR ; WHERE TO PUT ANSWER LENGTH PUSHAQ WRAPUP_PROMPT_DESCR ; PROMPT PUSHAQ WRAPUP_ACTION_DESCR ; DECRIPTION OF ANSWER BUFFER CALLS #4,G^LIB$GET_FOREIGN ; WHAT TO DO WITH THE TAPE? CMPB #^A/ /,WRAPUP_ACTION ; DEFAULT ACTION? (#1) BNEQU BC_CASE ; NO MOVB #^A/1/,WRAPUP_ACTION ; YES - MAKE ACTION "1" BC_CASE: CASEB WRAPUP_ACTION,#^A/1/,#4 ; GO TO PROPER SECTION BC_CASE_TBL: .WORD BC_CASE_1-BC_CASE_TBL ; IF 1 .WORD BC_CASE_2-BC_CASE_TBL ; IF 2 .WORD BC_CASE_3-BC_CASE_TBL ; IF 3 .WORD BC_CASE_4-BC_CASE_TBL ; IF 4 .WORD BC_CASE_5-BC_CASE_TBL ; IF 5 BRB BC_WRAPUP ; ASK AGAIN IF NONE OF THE ABOVE BC_CASE_1: JSB BC_REWIND_IN ; OPTION 1 - REWIND IN, DISMOUNT OUT JSB BC_DEASSIGN_BOTH JSB BC_DISMOUNT_OUT BRB BC_EXIT BC_CASE_2: JSB BC_DEASSIGN_BOTH ; OPTION 2 - DISMOUNT BOTH JSB BC_DISMOUNT_IN JSB BC_DISMOUNT_OUT BRB BC_EXIT BC_CASE_3: JSB BC_REWIND_IN ; OPTION 3 - REWIND BOTH JSB BC_REWIND_OUT JSB BC_DEASSIGN_BOTH BRB BC_EXIT BC_CASE_4: JSB BC_DEASSIGN_BOTH ; OPTION 4 - LEAVE BOTH TAPES ALONE BC_CASE_5: JSB EA_WRITE_EOF ; WRITE FIRST EOF JSB CK_WRITE_WAIT ; WAIT UNTIL IT IS FINISHED JSB EA_WRITE_EOF ; WRITE SECOND EOF JSB CK_WRITE_WAIT ; WAIT UNTIL IT IS FINISHED JSB BC_DEASSIGN_BOTH ; DEASSIGN BOTH DRIVES JSB BC_DISMOUNT_IN ; DISMOUNT INPUT JSB BC_DISMOUNT_OUT ; DISMOUNT OUTPUT BRB BC_EXIT ; BITE THE DUST BC_EXIT: $EXIT_S ; TELL VMS WE WANT TO STOP ;***************************************************************** ; ; MINI-SUBROUTINES USED BY BC_WRAPUP ; ;***************************************************************** BC_REWIND_IN: $QIO_S EFN=#READ_EFN,- ; REWIND INPUT TAPE FUNC=#IO$_REWIND,- CHAN=READ_CHAN,- IOSB=READ_IO_STATUS_BLOCK BLBS R0,10$ ; DID REWIND GO OK? MOVAL IN_REWIND_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO 10$: RSB ; RETURN TO CALLER ;***************************************************************** BC_REWIND_OUT: $QIO_S EFN=#WRITE_EFN,- ; REWIND OUTPUT TAPE FUNC=#IO$_REWIND,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK BLBS R0,10$ ; DID REWIND GO OK? MOVAL OUT_REWIND_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO 10$: RSB ; RETURN TO CALLER ;***************************************************************** BC_DEASSIGN_BOTH: $DASSGN_S CHAN=READ_CHAN ; DEASSIGN INPUT CHANNEL BLBS R0,BC_DEASSIGN_OUT ; DID DEASSIGN GO OK? MOVAL IN_DEASSIGN_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO BC_DEASSIGN_OUT: $DASSGN_S CHAN=WRITE_CHAN ; DEASSIGN OUTPUT CHANNEL BLBS R0,10$ ; DID DEASSIGN GO OK? MOVAL OUT_DEASSIGN_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO 10$: RSB ; RETURN TO CALLER ;***************************************************************** BC_DISMOUNT_IN: $DISMOU_S INDEV_DESCR ; DISMOUNT INPUT TAPE BLBS R0,10$ ; DID DISMOUNT GO OK? MOVAL IN_DISMOUNT_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO 10$: RSB ; RETURN TO CALLER ;***************************************************************** BC_DISMOUNT_OUT: $DISMOU_S OUTDEV_DESCR ; DISMOUNT OUTPUT TAPE BLBS R0,10$ ; DID MOUNT GO OK? MOVAL OUT_DISMOUNT_ERROR,R1 ; NO - GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO 10$: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CA - PRINT WELCOME MESSAGE ;***************************************************************** ; ; PRINT WELCOME MESSAGE ; ;***************************************************************** CA_PRINT_WELCOME_MESSAGE: PUSHAL WELCOME_MSG CALLS #1,G^LIB$PUT_OUTPUT ; WELCOME MESSAGE RSB .PAGE .SUBTITLE CB - GET INPUT DEVICE ;***************************************************************** ; ; CB_GET_INPUT_DEVICE ; ; IF DEFAULT IS RETURNED, THEN SET INPUT TO MSA0 AND OUTPUT TO MFA0 ; ;***************************************************************** CB_GET_INPUT_DEVICE: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL INDEV_DESCR ; WHERE TO PUT ANSWER LENGTH PUSHAQ IN_DEV_PROMPT ; WHAT TO PROMPT PUSHAQ INDEV_DESCR ; WHERE TO PUT ANSWER CALLS #4,G^LIB$GET_FOREIGN ; GET INDEV TSTL INDEV_DESCR ; DEFAULT? BNEQ CB_EXIT ; NO - USE WHAT WE HAVE MOVC3 #MSA0_LEN,MSA0,INDEV ; DEFAULT INPUT DEVICE MOVL #MSA0_LEN,INDEV_DESCR ; DEFAULT INPUT DEVICE'S LENGTH MOVC3 #MFA0_LEN,MFA0,OUTDEV ; DEFAULT OUTPUT DEVICE MOVL #MFA0_LEN,OUTDEV_DESCR ; DEFAULT OUTPUT DEVICE'S LENGTH CB_EXIT: RSB .PAGE .SUBTITLE CC - GET OUTPUT DEVICE ;***************************************************************** ; ; CC_GET_OUTPUT_DEVICE ; ; IF OUTDEV IS NOT BLANKS, THEN WE PROBABLY GOT THE DEVICE AS ; DEFAULT FROM CB_GET_INPUT_DEVICE. ; ;***************************************************************** CC_GET_OUTPUT_DEVICE: CMPL #^A/ /,OUTDEV ; IS IT BLANK? BNEQU CC_CHECK_FOR_SAME ; NO - LEAVE IT AS IS CC_ASK_AGAIN: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL OUTDEV_DESCR ; WHERE TO PUT ANSWER LENGTH PUSHAQ OUT_DEV_PROMPT ; WHAT TO SAY PUSHAQ OUTDEV_DESCR ; WHERE TO PUT ANSWER CALLS #4,G^LIB$GET_FOREIGN ; GET OUTDEV CC_CHECK_FOR_SAME: CMPC5 INDEV_DESCR,INDEV,#^A/ /,- ; ARE IN AND OUT DIFFERENT? OUTDEV_DESCR,OUTDEV BNEQU CC_EXIT ; YES - THATS WHAT WE WANT CLRL R0 ; NO SYSTEM MESSAGE MOVAB OUT_DEV_ERROR,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; SEE WHAT HE WANTS TO DO ABOUT IT IFABORT RETURN MOVL #20,OUTDEV_DESCR ; RESET ANSWER BUFFER LENGTH BRB CC_ASK_AGAIN ; ASK AGAIN CC_EXIT: RSB .PAGE .SUBTITLE CD - GET PRINT NUMBER OF RECORDS ;***************************************************************** ; ; FIND OUT IF WE ARE TO PRINT THE NUMBER OF RECORDS IN EACH FILE ; ;***************************************************************** CD_GET_PRINT_NUM_RECS: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL PRINT_NUM_RECS_LEN ; WHERE TO PUT ANSWER LENGTH PUSHAQ PRINT_NUM_RECS_PROMPT ; WHAT TO ASK PUSHAQ PRINT_NUM_RECS_DESCR ; WHERE TO PUT ANSWER CALLS #4,G^LIB$GET_FOREIGN ; PRINT NUMBER OF RECS? TSTW PRINT_NUM_RECS_LEN ; DID HE TYPE ANYTHING? BNEQ CD_NOT_DEFAULT ; YES - USE WHAT HE TYPED MOVB #^A/N/,PRINT_NUM_RECS ; NO - USE DEFAULT BRB CD_EXIT ; RETURN TO CALLER CD_NOT_DEFAULT: CMPB #^A/N/,PRINT_NUM_RECS ; DID HE TYPE "N"? BEQLU CD_EXIT ; YES - ALL IS WELL CMPB #^A/Y/,PRINT_NUM_RECS ; DID HE TYPE "Y"? BEQLU CD_EXIT ; AGAIN, ALL IS WELL BRB CD_GET_PRINT_NUM_RECS ; INVALID ANSWER, TRY AGAIN CD_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CE - GET NUMBER OF FILES ;***************************************************************** ; ; GET_NUM_FILES ; ;***************************************************************** CE_GET_NUM_FILES: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL NUM_FILES_LEN ; WHERE TO PUT LENGTH OF ANSWER PUSHAQ NUM_FILES_PROMPT ; WHAT TO ASK PUSHAQ NUM_FILES_DESCR ; WHERE TO PUT ANSWER CALLS #4,G^LIB$GET_FOREIGN ; GET NUM FILES TO COPY TSTL NUM_FILES_LEN ; DID HE TYPE ANYTHING? BGTR CE_CONVERT ; YES - CONVERT IT MOVL #^X7FFFFFFF,NUM_FILES ; NO - SET DEFAULT BRB CE_EXIT ; YES - OK TO STOP CE_CONVERT: PUSHAL NUM_FILES ; BINARY NUMBER OF FILES PUSHAQ NUM_FILES_REPLY ; ASCII NUMBER OF FILES PUSHL NUM_FILES_LEN ; LENGTH OF ASCII NUMBER OF FILES CALLS #3,G^LIB$CVT_DTB ; CVT NUM FILES TO BINARY TSTL NUM_FILES ; IS THE NUMBER POSITIVE? BLSS CE_GET_NUM_FILES ; NO, ASK AGAIN CE_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CF - ASSIGN CHANNELS ;***************************************************************** ; ; ASSIGN CHANNEL NUMBERS TO TAPE DRIVES ; ;***************************************************************** CF_ASSIGN_CHANNELS: $ASSIGN_S DEVNAM=INDEV_DESCR,- ; GET INPUT CHANNEL # CHAN=READ_CHAN BLBS R0,CF_ASSIGN_OUTPUT ; BRANCH IF NO ERROR (LSB SET) MOVAL IN_ASN_MSG,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR IFABORT RETURN BRB CF_ASSIGN_CHANNELS ; IF CONTINUE, TRY AGAIN CF_ASSIGN_OUTPUT: $ASSIGN_S DEVNAM=OUTDEV_DESCR,- ; GET OUTPUT CHANNEL # CHAN=WRITE_CHAN BLBS R0,10$ ; BRANCH IF NO ERROR (LSB SET) MOVAL OUT_ASN_MSG,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR IFABORT RETURN BRB CF_ASSIGN_OUTPUT ; IF CONTINUE, TRY AGAIN 10$: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CG - SET OUTPUT DENSITY ;***************************************************************** ; ; CG_GET_OUTPUT_DENSITY ; ;***************************************************************** ; ; GET INPUT DENSITY (TO USE AS DEFAULT OUTPUT DENSITY) ; ;***************************************************************** CG_SET_OUTPUT_DENSITY: $QIOW_S EFN=#READ_EFN,- ; GET INPUT TAPE CHARACTERISTICS FUNC=#IO$_SENSEMODE,- CHAN=READ_CHAN,- IOSB=READ_IO_STATUS_BLOCK BLBS R0,CG_GET_INPUT_DENSITY ; DIRECTIVE ERROR? MOVAL SENSE_MODE_ERROR,R1 ; YES - GET ADR OF OUR ERROR MESSAGE JSB DA_ERROR ; CALL ERROR PROCESSOR IFABORT RETURN ;***************************************************************** ; ; DECODE INPUT DENSITY. ; MOVE DENSITY TO PROMPT. ; ;***************************************************************** CG_GET_INPUT_DENSITY: CMPV #MT$V_DENSITY,- ; IS INPUT DENSITY 6250? #MT$S_DENSITY,- READ_IO_STATUS_BLOCK+4,- #MT$K_GCR_6250 BNEQU CG_INPUT_NOT_6250 ; NO - CHECK 1600 MOVL #^A/6250/,IN_DENS ; YES - PUT "6250" IN PROMPT BRW CG_PROMPT_FOR_DENSITY CG_INPUT_NOT_6250: CMPV #MT$V_DENSITY,- ; IS INPUT DENSITY 1600? #MT$S_DENSITY,- READ_IO_STATUS_BLOCK+4,- #MT$K_PE_1600 BNEQU CG_INPUT_NOT_1600 ; NO - CHECK 800 MOVL #^A/1600/,IN_DENS ; YES - PUT "1600" IN PROMPT BRW CG_PROMPT_FOR_DENSITY CG_INPUT_NOT_1600: MOVL #^A/800 /,IN_DENS ; 800 IS OUR ONLY OTHER CHOICE ;***************************************************************** ; ; SEE WHAT USER WANTS OUTPUT DENSITY TO BE. ; (DEFAULT IS INPUT DENSITY). ; ;***************************************************************** CG_PROMPT_FOR_DENSITY: PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL OUT_DENS_DESCR ; WHERE TO PUT ANSWER'S LENGTH PUSHAQ OUT_DENS_PROMPT ; WHAT TO ASK PUSHAQ OUT_DENS_DESCR ; WHERE TO PUT ANSWER CALLS #4,G^LIB$GET_FOREIGN ; PROMPT FOR OUTPUT DENSITY ;***************************************************************** ; ; GET CURRENT OUTPUT TAPE CHARACTERISTICS. ; (WE WANT TO CHANGE THE DENSITY ONLY AND LEAVE OTHER ; CHARACTERISTICS UNCHANGED.) ; ;***************************************************************** $QIOW_S EFN=#WRITE_EFN,- ; GET OUTPUT TAPE CHARACTERISTICS FUNC=#IO$_SENSEMODE,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK BLBS R0,CG_SET_DEFAULT_DENSITY ; DIRECTIVE ERROR? MOVAL OUTPUT_SENSE_MODE_ERROR,R1 ; YES - GET ADR OF OUR ERROR MESSAGE JSB DA_ERROR ; CALL ERROR PROCESSOR IFABORT RETURN ;***************************************************************** ; ; SET OUTPUT DENSITY TO SAME AS INPUT DENSITY JUST IN CASE USER ; WANTS TO USE THE DEFAULT. ; ;***************************************************************** CG_SET_DEFAULT_DENSITY: MOVL WRITE_IO_STATUS_BLOCK+4,- ; MOVE INPUT CHAR TO OUTPUT CHAR SET_MODE_CHAR_BUF+4 EXTV #MT$V_DENSITY,- ; PUT DENSITY IN R8 #MT$S_DENSITY,- READ_IO_STATUS_BLOCK+4,- R8 ;***************************************************************** ; ; SEE WHAT USER REQUESTED AS OUTPUT DENSITY. ; IF NOT DEFAULT, THEN CHANGE OUTPUT DENSITY. ; ;***************************************************************** CMPL #^A/ /,OUTPUT_DENSITY ; IS ANSWER DEFAULT? BEQLU CG_WRITE_OUTPUT_CHAR ; YES - KEEP IT THE SAME. CMPL #^A/6250/,OUTPUT_DENSITY ; IS ANSWER "6250" BNEQU CG_OUTPUT_NOT_6250 ; NO. MOVL #MT$K_GCR_6250,R8 ; PUT DENSITY IN R8 BRW CG_WRITE_OUTPUT_CHAR ; SEND CHARS TO THE DRIVE CG_OUTPUT_NOT_6250: CMPL #^A/1600/,OUTPUT_DENSITY ; IS ANSWER "1600" BNEQU CG_OUTPUT_NOT_1600 ; NO. MOVL #MT$K_PE_1600,R8 ; PUT DENSITY IN R8 BRW CG_WRITE_OUTPUT_CHAR ; SEND CHARS TO THE DRIVE CG_OUTPUT_NOT_1600: CMPL #^A/800 /,OUTPUT_DENSITY ; IS ANSWER "800 " BNEQU CG_OUTPUT_NOT_800 ; NO. MOVL #MT$K_NRZI_800,R8 ; PUT DENSITY IN R8 BRW CG_WRITE_OUTPUT_CHAR ; SEND CHARS TO THE DRIVE CG_OUTPUT_NOT_800: CLRL R0 ; NO SYSTEM ERROR MOVAL BAD_DENSITY,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; PRINT ERROR MESSAGE IFABORT RETURN BRW CG_PROMPT_FOR_DENSITY ; TRY AGAIN ;***************************************************************** ; ; WRITE OUTPUT CHARACTERISTICS (WITH DESIRED DENSITY) TO ; OUTPUT DRIVE. ; ;***************************************************************** CG_WRITE_OUTPUT_CHAR: INSV R8,- ; PUT DENSITY INTO OUTPUT DESCRIPTOR #MT$V_DENSITY,- #MT$S_DENSITY,- SET_MODE_CHAR_BUF+4 $QIOW_S EFN=#WRITE_EFN,- ; SET OUTPUT TAPE CHARACTERISTICS FUNC=#IO$_SETMODE,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK,- P1=SET_MODE_CHAR_BUF BLBS R0,CG_EXIT ; DIRECTIVE ERROR? MOVAL SET_MODE_ERROR,R1 ; YES - GET ADR OF OUR ERROR MESSAGE JSB DA_ERROR ; PROCESS ERROR IFABORT RETURN CG_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CH - READ INPUT TAPE ;***************************************************************** ; ; READ RECORD FROM INPUT TAPE DRIVE ; ;***************************************************************** ; ; READ SUBROUTINE CODE: ; PUT ADR OF BUFFER INTO QIO PARMS ; ISSUE READ QIO ; CHECK FOR ERRORS ; SWAP POINTERS ; ;***************************************************************** CH_READ: $QIO_S EFN=#READ_EFN,- ; READ RECORD FROM TAPE FUNC=#IO$_READLBLK,- CHAN=READ_CHAN,- IOSB=READ_IO_STATUS_BLOCK,- P1=@IN_BUF_PTR,- P2=#IO_BUF_SIZE BLBS R0,CH_SWAP_PTRS ; CHECK FOR ERRORS MOVAL READ_ERROR,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR IFABORT RETURN CH_SWAP_PTRS: MOVL IN_BUF_PTR,R0 ; SWAP MOVL OUT_BUF_PTR,IN_BUF_PTR ; BUFFER MOVL R0,OUT_BUF_PTR ; POINTERS RSB ; RETURN TO CALLER .PAGE .SUBTITLE CI - WRITE OUTPUT TAPE ;***************************************************************** ; ; WRITE RECORD TO OUTPUT TAPE DRIVE ; ;***************************************************************** ; ; WRITE SUBROUTINE CODE: ; PUT ADR OF BUFFER INTO QIO PARMS ; COPY LENGTH OF BUFFER FROM INPUT IOSB TO QIO PARMS ; ISSUE WRITE QIO ; CHECK FOR ERRORS ; ;***************************************************************** CI_WRITE: $QIO_S EFN=#WRITE_EFN,- ; WRITE RECORD TO TAPE FUNC=#IO$_WRITELBLK,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK,- P1=@OUT_BUF_PTR,- P2=READ_LENGTH BLBS R0,CI_EXIT ; CHECK FOR DIRECTIVE ERRORS MOVAL WRITE_ERROR,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR CI_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CJ - READ WAIT ;***************************************************************** ; ; READ_WAIT ; WAIT FOR COMPLETION ; CHECK FOR ERRORS ; CHECK FOR EOF ; ;***************************************************************** CJ_READ_WAIT: $WAITFR_S EFN=#READ_EFN ; WAIT FOR READ TO FINISH CMPW READ_IO_STATUS_BLOCK,#SS$_NORMAL ; ERROR? BEQL CJ_EXIT ; NO CMPW READ_IO_STATUS_BLOCK,#SS$_ENDOFFILE ; EOF? BEQL CJ_EXIT ; YES - IGNORE IT MOVAL READ_ERROR,R1 ; OUR ERROR MESSAGE CVTWL READ_IO_STATUS_BLOCK,R0 ; SYSTEM ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR CJ_EXIT: MOVZWL READ_IO_STATUS_BLOCK+2,READ_LENGTH ; GET # BYTES READ RSB ; RETURN TO CALLER .PAGE .SUBTITLE CK - WRITE WAIT ;***************************************************************** ; ; WAIT FOR A WRITE OPERATION TO COMPLETE THEN CHECK STATUS ; ;***************************************************************** CK_WRITE_WAIT: $WAITFR_S EFN=#WRITE_EFN ; WAIT FOR WRITE TO FINISH CMPW WRITE_IO_STATUS_BLOCK,#SS$_NORMAL ; ERROR? BEQL CK_EXIT ; NO MOVAL WRITE_ERROR,R1 ; OUR ERROR MESSAGE CVTWL WRITE_IO_STATUS_BLOCK,R0 ; SYSTEM ERROR MESSAGE JSB DA_ERROR ; ERROR PROCESSOR CK_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CL - EOF_CHECK ;***************************************************************** ; ; CHECK FOR EOF. ; IF NOT EOF THEN ; RESET COUNT OF NUMBER OF EOFS . ; RETURN. ; END IF. ; WRITE EOF ON OUTPUT DRIVE. ; COUNT NUMBER OF CONSECUTIVE EOFS. ; IF MULTIPLE EOFS ENCOUNTERED THEN ; ASK USER IF HE WANTS TO STOP (VIA "ERROR"). ; END IF. ; IF SINGLE EOF THEN ; POSSIBLY WRITE NUMBER OF RECORDS IN FILE. ; END IF. ; READ NEXT RECORD. ; SEE IF IT WAS AN EOF (**** RECURSIVE CALL ****). ; ; NOTE: THERE ARE ONLY TWO WAYS OUT OF THE RECURSIVE CALL LOOP: ; 1) IF WE READ A NON-EOF, WE WILL RETURN TO THE CALLER, ; 2) IN THE CALL TO "ERROR", THE USER CAN SPECIFY THAT HE DOES NOT ; WANT TO CONTINUE. IN THIS CASE, THE PROGRAM WILL CLEAN THINGS ; UP AND STOP, BUT NEVER COME BACK TO US (IE, THE STACK IS NOT ; UNWOUND - UNSTRUCTURED, BUT EFFECTIVE.) ; ;***************************************************************** CL_EOF_CHECK: ;***************************************************************** ; ; CHECK FOR EOF. IF NOT EOF, RESET COUNT OF NUMBER OF EOFS ; ;***************************************************************** CMPW READ_IO_STATUS_BLOCK,#SS$_ENDOFFILE ; EOF? BEQL CL_PROCESS_EOF ; YES - CHECK IT OUT CLRB NUMBER_OF_EOFS ; NO - CLEAR # OF CONSECUTIVE EOFS INCL NUMBER_OF_RECORDS ; COUNT RECORDS IN FILE BRW CL_EXIT ; RETURN TO CALLER ;***************************************************************** ; ; WRITE EOF ON OUTPUT DRIVE, ; COUNT NUMBER OF CONSECUTIVE EOFS ; DETERMINE IF MULTIPLE EOF CONDITION ; ;***************************************************************** CL_PROCESS_EOF: $QIO_S EFN=#WRITE_EFN,- ; "COPY" EOF TO OUTPUT DRIVE FUNC=#IO$_WRITEOF,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK INCB NUMBER_OF_EOFS ; COUNT CONSECUTIVE EOFS CMPB #2,NUMBER_OF_EOFS ; 2 OR MORE? BGTR CL_EOF_PRINT ; NO - TRY ANOTHER READ ;***************************************************************** ; ; MULTIPLE EOFS ENCOUNTERED. ASK USER IF HE WANTS TO STOP. ; IF HE DOES, WE WILL NEVER RETURN FROM "ERROR". ; ;***************************************************************** CLRL R0 ; NO SYSTEM ERROR MOVAL DOUBLE_EOF_MSG,R1 ; OUR ERROR MESSAGE JSB DA_ERROR ; PROCESS CONDITION IFABORT RETURN ;***************************************************************** ; ; IF THIS IS A SINGLE EOF, CHECK TO SEE IF WE WRITE NUMBER OF RECORDS IN FILE. ; ;***************************************************************** CL_EOF_PRINT: CMPB #1,NUMBER_OF_EOFS ; FIRST EOF IN FILE? BGTR CL_READ_NEXT_REC ; NO CMPB #^A/Y/,PRINT_NUM_RECS ; PRINT NUMBER OF RECORDS? BNEQU CL_READ_NEXT_REC ; NO $FAO_S CTRSTR=NUM_RECS_MSG,- ; FORMAT "NUMBER OF RECS" MSG OUTBUF=BUFFER_DESCR,- OUTLEN=FORMATTED_DESCR,- P1=FILES_READ,- P2=NUMBER_OF_RECORDS PUSHAQ FORMATTED_DESCR ; ADR OF FORMAT DESCRIPTION CALLS #1,G^LIB$PUT_OUTPUT ; WRITE MESSAGE INCL FILES_READ ; INCREMENT FILE NUMBER CLRL NUMBER_OF_RECORDS ; RESET NUMBER OF RECORDS ;***************************************************************** ; ; READ NEXT RECORD. ; SEE IF IT WAS AN EOF (**** RECURSIVE CALL ****). ; NOTE: UPON MULTIPLE EOFS, THE USER IS ASKED IF WE SHOULD CONTINUE. ; ;***************************************************************** CL_READ_NEXT_REC: JSB CH_READ ; READ NEXT RECORD IFABORT RETURN JSB CK_WRITE_WAIT ; WAIT FOR OUTPUT EOF TO BE WRITTEN IFABORT RETURN JSB CJ_READ_WAIT ; WAIT FOR NEW INPUT RECORD IFABORT RETURN JSB CL_EOF_CHECK ; **** RECURSIVE CALL **** CL_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE CM - MOUNT TAPES ;***************************************************************** ; ; CM_MOUNT_TAPES ; SAME AS $ MOUNT/FOREIGN ddcu: ; ;***************************************************************** CM_MOUNT_TAPES: MOVW INDEV_DESCR,IN_MOUNT_LIST ; GET LENGTH OF INPUT DEVICE NAME MOVW OUTDEV_DESCR,OUT_MOUNT_LIST ; GET LENGTH OF OUTPUT DEVICE NAME MOVC3 #5,INDEV,IN_COMMENT_DEV ; PUT DEV NAME IN MOUNT COMMENT $MOUNT_S IN_MOUNT_LIST ; MOUNT INPUT TAPE BLBS R0,CM_MOUNT_OUT ; DID MOUNT GO OK? MOVAL IN_MOUNT_ERROR,R1 ; GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO ABOUT IT IFABORT RETURN CM_MOUNT_OUT: MOVC3 #5,OUTDEV,OUT_COMMENT_DEV ; PUT DEV NAME IN MOUNT COMMENT $MOUNT_S OUT_MOUNT_LIST ; MOUNT OUTPUT TAPE BLBS R0,CM_EXIT ; DID MOUNT GO OK? MOVAL OUT_MOUNT_ERROR,R1 ; GET OUR ERROR MESSAGE JSB DA_ERROR ; ASK USER WHAT TO DO ABOUT IT CM_EXIT: RSB ; RETURN TO CALLER .PAGE .SUBTITLE DA - ERROR ;***************************************************************** ; ; ERROR PROCESSOR. ; PARAMETERS: ; R0 - SYSTEM ERROR MESSAGE NUMBER OR ZERO ; R1 - ADDRESS OF CALLER'S ERROR MESSAGE OR ZERO ; ; IF EITHER IS ZERO, THEN THAT MESSAGE IS NOT PRINTED. ; ; AFTER PRINTING THE MESSAGE, ASK IF THE USER WANTS TO CONTINUE. ; IF NOT, STOP THE PROGRAM. ; ; R0 AND R1 ARE NOT PRESERVED. ; ;***************************************************************** ; MODIFIED FOR VERSION 4.0 DA_ERROR: TSTL R1 ; IS IT ZERO? BEQL DA_SYS_ERR_MSG ; YES - SKIP OUR CALLER'S MSG PUSHR #^M ; SAVE SYSTEM ERR NUMBER PUSHL R1 ; PUSH ADR OF CALLER'S MESSAGE CALLS #1,G^LIB$PUT_OUTPUT ; WRITE CALLER'S MESSAGE POPR #^M ; RESTORE SYSTEM ERR NUMBER DA_SYS_ERR_MSG: TSTL R0 ; IS IT ZERO? BEQL DA_ASK_CONT ; YES - SKIP SYSTEM ERR MSG ;***************************************************************** ; ; IF THIS IS A "SEVERE" ERROR, CHANGE IT TO "ERROR" SO THE SYSTEM ; WON'T ABORT US. ; ;***************************************************************** EXTZV #0,#3,R0,R1 ; EXTRACT SEVERITY CMPL #4,R1 ; IS IT "SEVERE"? BNEQ DA_NOT_SEVERE ; NO INSV #3,#0,#3,R0 ; YES - CHANGE TO "ERROR" DA_NOT_SEVERE: PUSHL R0 ; PUSH SYSTEM ERROR NUMBER CALLS #1,G^LIB$SIGNAL ; PRINT SYSTEM ERROR MESSAGE DA_ASK_CONT: CMPL #JPI$K_BATCH,USER_MODE ; CHECK IF WE ARE IN BATCH BEQL BATCH_CHECK ; BRANCH TO BATCH CHECK IF SO PUSHAL FORCE_PROMPT ; ALWAYS PROMPT PUSHAL CONT_REPLY ; WHERE TO ANSWER'S LENGTH PUSHAQ CONT_MSG ; WHAT TO ASK PUSHAQ CONT_REPLY ; WHERE TO PUT REPLY CALLS #4,G^LIB$GET_FOREIGN ; "CONTINUE?" CMPB #^A/Y/,CONT_REPLY+8 ; CONTINUE? BEQLU DA_EXIT ; YES - RETURN TO CALLER CLRL CONTINUE ; NO - CLEAR CONTINUE FLAG: 0=ABORT DA_EXIT: RSB ; RETURN TO CALLER BATCH_CHECK: CMPL #SS$_PARITY,R0 ; CHECK IF THIS IS A PARITY ERROR BEQL BATCH_PARITY BATCH_QUIT: PUSHAL BATCH_QUIT_MSG ; PUSH ADDRESS OF BATCH QUIT MSG CALLS #1,G^LIB$PUT_OUTPUT ; WRITE BATCH QUIT MESSAGE CLRL CONTINUE ; ABORT THE PROGRAM RSB ; RETURN TO CALLER BATCH_PARITY: PUSHAL BATCH_PARITY_MSG ; PUSH ADDRESS OF BATCH PARITY MSG CALLS #1,G^LIB$PUT_OUTPUT ; WRITE MESSAGE RSB ; RETURN .PAGE .SUBTITLE CM - MOUNT TAPES ;********************************************************************** ; ; VERSION 4.00 ADDED ROUTINES HERE ; ;********************************************************************** EA_WRITE_EOF: $QIO_S EFN=#WRITE_EFN,- ; WRITE EOF TO OUTPUT DRIVE FUNC=#IO$_WRITEOF,- CHAN=WRITE_CHAN,- IOSB=WRITE_IO_STATUS_BLOCK RSB EA_GET_USER_MODE: $GETJPIW_S - PIDADR=0, - ITMLST=JPI_ITEM_LIST BLBS R0,EA_CONTINUE MOVAL JPI_ERROR_MSG, R1 JSB DA_ERROR EA_CONTINUE: RSB .END TCOPY