MODULE XRENAM ( IDENT = 'V1.1-29' %TITLE 'XPO$RENAME - XPORT File Rename' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$RENAME ),OTS='' ) ) = BEGIN ! ! COPYRIGHT (c) 1982 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module is the XPORT file rename module. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHORS: Ward Clark, CREATION DATE: 19 February 1979 ! Linda Duffell ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$RENAME; ! XPORT file rename routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11 ) %IF $TOPS10 %THEN REQUIRE 'XT10' ; ! TOPS-10 I/O interface macros %FI %IF $TOPS20 %THEN REQUIRE 'XT20'; ! TOPS-20 I/O interface macros %FI %IF $VMS %THEN REQUIRE 'XVMS' ; ! XPORT-specific VAX/VMS interface definitions %FI %IF $11M %THEN REQUIRE 'XRSX' ; ! XPORT-specific RSX-11 and FCS interface definitions %FI %IF $RSTS %THEN REQUIRE 'XRSTS' ; ! RSTS/E system interface definitions %FI %IF $RT11 %THEN REQUIRE 'XRT11' ; ! RT-11 system interface definitions %FI ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! LITERAL yes = 1, ! Used to turn an indicator on no = 0; ! Used to turn an indicator off %IF $VMS %THEN LITERAL max_file_spec = 255; ! Maximum length of a file specification %FI ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! %IF $TOPS10 %THEN EXTERNAL ROUTINE X10$CHAN_ASSIGN, ! Channel assignment routine X10$ASCII_6BIT, ! ASCII-to-sixbit conversion routine X10$ENTER_LOOKUP, ! Setup routine for the ENTER/LOOKUP block X10$LOOKUP_FINI, ! Completion routine for setting up the ENTER/LOOKUP block X10$CLEANUP; ! TOPS-10 control block cleanup routine %FI %IF $TOPS20 %THEN EXTERNAL ROUTINE X20$ERROR : NOVALUE; ! TOPS-20 to XPORT completion code conversion routine %FI %IF $VMS %THEN EXTERNAL ROUTINE XPO$RMS_PARSE, ! RMS file specification resultion routine XPO$RMS_ERROR : NOVALUE, ! RMS-to-XPORT completion code conversion routine XPO$RMS_CLEANUP; ! RMS control block cleanup routine %FI %IF $11M %THEN EXTERNAL XRSX$EVENT_FLAG; ! XPORT QIO/FCS event flag number EXTERNAL ROUTINE XRSX$SPEC_SETUP, ! File-spec setup and LUN assignment routine XRSX$DSPT_SETUP : NOVALUE, ! FCS DSPT setup routine XRSX$XOPEN, ! XPORT/FCS file open routine XRSX$RSLT_FIXUP, ! Resultant file-spec fixup routine XRSX$IO_ERROR : NOVALUE, ! FCS-to-XPORT completion code conversion routine XRSX$CLEANUP; ! QIO/FCS cleanup routine %FI %IF $RSTS %THEN EXTERNAL ROUTINE XRST$SPEC_SETUP, ! File-spec setup routine XRST$ERROR : NOVALUE; ! RSTS-to-XPORT completion code conversion routine %FI %IF $RT11 %THEN EXTERNAL XPO$CHANNELS : BITVECTOR[]; ! Channel assignment vector in XPO$OPEN EXTERNAL LITERAL XPO$K_MAX_CHAN; ! Maximum I/O channel number EXTERNAL ROUTINE XRT$ASCII_RAD50 : NOVALUE, ! ASCII to RADIX-50 conversion routine XRT$CHK_BACKGRD, ! Background job verification XRT$FETCH; ! Fetch I/O handler routine %FI GLOBAL ROUTINE XPO$RENAME ( iob, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine is the XPORT file rename routine. ! ! FORMAL PARAMETERS: ! ! iob - address of IOB ! success_action - address of success action routine ! failure_action - address of failure action routine ! ! IMPLICIT INPUTS: ! ! Information contained in or pointed to by the caller's IOB ! ! IMPLICIT OUTPUTS: ! ! Various fields in the caller's IOB are updated to reflect ! the results of the file rename function ! ! COMPLETION CODES: ! ! XPO$_NORMAL - the file was successfully renamed ! ! XPO$_BAD_DEVICE - invalid device specified ! XPO$_BAD_IOB - the IOB is invalid ! ( IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid IOB length ) ! XPO$_BAD_LOGIC - FAB and/or RAB exists (VMS) ! XPO$_BAD_NEW - invalid new file specification ! ( IOB$G_2ND_CODE = XPO$_BAD_DEVICE - invalid device name or device name not allowed ! or XPO$_NO_CONCAT - concatenated file-spec not allowed ! or XPO$_NO_TEMP - temporary file-spec not allowed ) ! XPO$_BAD_RSLT - invalid resultant file specification ! ( IOB$G_2ND_CODE = completion code from $XPO_PARSE_SPEC ! or completion code from $STR_COPY ! or completion code from XRSX$RSLT_FIXUP (11M) ) ! XPO$_BAD_SPEC - invalid file specification ! ( IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid length (TOPS-20) ! or XPO$_NO_CONCAT - a concatenated old file was specified ) ! XPO$_EXISTS - the file already exists (RT-11) ! XPO$_FOREGROUND - this is a foreground job (RT-11) ! XPO$_FREE_MEM - resultant file-spec cannot be freed ! ( IOB$G_2ND_CODE = completion code from $XPO_FREE_MEM ) ! XPO$_GET_MEM - insufficient memory for RMS control blocks (VMS) ! ( IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! XPO$_IO_ERROR - I/O error (RT-11) ! XPO$_NO_CHANNEL - no I/O channel is available ! XPO$_NO_FILE - file not found (RT-11) ! XPO$_OPEN - the file has already been opened ! failure completion codes from $XPO_VALID_IOB ! failure completion codes from $XPO_BUILD_SPEC (TOPS-10, TOPS-20, RT-11) ! failure completion code from $T10_ERROR (TOPS-10) ! failure completion codes from X20$ERROR (TOPS-20) ! failure completion codes from XPO$RMS_PARSE (VMS) ! failure completion codes from XPO$RMS_CLEANUP (VMS) ! failure completion codes from XPO$RMS_ERROR (VMS) ! failure completion codes from XRSX$SPEC_SETUP (11M) ! failure completion codes from XRSX$IO_ERROR (11M) ! failure completion codes from XRSX$CLEANUP (11M) ! failure completion codes from XRST$SPEC_SETUP (RSTS) ! failure completion codes from XRST$ERROR (RSTS) ! failure completion codes from XRT$FETCH (RT-11) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND old_iob = .iob : $XPO_IOB(), new_iob = .old_iob[IOB$A_ASSOC_IOB] : $XPO_IOB(); %IF $TOPS10 %THEN LOCAL channel_open; ! Channel open indicator %FI %IF $TOPS20 %THEN LOCAL new_jfn_assign, ! JFN assignment indicator for new file. old_jfn_assign; ! JFN assignment indicator for old file. %FI %IF $RT11 %THEN LOCAL channel_assign, ! Channel assignment indicator rename_block : BLOCKVECTOR[ 2, LOOK$K_ARG_LEN ]; BIND rename_old = rename_block[ 0, $BASE ] : $XRT_LOOK_ARGS, rename_new = rename_block[ 1, $BASE ] : $XRT_LOOK_ARGS; %FI ! ! XPORT routine initialization. ! $XPO_MAIN_BEGIN( IO, FIXUP_IOB ) ! Define the MAIN_BLOCK code block ! and validate the caller's IOB. %IF $TOPS10 %THEN channel_open = no; ! Indicate that no channel has been opened. %FI %IF $TOPS20 %THEN new_jfn_assign = no; ! Indicate that no JFN has been assigned to the new file. old_jfn_assign = no; ! Indicate that no JFN has been assigned to the old file. %FI %IF $RT11 %THEN channel_assign = no; ! Indicate that no channel has been assigned. %FI ! ! Establish IOB defaults. ! IF .new_iob[IOB$A_RELATED] EQL 0 ! If no new related file-spec was specified, THEN ! new_iob[IOB$A_RELATED] = ! use the current resultant file-spec. old_iob[IOB$T_RESULTANT]; $XPO_VALID_IOB( old_iob ); ! Validate or default caller's file-specs and prompt string. $XPO_VALID_IOB( new_iob, BAD_NEW ); ! ! Check the IOB for invalid or conflicting information. ! ! Return an error code if the IOB is invalid ! for one of the following reasons: IF .old_iob[IOB$V_OPEN] ! the file is already open THEN $XPO_QUIT( OPEN ); IF $STR_SCAN( STRING = .old_iob[IOB$A_FILE_SPEC], ! a concatenated old file-spec was specified FIND = '+', FAILURE = 0 ) THEN $XPO_QUIT( BAD_SPEC, NO_CONCAT ); IF $STR_SCAN( STRING = .new_iob[IOB$A_FILE_SPEC], ! a concatenated new file-spec was specified FIND = '+', FAILURE = 0 ) THEN $XPO_QUIT( BAD_NEW, NO_CONCAT ); !+ ! ! System-specific file rename processing follows. ! !- %TITLE 'TOPS-10 File Rename' %IF $TOPS10 %THEN !+ ! ! TOPS-10 File Rename Processing ! ! NOTE: The following code is very similar to the code in ! XPO$DELETE since TOPS-10 file delete is a special ! form of file rename. ! !- BEGIN LOCAL old_parse : $XPO_SPEC_BLOCK, ! Old resultant file-spec parse block new_parse : $XPO_SPEC_BLOCK, ! New resultant file-spec parse block open_args : $T10_OPEN_ARGS, ! TOPS-10 OPEN argument list lookup_args : $T10_LOOK_ARGS, ! TOPS-10 LOOKUP argument list old_pgmr_numb, ! Storage area for the old programmer number old_proj_numb; ! Storage area for the old project number BIND ! Redefine several spec-block fields. old_device = old_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), new_device = new_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), new_name = new_parse[XPO$T_FILE_NAME] : $STR_DESCRIPTOR(), new_type = new_parse[XPO$T_FILE_TYPE] : $STR_DESCRIPTOR(); ! ! Build a resultant file specifications from the specifications passed by the caller. ! $XPO_BUILD_SPEC( old_iob ); $XPO_BUILD_SPEC( new_iob, BAD_NEW ); ! ! Validate the old and new file specifications. ! IF .old_iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. IF .new_iob[IOB$V_TERMINAL] ! If the new file is the user's terminal, THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Parse the old and new resultant file specifications into their individual components. ! $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = old_iob[IOB$T_RESULTANT], SPEC_BLOCK = old_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = new_iob[IOB$T_RESULTANT], SPEC_BLOCK = new_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); IF .new_device[STR$H_LENGTH] NEQ 0 AND ! If the new file-spec includes a device name NOT $STR_EQL( ! which is different from the old file-spec device name, STRING1 = old_parse[XPO$T_DEVICE], ! STRING2 = new_parse[XPO$T_DEVICE], ! FAILURE = 0 ) ! THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. ! ! Assign a TOPS-10 I/O channel to this file. ! IF NOT X10$CHAN_ASSIGN( .old_iob ) THEN $XPO_QUIT(); ! ! Setup the OPEN argument list. ! INCR index FROM 0 TO OPEN$K_ARG_LEN-1 DO ! Zero the open argument list. open_args[.index,0,%BPVAL,0] = 0; open_args[OPEN$T_DEVICE] = ! Convert the device name to 6-bit and put it X10$ASCII_6BIT( ! in the argument list. .old_device[STR$H_LENGTH] - 1, .old_device[STR$A_POINTER] ); ! ! Open the assigned channel. ! IF $T10_OPEN( .old_iob[IOB$H_CHANNEL], open_args ) ! If the assigned channel can be opened, THEN ! channel_open = yes ! indicate that a channel has been opened. ELSE $XPO_QUIT( BAD_DEVICE ); ! Otherwise, return an error code to the caller. ! ! Setup the LOOKUP argument list. ! IF NOT X10$ENTER_LOOKUP( .old_iob, old_parse, lookup_args ) THEN $XPO_QUIT(); ! ! Perform a LOOKUP monitor call. ! IF NOT $T10_LOOKUP( ! Perform a TOPS-10 LOOKUP: .old_iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the LOOKUP fails, $T10_ERROR( .lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_FILE ); ! ! Change the LOOKUP argument list into a RENAME argument list. ! lookup_args[LOOK$H_PROJ] = 0; ! Initialize the project number. IF .old_parse[XPO$V_PPN] ! Default to the old file's PPN. THEN lookup_args[LOOK$H_PGMR] = lookup_args[LOOK$Z_PATH] ELSE lookup_args[LOOK$H_PGMR] = 0; IF NOT X10$LOOKUP_FINI( .new_iob, new_parse, lookup_args ) THEN $XPO_QUIT(); ! ! Perform a RENAME monitor call. ! IF NOT $T10_RENAME( ! Perform a TOPS-10 RENAME: .old_iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the RENAME fails, $T10_ERROR( .lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_RENAME ); $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of TOPS-10 code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! ! Close and release the assigned I/O channel. ! IF .channel_open ! If a channel has been opened, THEN ! BEGIN ! $T10_CLOSE( .old_iob[IOB$H_CHANNEL] ); ! close the assigned channel $T10_RELEASE( .old_iob[IOB$H_CHANNEL] ); ! and release the channel assignment. END; !+ ! ! End of TOPS-10 File Rename Processing ! !- %FI %TITLE 'TOPS-20 RENAME' %IF $TOPS20 %THEN !+ ! ! TOPS-20 File Rename Processing ! ! !- BEGIN LOCAL jfn_or_error, ! Storage area for JFN or error code old_parse : $XPO_SPEC_BLOCK, ! Old file-spec parse block new_parse : $XPO_SPEC_BLOCK, ! New file-spec parse block new_spec : VECTOR[CH$ALLOCATION(X20$K_MAX_SPEC)], old_spec : VECTOR[CH$ALLOCATION(X20$K_MAX_SPEC)]; BIND ! Redefine several spec-block fields. old_device = old_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), new_device = new_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), new_resultant = new_iob[IOB$T_RESULTANT] : $STR_DESCRIPTOR(), old_resultant = old_iob[IOB$T_RESULTANT] : $STR_DESCRIPTOR(); ! ! Build a resultant file specifications from the specifications passed by the caller. ! $XPO_BUILD_SPEC( old_iob ); $XPO_BUILD_SPEC( new_iob, BAD_NEW ); ! ! Validate the old and new file specifications. ! IF .old_iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. IF .new_iob[IOB$V_TERMINAL] ! If the new file is the user's terminal, THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Parse the old and new resultant file specifications into their individual components. ! $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = old_iob[IOB$T_RESULTANT], SPEC_BLOCK = old_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = new_iob[IOB$T_RESULTANT], SPEC_BLOCK = new_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); ! ! The TOPS-20 RENAME will fail if the disk structures are different. ! The following code did not allow for logical names. Therefore we ! commented it out. ! ! IF .new_device[STR$H_LENGTH] NEQ 0 AND ! If the new file-spec includes a device name ! NOT $STR_EQL( ! which is different from the old file-spec device name, ! STRING1 = old_parse[XPO$T_DEVICE], ! ! STRING2 = new_parse[XPO$T_DEVICE], ! ! FAILURE = 0 ) ! ! THEN ! ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. ! ! Find out if we're renaming a file to itself. ! Comment the following code out. The user may wish a new version number. ! ! IF $STR_EQL( STRING1 = old_resultant, ! If we're renaming a file to itself, ! STRING2 = new_resultant, ! ! FAILURE = 0 ) ! ! THEN ! ! $XPO_QUIT( NORMAL ); ! return a success code to the caller. ! ! Make the resultant file-specs ASCIZ. ! IF NOT $X20_ASCIZ( new_resultant, new_spec ) ! Make the new file-spec ASCIZ. THEN $XPO_QUIT( BAD_RSLT, BAD_LENGTH ); ! If file-spec is too long return error code to the caller. IF NOT $X20_ASCIZ( old_resultant, old_spec ) ! Make the old file-spec ASCIZ. THEN BEGIN new_iob[IOB$G_COMP_CODE] = XPO$_BAD_RSLT; new_iob[IOB$G_2ND_CODE] = XPO$_BAD_LENGTH; $XPO_QUIT( BAD_NEW ); END; ! ! Associate the old file with a JFN. ! IF NOT $T20_GTJFN( ! Get the JFN: GJ_SHT OR GJ_OLD, ! Short form, file exists CH$PTR( old_spec), ! Pointer to file_spec jfn_or_error ) ! Storage area for JFN or error code THEN BEGIN X20$ERROR( old_iob, .jfn_or_error ); $XPO_QUIT(); END; old_iob[IOB$H_CHANNEL] = .jfn_or_error; ! Save the JFN. old_jfn_assign = yes; ! Indicate the JFN has been assigned. ! ! Associate the new file with a JFN. ! IF NOT $T20_GTJFN( ! Get the JFN: GJ_SHT OR GJ_FOU, ! Short form, new generation CH$PTR( new_spec), ! Pointer to new file-spec jfn_or_error ) ! Storage area for JFN or error code THEN BEGIN X20$ERROR( old_iob, .jfn_or_error ); $XPO_QUIT(); END; new_iob[IOB$H_CHANNEL] = .jfn_or_error; ! Save the JFN. new_jfn_assign = yes; ! Indicate the JFN has been assigned. ! ! Perform a RENAME monitor call. ! IF NOT $T20_RNAMF( ! Perform a TOPS-20 RENAME: .old_iob[IOB$H_CHANNEL], ! JFN of existing file .new_iob[IOB$H_CHANNEL], ! JFN of new file jfn_or_error ) ! Storage area for possible error code THEN BEGIN X20$ERROR( old_iob, .jfn_or_error ); $XPO_QUIT(); END; $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of TOPS-20 code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! ! Release the assigned JFN. ! IF .old_jfn_assign ! If the JFN has been assigned to the existing file, THEN ! BEGIN ! $T20_RLJFN( .old_iob[IOB$H_CHANNEL] ); ! release the JFN, old_iob[IOB$H_CHANNEL] = 0; ! and zero the IOB JFN field. END; IF .new_jfn_assign ! If the JFN has been assigned to the existing file, THEN ! BEGIN ! $T20_RLJFN( .new_iob[IOB$H_CHANNEL] ); ! release the JFN, new_iob[IOB$H_CHANNEL] = 0; ! and zero the IOB JFN field. END; !+ ! ! End of TOPS-20 File Rename Processing ! !- %FI %TITLE 'VAX/VMS File Rename' %IF $VMS %THEN !+ ! ! VAX/VMS File Rename Processing ! !- BEGIN LOCAL old_fab : REF $FAB_DECL, ! Address of RMS FAB for old file new_fab : REF $FAB_DECL, ! Address of RMS FAB for new file old_name_block : REF $NAM_DECL, ! Address of RMS Name Block new_name_block : REF $NAM_DECL, ! Address of RMS Name Block old_result_spec : ! Space for the old file resultant file-spec VECTOR[ CH$ALLOCATION(max_file_spec) ], new_result_spec : ! Space for the new file resultant file-spec VECTOR[ CH$ALLOCATION(max_file_spec) ]; ! ! Make sure that no FAB or RAB already exists. ! IF .old_iob[IOB$A_RMS_FAB] NEQ 0 OR ! If a FAB already exists .old_iob[IOB$A_RMS_RAB] NEQ 0 ! or a RAB already exists, THEN ! $XPO_QUIT( BAD_LOGIC ); ! return an error code to the caller. ! ! Create RMS File Access Blocks (FAB) for the old and new file names. ! $XPO_IF_NOT( $XPO_GET_MEM( UNITS = FAB$C_BLN, ! Get dynamic memory for a FAB. RESULT = old_fab, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); old_iob[IOB$A_RMS_FAB] = .old_fab; ! Save the address of the old file FAB. $FAB_INIT( FAB = .old_fab ); ! Initialize the old file FAB: old_fab[FAB$V_MXV] = .old_iob[IOB$V_MAX_VERSI]; ! "maximize file version" indicator $XPO_IF_NOT( $XPO_GET_MEM( UNITS = FAB$C_BLN, ! Get dynamic memory for a FAB. RESULT = new_fab, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); new_iob[IOB$A_RMS_FAB] = .new_fab; ! Save the address of the new file FAB. $FAB_INIT( FAB = .new_fab, ! Initialize the new file FAB: FOP = OFP ); ! "output file parse" indicator new_fab[FAB$V_MXV] = .old_iob[IOB$V_MAX_VERSI]; ! "maximize file version" indicator ! ! Use RMS PARSE to perform file specification resolution for the old and new file-specs. ! IF NOT XPO$RMS_PARSE( old_iob ) ! Resolve the old file-spec. THEN $XPO_QUIT(); old_name_block = .old_fab[FAB$L_NAM]; ! Update the Name Block built by XPO$RMS_PARSE: old_name_block[NAM$B_RSS] = max_file_spec; ! length of resultant file-spec buffer old_name_block[NAM$L_RSA] = old_result_spec; ! pointer to the resultant file-spec buffer IF .new_iob[IOB$A_RELATED] EQL 0 ! If no new related file-spec was specified, THEN ! new_iob[IOB$A_RELATED] = ! use the current resultant file-spec. old_iob[IOB$T_RESULTANT]; IF NOT XPO$RMS_PARSE( new_iob ) ! Resolve the new file-spec. THEN $XPO_QUIT( BAD_NEW ); new_name_block = .new_fab[FAB$L_NAM]; ! Update the Name Block built by XPO$RMS_PARSE: new_name_block[NAM$B_RSS] = max_file_spec; ! length of resultant file-spec buffer new_name_block[NAM$L_RSA] = new_result_spec; ! pointer to the resultant file-spec buffer IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Use RMS RENAME to rename the file. ! $RMS_RENAME( OLDFAB = .old_fab, ! Rename the file. NEWFAB = .new_fab ); ! ! Save the resultant file specifications. ! IF .old_name_block[NAM$B_RSL] NEQ 0 ! If an old file resultant file-spec was created by RMS, THEN ! BEGIN ! $XPO_IF_NOT( $STR_COPY( ! copy the file-spec into dynamic memory. STRING = (.old_name_block[NAM$B_RSL], .old_name_block[NAM$L_RSA]), TARGET = old_iob[IOB$T_RESULTANT], FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); old_name_block[NAM$L_RSA] = ! Then have the Name Block point to the copied file-spec. .old_iob[$SUB_FIELD(IOB$T_RESULTANT,STR$A_POINTER)]; END; old_name_block[NAM$B_RSS] = 0; ! Zero the resultant buffer length for safety sake. IF .new_name_block[NAM$B_RSL] NEQ 0 ! If an new file resultant file-spec was created by RMS, THEN ! BEGIN ! $XPO_IF_NOT( $STR_COPY( ! copy the file-spec into dynamic memory. STRING = (.new_name_block[NAM$B_RSL], .new_name_block[NAM$L_RSA]), TARGET = new_iob[IOB$T_RESULTANT], FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); new_name_block[NAM$L_RSA] = ! Then have the Name Block point to the copied file-spec. .new_iob[$SUB_FIELD(IOB$T_RESULTANT,STR$A_POINTER)]; END; new_name_block[NAM$B_RSS] = 0; ! Zero the resultant buffer length for safety sake. ! ! Check for a file rename failure. ! IF NOT .old_fab[FAB$L_STS] ! If file renaming failed, THEN ! BEGIN ! XPO$RMS_ERROR( old_iob, .old_fab[FAB$L_STS], ! convert the RMS completion codes into .old_fab[FAB$L_STV] ); ! equivalent XPORT completion codes $XPO_QUIT(); ! and then jump to return to the caller. END; $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of VMS code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; %FI %TITLE 'RSX-11M File Rename' %IF $11M %THEN !+ ! ! RSX-11M File Rename Processing ! !- BEGIN LOCAL old_parse : $XPO_SPEC_BLOCK, ! Old resultant file-spec parse block new_parse : $XPO_SPEC_BLOCK; ! New resultant file-spec parse block ! ! Make sure that no QIO/FCS information already exists. ! IF .old_iob[IOB$H_CHANNEL] NEQ 0 OR ! If a LUN has been assigned .old_iob[IOB$A_FCS_FDB] NEQ 0 ! or XPORT's FCS blocks have been allocated, THEN ! $XPO_QUIT( BAD_LOGIC ); ! return an error code to the caller. ! ! Build resultant file specifications from the specifications passed by the caller ! and assign RSX-11M Logical Unit Numbers (LUN) to the old and new files. ! IF NOT XRSX$SPEC_SETUP( old_iob, old_parse ) ! Setup the old file-spec. THEN $XPO_QUIT(); IF .new_iob[IOB$A_RELATED] EQL 0 ! If no new related file-spec was specified, THEN ! new_iob[IOB$A_RELATED] = ! use the current resultant file-spec. old_iob[IOB$T_RESULTANT]; IF NOT XRSX$SPEC_SETUP( new_iob, new_parse ) ! Setup the new file-spec. THEN $XPO_QUIT( BAD_NEW ); ! ! Validate the old and new file specifications. ! IF .old_iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. IF .new_iob[IOB$V_TERMINAL] ! If the new file is the user's terminal, THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Allocate an XPORT set of FCS control blocks for each IOB. ! $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = FCS$K_BLK_LEN, RESULT = old_iob[IOB$A_FCS_FDB], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = FCS$K_BLK_LEN, RESULT = new_iob[IOB$A_FCS_FDB], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); BEGIN BIND old_fcs_blocks = .old_iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, old_fdb = old_fcs_blocks[FCS$Z_FDB] : FDB$, new_fcs_blocks = .new_iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, new_fdb = new_fcs_blocks[FCS$Z_FDB] : FDB$; ! ! Setup the FCS File Descriptor Blocks (FDB). ! ! Setup old FDB fields: old_fdb[F$LUN] = .old_iob[IOB$H_CHANNEL]; ! logical unit number (LUN) old_fdb[F$DSPT] = old_fcs_blocks[FCS$Z_DS_DESC]; ! address of FCS dataset descriptor old_fdb[F$EFN] = .XRSX$EVENT_FLAG; ! event flag number ! Setup new FDB fields: new_fdb[F$LUN] = .new_iob[IOB$H_CHANNEL]; ! logical unit number (LUN) new_fdb[F$DSPT] = new_fcs_blocks[FCS$Z_DS_DESC]; ! address of FCS dataset descriptor new_fdb[F$EFN] = .XRSX$EVENT_FLAG; ! event flag number ! ! Setup the FCS Dataset Descriptors (DSPT). ! XRSX$DSPT_SETUP( old_fcs_blocks[FCS$Z_DS_DESC], old_parse ); XRSX$DSPT_SETUP( new_fcs_blocks[FCS$Z_DS_DESC], new_parse ); ! ! Open the file to be renamed. ! IF NOT XRSX$XOPEN( old_iob ) ! Open the specified file. THEN BEGIN XRSX$RSLT_FIXUP( old_iob ); XRSX$IO_ERROR( old_iob, .old_fdb[F$ERR] ); $XPO_QUIT(); END; $XPO_IF_NOT( XRSX$RSLT_FIXUP( old_iob ) ) ! Fixup the old resultant file-spec. THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); ! ! Rename the file. ! BEGIN EXTERNAL ROUTINE %NAME( '.RENAM' ); BUILTIN R0, ! Points to old file FDB R1; ! Points to new file FDB R0 = old_fdb; ! Setup the FDB address registers. R1 = new_fdb; %NAME( '.RENAM' )(); ! Rename the file. IF .old_fdb[F$ERR] NEQ IS$SUC ! Check for a rename failure. THEN BEGIN XRSX$RSLT_FIXUP( new_iob ); IF .old_fdb[F$ERR] EQL IE$NSF ! "no such file" means "no such directory" THEN $XPO_QUIT( BAD_NEW, NO_DIRECT ); XRSX$IO_ERROR( old_iob, .old_fdb[F$ERR] ); $XPO_QUIT(); END; END; ! ! Cleanup the IOBs after a successful file rename. ! IF .old_iob[IOB$V_REMEMBER] ! If the file will be reprocessed, THEN ! BEGIN ! $XPO_IF_NOT( XRSX$RSLT_FIXUP( new_iob ) ) ! fixup the new resultant file-spec. THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); END; $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of "FCB block BINDs" code block END; ! End of RSX-11M code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. !+ ! ! End of RSX-11M File Rename Processing ! !- %FI %TITLE 'RSTS/E File Rename' %IF $RSTS %THEN !+ ! ! RSTS/E File Rename Processing ! !- BEGIN LOCAL new_parse : $XRST_REN_ARGS; ! New resultant file-spec rename parse block ! ! Build a resultant file specifications for the new file and save the information in the FIRQB. ! IF NOT XRST$SPEC_SETUP( new_iob ) THEN $XPO_QUIT(); ! ! Validate the new file specifications. ! IF .new_iob[IOB$V_TERMINAL] ! If the new file is the user's terminal, THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Save the file information in the rename block. ! INCR index FROM 0 TO FQBSIZ - 1 DO new_parse[ .index,0,%BPVAL,0 ] = .$XRSTS_FIRQB[ .index,0,%BPVAL,0 ]; ! ! Build a resultant file specification for the old file and save the information in the FIRQB. ! IF NOT XRST$SPEC_SETUP( old_iob ) THEN $XPO_QUIT(); ! ! Validate the old file specification. ! IF .old_iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. IF .$XRSTS_FIRQB[FQDEV] NEQ .new_parse[FQDEV] OR ! Return an error completion code if we're .$XRSTS_FIRQB[FQDEV2] NEQ .new_parse[FQDEV2] ! attempting to rename a file across different THEN ! disk structures. $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! ! Zero the unused fields and fill in the new file specifications in the FIRQB. ! $XRSTS_FIRQB[FQJOB] = 0; $XRSTS_FIRQB[FQSIZM] = 0; $XRSTS_FIRQB[FQSIZ] = 0; $XRSTS_FIRQB[FQCLUS] = 0; $XRSTS_FIRQB[FQNENT] = 0; $XRSTS_FIRQB[FQBUFL] = .new_parse[FQNAMA]; $XRSTS_FIRQB[FQMODE] = .new_parse[FQNAMB]; $XRSTS_FIRQB[FQFLAG] = .new_parse[FQEXT]; $XRSTS_FIRQB[FQPFLG] = .new_parse[FQPFLG]; $XRSTS_FIRQB[FQPROT] = .new_parse[FQPROT]; $XRSTS_FIRQB[FQFUN] = RENFQ; ! ! Rename the file. ! $CALFIP; IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! Report any errors. THEN BEGIN XRST$ERROR( old_iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of RSTS/E code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; !+ ! ! End of RSTS/E File Rename Processing ! !- %FI %TITLE 'RT-11 File Rename' %IF $RT11 %THEN !+ ! ! RT-11 File Rename Processing ! ! NOTE: The following code is very similar to the TOPS-10 code. ! !- BEGIN LOCAL error_code, ! Error condition indicator old_parse : $XPO_SPEC_BLOCK, ! Old resultant file-spec parse block new_parse : $XPO_SPEC_BLOCK; ! New resultant file-spec parse block BIND ! Redefine several spec-block fields. old_device = old_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), old_name = old_parse[XPO$T_FILE_NAME] : $STR_DESCRIPTOR(), old_type = old_parse[XPO$T_FILE_TYPE] : $STR_DESCRIPTOR(), new_device = new_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), new_name = new_parse[XPO$T_FILE_NAME] : $STR_DESCRIPTOR(), new_type = new_parse[XPO$T_FILE_TYPE] : $STR_DESCRIPTOR(); ! ! Verify that this is a background job. ! IF NOT XRT$CHK_BACKGRD() THEN $XPO_QUIT( FOREGROUND ); ! ! Initialize the error condition flag. ! error_code = no; ! ! Build a resultant file specifications from the specifications passed by the caller. ! $XPO_BUILD_SPEC( old_iob ); $XPO_BUILD_SPEC( new_iob, BAD_NEW ); ! ! Validate the old and new file specifications. ! IF .old_iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. IF .new_iob[IOB$V_TERMINAL] ! If the new file is the user's terminal, THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. IF .new_iob[IOB$V_TEMPORARY] ! If the new file is a temporary file, THEN ! $XPO_QUIT( BAD_NEW, NO_TEMP ); ! return error codes to the caller. ! ! Parse the old and new resultant file specifications into their individual components. ! $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = old_iob[IOB$T_RESULTANT], SPEC_BLOCK = old_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_PARSE_SPEC( FILE_SPEC = new_iob[IOB$T_RESULTANT], SPEC_BLOCK = new_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); IF .new_device[STR$H_LENGTH] NEQ 0 AND ! If the new file-spec includes a device name NOT $STR_EQL( ! which is different from the old file-spec device name, STRING1 = old_parse[XPO$T_DEVICE], ! STRING2 = new_parse[XPO$T_DEVICE], ! FAILURE = 0 ) ! THEN ! $XPO_QUIT( BAD_NEW, BAD_DEVICE ); ! return error codes to the caller. ! ! Setup the RADIX-50 RENAME block for the old file. ! INCR index FROM 0 TO LOOK$K_ARG_LEN-1 DO ! Zero the old file argument list. rename_old[.index,0,%BPVAL,0] = 0; ! Fill in the argument list: XRT$ASCII_RAD50( ! device name (Radix-50) .old_device[STR$A_POINTER], ! .old_device[STR$H_LENGTH] - 1, ! rename_old[LOOK$T_DEVICE], ! 1, 0 ); ! ! XRT$ASCII_RAD50( ! file name (Radix-50) .old_name[STR$A_POINTER], ! .old_name[STR$H_LENGTH], ! rename_old[LOOK$T_NAME1], ! 2, 0 ); ! ! XRT$ASCII_RAD50( ! file type (Radix-50) CH$PLUS(.old_type[STR$A_POINTER], 1), ! .old_type[STR$H_LENGTH] - 1, ! rename_old[LOOK$T_TYPE], ! 1, 0 ); ! ! ! Setup the RADIX-50 RENAME block for the new file. ! INCR index FROM 0 TO LOOK$K_ARG_LEN-1 DO ! Zero the new file argument list. rename_new[.index,0,%BPVAL,0] = 0; ! Fill in the argument list: XRT$ASCII_RAD50( ! device name (Radix-50) .new_device[STR$A_POINTER], ! .new_device[STR$H_LENGTH] - 1, ! rename_new[LOOK$T_DEVICE], ! 1, 0 ); ! ! XRT$ASCII_RAD50( ! file name (Radix-50) .new_name[STR$A_POINTER], ! .new_name[STR$H_LENGTH], ! rename_new[LOOK$T_NAME1], ! 2, 0 ); ! ! XRT$ASCII_RAD50( ! file type (Radix-50) CH$PLUS(.new_type[STR$A_POINTER], 1), ! .new_type[STR$H_LENGTH] - 1, ! rename_new[LOOK$T_TYPE], ! 1, 0 ); ! ! ! Fetch the I/O handler for the specified device. ! IF NOT XRT$FETCH( old_iob, rename_old[LOOK$T_DEVICE] ) THEN $XPO_QUIT(); ! ! Assign an RT-11 I/O channel to this file. ! WHILE 1 DO ! Loop until we find a free channel. BEGIN INCR channel FROM 0 TO xpo$k_max_chan+1 DO ! Search for an unused I/O channel.(i.e. unused by XPORT) BEGIN IF .channel GTR xpo$k_max_chan ! If all channels have been assigned, THEN ! $XPO_QUIT( NO_CHANNEL ); ! return an error code to the caller. IF NOT .xpo$channels[.channel] ! If this channel is not assigned, THEN ! BEGIN ! XPO$CHANNELS[.channel] = yes; ! indicate that this channel is in use, old_iob[IOB$H_CHANNEL] = .channel; ! save the channel number, and channel_assign = yes; ! indicate that the channel has been assigned. EXITLOOP; END; END; ! ! Don't allow renames to files which already exist. ! $LOOKUP( ! Perform an RT-11 LOOKUP: .iob[IOB$H_CHANNEL], ! channel number rename_new, 0, ! address of argument list error_code = yes ); ! if an error occurs then set error code IF NOT .error_code ! If the file already exists THEN ! $XPO_QUIT( EXISTS ); ! return an error completion code to the caller. error_code = no; ! Otherwise, reinitialize the error condition flag. ! ! Rename the file. ! IF NOT $RENAME( ! Perform an RT-11 RENAME: .old_iob[IOB$H_CHANNEL], ! channel number rename_block ) ! address of argument block THEN ! BEGIN ! If an error occurred and IF .RT_ERR_EMT ! the error bit is set to 1 then THEN ! $XPO_QUIT( NO_FILE ); ! the file does not exist. IF .RT_ERR_EMT NEQ 0 ! If the error bit is set to 2 THEN ! $XPO_QUIT( IO_ERROR ); ! then an I/O error occurred. ! Otherwise, the channel is in use. END ELSE EXITLOOP; ! Successful lookup - channel was not in use. END; ! End of channel loop $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of RT11 code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! ! Release the assigned I/O channel. ! IF .channel_assign ! If a channel number has been assigned, THEN ! BEGIN ! XPO$CHANNELS[.old_iob[IOB$H_CHANNEL]] = no; ! release the channel number and old_iob[IOB$H_CHANNEL] = 0; ! zero the IOB channel field. END; !+ ! ! End of RT-11 File Rename Processing ! !- %FI %TITLE 'XPO$RENAME Routine Termination' !+ ! ! Continuation of system-independent file rename processing ! !- ! ! Cleanup the IOBs after a successful file rename. ! IF .iob[IOB$G_COMP_CODE] THEN BEGIN IF .old_iob[IOB$V_REMEMBER] ! REMEMBER processing: THEN BEGIN $XPO_IF_NOT( $STR_COPY( ! Save the new file-spec. STRING = new_iob[IOB$T_RESULTANT], TARGET = old_iob[IOB$T_RESULTANT], FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); $XPO_LEAVE_IOB( old_iob ); ! Cleanup the old file IOB. old_iob[IOB$A_FILE_SPEC] = ! Reset the primary file-spec. old_iob[IOB$T_RESULTANT]; END ELSE ! Non-REMEMBER processing: $XPO_ZAP_IOB( old_iob ); ! Reinitialize the old file IOB. $XPO_ZAP_IOB( new_iob ); ! Reinitialize the new file IOB. END; ! ! Call an appropriate action routine. ! $XPO_ACTION_RTN( old_iob ); ! Call a success or failure action routine. ! ! Cleanup the IOBs after a file rename failure. ! IF NOT .old_iob[IOB$G_COMP_CODE] ! If the file rename failed, THEN ! BEGIN ! $XPO_ZAP_IOB( old_iob ); ! cleanup the old file IOB $XPO_ZAP_IOB( new_iob ); ! and the new file IOB. END; ! ! Return to the caller. ! RETURN .old_iob[IOB$G_COMP_CODE] ! Return the IOB completion code to the caller. END; ! End of XPO$RENAME routine END ELUDOM