Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
apxfil.b36
There is 1 other file named apxfil.b36 in the archive. Click here to see a list.
MODULE APXFIL (
LANGUAGE(BLISS36),
ENTRY (
BUF_READ,
BUF_WRITE,
CK_FILE,
PCK_FILE, ![106]
CKW_FILE,
SCK_FILE,
CLOSE,
DEF_LN,
DELETE,
DISPLAY_FILES,
DISP_BUILD_FILES,
DISP_NEW_FILES,
DISP_FILE,
DISP_LN_DEFS,
FILE_COPY,
F_COPY,
GET_BYTES,
OPEN_I,
OPN_IE, ![106]
OPEN_O,
R_REL,
UPD_FILE
)
) =
BEGIN
!
! COPYRIGHT (c) 1980 BY
! Digital Equipment Corporation, Maynard, MA.
!
! 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:
!
! Autopatch Exec File Support Routines
!
! ABSTRACT:
!
!
!
!
! ENVIRONMENT: TOPS-20 / TOPS-10
!
! AUTHOR: Donald R. Brandt, CREATION DATE: 3 April 1980
!
! MODIFIED BY:
!
! Revision history follows
!
!--
!
! Edit History for APXFIL
!
! FIL001 by DRB on 24-Dec-80
! Modified message strings so that they refer to
! "autopatching" rather than "patching" directory. This is
! then consistent with the documentation.
!
! 063 by ESB on 25-Mar-82
! Add code to routine DISPLAY_FILES to display the file names, checksums,
! and version numbers of the expected utility files for the product.
!
! 071 by ESB on 23-Jun-82
! In DISP_FILE, if the filespec is null, don't output anything.
! Move the CRLF and blanks that are output before each call to
! DISP_FILE into DISP_FILE.
!
! 110 by RBW on 22-Aug-83
! Added routines PCK_FILE and OPN_IE so that Build may tolerate a
! file protection violation. Also added Literal ERPRT$ ... Galaxy's
! error code for a protection violation. I also eliminated multiply
! defined symbol warnings for $CHLFD, $CHCRT, $CHFFD.
!
! 116 by RBW on 7-DEC-83
! Added code to F_COPY to test the actual file specs so
! that unnecessary copies are avoided.
GLOBAL BIND EDTFIL = %O'116' ; ! Edit level of this module
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
BUF_READ, !Read a buffer
BUF_WRITE, !Write a buffer
CK_FILE, !Check validity of a file
PCK_FILE, ![110] Tolerate protection violation
CKW_FILE, !Check writeability of a file
SCK_FILE, !Silently ck validity of a file
CLOSE, !Close a file
DEF_LN, !Define logical names
DELETE, !Delete an unopened file
DISPLAY_FILES, !Display files for INFORMATION
DISP_BUILD_FILES, !Display files for BUILD
DISP_NEW_FILES, !Display new copies of files
DISP_FILE, !Display file name and version
DISP_LN_DEFS, !Display logical name defs
FILE_COPY, !Make a copy of a file
F_COPY, !File copy routine
GET_BYTES, !Get bytes from a file
OPEN_I, !Open a file for input
OPN_IE, ![110] Open a file for input w/err return
OPEN_O, !Open a file for output
R_REL, !Reset & release a file
UPD_FILE ; !Update file version and cksum
!
! INCLUDE FILES:
!
LIBRARY 'BLI:TENDEF' ; !PDP-10 Definitions
UNDECLARE ![110] Undeclare multiply defined symbols
$CHLFD,
$CHCRT,
$CHFFD ;
LIBRARY 'BLI:MONSYM' ; !TOPS-20 Monitor Symbols
LIBRARY 'APEX' ; !APEX definitions
LIBRARY 'DEBUG' ; !Debugging macros
!
! EXTERNAL REFERENCES:
!
GLOBAL BIND EDTAPX = APEX_EDT ; ! Edit level of APEX.R36
!
! The BLISS interface routines to the GALAXY library
! These are defined in BLSGLX.B36
!
EXTERNAL ROUTINE $F_DEL ; !Delete an unopened file routine
EXTERNAL ROUTINE $F_FD ; !Return FD for a file
EXTERNAL ROUTINE $F_IBUF ; !Buffer input routine
EXTERNAL ROUTINE $F_IOPN ; !Open file for input routine
EXTERNAL ROUTINE $F_OBUF ; !Buffer output routine
EXTERNAL ROUTINE $F_OOPN ; !Open file for output routine
EXTERNAL ROUTINE $F_REL ; !Close & release file routine
EXTERNAL ROUTINE $F_RREL ; !Reset & release file routine
EXTERNAL ROUTINE $F$CHKS ; !Compute checksum of a file
EXTERNAL ROUTINE $F$VERS ; !Read version word of EXE file
EXTERNAL ROUTINE $DEF$LN ; !Define logical name
EXTERNAL ROUTINE $FMT$ERR ; !Format GALAXY error message
EXTERNAL ROUTINE $FMT$FD ; !Format name from FD for a file
EXTERNAL ROUTINE $FMT$NUM ; !Format number
EXTERNAL ROUTINE $FMT$OCT ; !Format octal number
EXTERNAL ROUTINE $FMT$VRS ; !Format version number
EXTERNAL ROUTINE $GET$LND ; !Return logical name definition
EXTERNAL ROUTINE $K_SOUT ; !String output routine
EXTERNAL ROUTINE $M_GMEM ; !Memory allocation routine
!
! APEX support routines
!
EXTERNAL ROUTINE GET_VALUE ; !Get item value from TBLUK table
EXTERNAL ROUTINE T_LOOKUP ; !Lookup entry in a table
EXTERNAL ROUTINE A_LOOKUP ; !Lookup address in a table
EXTERNAL ROUTINE A_ENTER ; !Enter address/value in a table
LITERAL ERPRT$ = 10; ![110] GALAXY file protection violation
GLOBAL ROUTINE BUF_READ(file,byte_count,address) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine inputs a buffer of data from the file
! specified in the file descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be read
!
! byte_count:
! the address to return the count of available bytes in
! (the byte size is set when the file is OPENed)
!
! address:
! the address to return the address of the data in
!
! IMPLICIT INPUTS:
!
! The file referenced must already be OPENed.
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! 0 if read fails (false)
! 1 if read successful (true)
! 2 if EOF (false) (literal $$eof_flag)
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE BUF_READ
LOCAL
error ;
MAP
file: REF FILE$$ ;
! $TRACE('Beginning','BUF_READ') ;
CK_DATATYPE(file,FILE) ;
IF $F_IBUF(.file[FILE_IFN],.byte_count,.address,error)
THEN
true
ELSE
IF .error EQL EREOF$
THEN
$$eof_flag
ELSE
$ERROR(W$CRF,*,FMT_FILE(file),$GERROR(.error))
END ; !End ROUTINE BUF_READ
GLOBAL ROUTINE BUF_WRITE(file,byte_count,data_adr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine outputs a buffer of data from the file
! specified in the file descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be written
!
! byte_count:
! the number of bytes to write
! (the byte size is set when the file is OPENed)
!
! data_adr:
! the starting address of the bytes of data
!
! IMPLICIT INPUTS:
!
! The file referenced must already be OPENed.
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the write fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE BUF_WRITE
LOCAL
error ;
MAP
file: REF FILE$$ ;
! $TRACE('Beginning','BUF_WRITE') ;
CK_DATATYPE(file,FILE) ;
IF $F_OBUF(.file[FILE_IFN],.byte_count,.data_adr,error)
THEN
true
ELSE
$ERROR(W$CWF,*,FMT_FILE(file),$GERROR(.error))
END ; !End ROUTINE BUF_WRITE
GLOBAL ROUTINE CK_FILE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be checked
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the check fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE CK_FILE
LITERAL
byte_size = 36 ;
LOCAL
checksum,
error,
version,
value ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','CK_FILE') ;
CK_DATATYPE(file,FILE) ;
IF NOT OPEN_I(.file,byte_size) THEN RETURN false ;
value = true ;
IF .file[FILE_EXP_VER] NEQ 0
THEN
BEGIN
IF $F$VERS(.file[FILE_IFN],version,error)
THEN
BEGIN
file[FILE_ACT_VER] = .version ;
IF .file[FILE_EXP_VER] NEQ .file[FILE_ACT_VER]
THEN
$ERROR(W$VID,*,FMT_FILE(file),
S(' is different than expected',cr_lf,' expected '),
FMT_VER(.file[FILE_EXP_VER]),
S(' but found '),
FMT_VER(.file[FILE_ACT_VER]),S(cr_lf)) ;
END
ELSE
BEGIN
file[FILE_ACT_VER] = 0 ;
IF .error NEQ ERNEF$
THEN
$ERROR(W$CGV,*,FMT_FILE(file),$GERROR(.error)) ;
END
END ;
IF .file[FILE_EXP_CKSUM] NEQ 0
THEN
BEGIN
IF $F$CHKS(.file[FILE_IFN],checksum,error)
THEN
BEGIN
file[FILE_ACT_CKSUM] = .checksum ;
IF .file[FILE_EXP_CKSUM] NEQ .file[FILE_ACT_CKSUM]
THEN
$ERROR(W$CID,*,FMT_FILE(file),
S(' is different than expected',cr_lf,' expected '),
FMT_OCT(.file[FILE_EXP_CKSUM]),
S(' but found '),
FMT_OCT(.file[FILE_ACT_CKSUM]),S(cr_lf)) ;
END
ELSE
BEGIN
file[FILE_ACT_CKSUM] = 0 ;
$ERROR(W$CGC,*,FMT_FILE(file),$GERROR(.error)) ;
END
END ;
R_REL(.file) ;
.value
END ; !End ROUTINE CK_FILE
GLOBAL ROUTINE PCK_FILE(file) = !This routine added in edit [110]
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be checked
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors other than a protection failure.
! Returns FALSE if the check fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE CK_FILE
LITERAL
byte_size = 36 ;
LOCAL
checksum,
error,
version,
value ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','PCK_FILE') ;
CK_DATATYPE(file,FILE) ;
IF NOT OPN_IE(.file,byte_size,ERROR )
THEN
IF .ERROR EQL ERPRT$
THEN
BEGIN
$ERROR(W$NFP,*,FMT_FILE(FILE));
RETURN TRUE !Tolerate protection failure
END
ELSE
RETURN false ; ! but nothing else
value = true ; !Since the file is open, continue as
! for CK_FILE...
IF .file[FILE_EXP_VER] NEQ 0
THEN
BEGIN
IF $F$VERS(.file[FILE_IFN],version,error)
THEN
BEGIN
file[FILE_ACT_VER] = .version ;
IF .file[FILE_EXP_VER] NEQ .file[FILE_ACT_VER]
THEN
$ERROR(W$VID,*,FMT_FILE(file),
S(' is different than expected',cr_lf,' expected '),
FMT_VER(.file[FILE_EXP_VER]),
S(' but found '),
FMT_VER(.file[FILE_ACT_VER]),S(cr_lf)) ;
END
ELSE
BEGIN
file[FILE_ACT_VER] = 0 ;
IF .error NEQ ERNEF$
THEN
$ERROR(W$CGV,*,FMT_FILE(file),$GERROR(.error)) ;
END
END ;
IF .file[FILE_EXP_CKSUM] NEQ 0
THEN
BEGIN
IF $F$CHKS(.file[FILE_IFN],checksum,error)
THEN
BEGIN
file[FILE_ACT_CKSUM] = .checksum ;
IF .file[FILE_EXP_CKSUM] NEQ .file[FILE_ACT_CKSUM]
THEN
$ERROR(W$CID,*,FMT_FILE(file),
S(' is different than expected',cr_lf,' expected '),
FMT_OCT(.file[FILE_EXP_CKSUM]),
S(' but found '),
FMT_OCT(.file[FILE_ACT_CKSUM]),S(cr_lf)) ;
END
ELSE
BEGIN
file[FILE_ACT_CKSUM] = 0 ;
$ERROR(W$CGC,*,FMT_FILE(file),$GERROR(.error)) ;
END
END ;
R_REL(.file) ;
.value
END ; !End ROUTINE PCK_FILE
GLOBAL ROUTINE CKW_FILE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine checks if the specified file can be written.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be checked
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the check fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE CKW_FILE
LITERAL
byte_size = 36 ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','CKW_FILE') ;
CK_DATATYPE(file,FILE) ;
IF NOT OPEN_O(.file,byte_size) THEN RETURN false ;
R_REL(.file)
END ; !End ROUTINE CKW_FILE
GLOBAL ROUTINE SCK_FILE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine verifies the existence of the specified file
! but does not issue any error messages if the file cannot be
! opened.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be checked
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs NO associated error messages.
! (unless illegal data type)
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the file cannot be opened.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE SCK_FILE
LITERAL
byte_size = 36 ;
LOCAL
error,
ifn ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','SCK_FILE') ;
CK_DATATYPE(file,FILE) ;
IF $F_IOPN(.file[FILE_FD],byte_size,ifn,error)
THEN
BEGIN
file[FILE_IFN] = .ifn ;
R_REL(.file) ;
true
END
ELSE
false
END ; !End ROUTINE SCK_FILE
GLOBAL ROUTINE CLOSE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine closes the file specified in the file
! descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be CLOSEd
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The IFN stored in the FILE$$ data structure is zeroed.
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the CLOSE fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE CLOSE
LOCAL
error ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','CLOSE') ;
CK_DATATYPE(file,FILE) ;
IF $F_REL(.file[FILE_IFN],error)
THEN
( file[FILE_IFN] = 0 ; true )
ELSE
$ERROR(W$CCF,*,FMT_FILE(file),$GERROR(.error))
END ; !End of CLOSE
GLOBAL ROUTINE DEF_LN(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine defines the logical names for the backup,
! distribution, patching, and installation directories
! associated with a product. It also defines the autopatch
! search list (logical name ASL:) to be the patching
! directory, the distribution directory, and SYS:.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the product descriptor (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if any definition fails.
!
! SIDE EFFECTS:
!
! The logical names ASL:, BAK:, DIS:, INS:, and PAT: will be
! redefined.
!
!--
BEGIN !Beginning ROUTINE DEF_LN
LOCAL
error,
value ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','DEF_LN') ;
CK_DATATYPE(product,PRODUCT) ;
value = true ;
IF NOT $DEF$LN(LN_BAK,.product[PROD_BAK_LND],error)
THEN
value = $ERROR(W$CDL,*,LN_BAK,S(' to be '),
.product[PROD_BAK_LND],
S(cr_lf,' ('),.error,S(')')) ;
IF NOT $DEF$LN(LN_DIS,.product[PROD_DIS_LND],error)
THEN
value = $ERROR(W$CDL,*,LN_DIS,S(' to be '),
.product[PROD_DIS_LND],
S(cr_lf,' ('),.error,S(')')) ;
IF NOT $DEF$LN(LN_INS,.product[PROD_INS_LND],error)
THEN
value = $ERROR(W$CDL,*,LN_INS,S(' to be '),
.product[PROD_INS_LND],
S(cr_lf,' ('),.error,S(')')) ;
IF NOT $DEF$LN(LN_PAT,.product[PROD_PAT_LND],error)
THEN
value = $ERROR(W$CDL,*,LN_PAT,S(' to be '),
.product[PROD_PAT_LND],
S(cr_lf,' ('),.error,S(')')) ;
!
! Define autopatch search list (Logical name ASL:)
!
IF NOT $DEF$LN(ln_asl,lnd_asl,error)
THEN
value = $ERROR(W$CDL,*,ln_asl,S(' to be '),lnd_asl,
S(cr_lf,' ('),.error,S(')')) ;
.value
END ; !End of DEF_LN
GLOBAL ROUTINE DELETE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine DELETEs the unopened file specified in the
! file descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be DELETEd
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the DELETE fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DELETE
LOCAL
error ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','DELETE') ;
CK_DATATYPE(file,FILE) ;
IF $F_DEL(.file[FILE_FD],error)
THEN
true
ELSE
$ERROR(W$CDF,*,FMT_FILE(file),$GERROR(.error))
END ; !End of DELETE
GLOBAL ROUTINE DISPLAY_FILES(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the name and version number of the
! component output files for a specified product.
!
! FORMAL PARAMETERS:
!
! product:
! the descriptor for the product (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DISPLAY_FILES
LOCAL
component: REF COMPONENT$$,
file: REF FILE$$,
n,
nn ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','DISPLAY_FILES') ;
CK_DATATYPE(product,PRODUCT) ;
!
! Display current copies of component output files
!
TTY((cr_lf)) ;
TTY((cr_lf,' Current installed files:')) ;
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_COMP_LIST],component) EQL true DO
BEGIN
CK_DATATYPE(component,COMPONENT) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.component[COMP_OUT_LIST],file) EQL true DO
BEGIN
CK_DATATYPE(file,FILE) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file) ;
END ;
END ;
!
! Now display newest copies of component output files
!
TTY((cr_lf)) ;
TTY((cr_lf,' Updated files (ready to be installed):')) ;
IF ((.product[PROD_STATUS] EQL prod_state_bjs) OR
(.product[PROD_STATUS] EQL prod_state_ini))
THEN
BEGIN
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_COMP_LIST],component)
EQL true DO
BEGIN
CK_DATATYPE(component,COMPONENT) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.component[COMP_OUT_LIST],file)
EQL true DO
BEGIN
CK_DATATYPE(file,FILE) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file[FILE_NEWEST]) ;
END ;
END ;
END
ELSE
TTY((cr_lf,' None')) ;
!
! Now display backup copies of component output files
!
TTY((cr_lf)) ;
TTY((cr_lf,' Backup files:')) ;
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_COMP_LIST],component) EQL true DO
BEGIN
CK_DATATYPE(component,COMPONENT) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.component[COMP_OUT_LIST],file) EQL true DO
BEGIN
CK_DATATYPE(file,FILE) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file[FILE_BACKUP]) ;
END ;
END ;
![063] Add this section to display the utility files at the end of DISPLAY_FILES
! Now display utility files
!
TTY((cr_lf)) ;
TTY((cr_lf,' Expected utility files for product build:')) ;
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_UTL_LIST],file) EQL true DO
BEGIN
TTY((cr_lf,' ')) ;
TTY(FMT_FILE(file)) ;
IF .file[FILE_EXP_CKSUM] NEQ 0
THEN
BEGIN
TTY((' sequential checksum ')) ;
TTY(FMT_OCT(.file[FILE_EXP_CKSUM])) ;
END ;
IF .file[FILE_EXP_VER] NEQ 0
THEN
BEGIN
TTY((', version ')) ;
TTY(FMT_VER(.file[FILE_EXP_VER])) ;
END ;
END ;
true
END ; !End of DISPLAY_FILES
GLOBAL ROUTINE DISP_BUILD_FILES(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the name, checksum, and version
! number of the files required to build the specified
! product. This includes:
!
! utilities
! patch and build file
! patch command file
! current copies of libraries
! patch files
! component build files
! component input files
!
!
! FORMAL PARAMETERS:
!
! product:
! the descriptor for the product (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DISP_BUILD_FILES
LOCAL
component: REF COMPONENT$$,
edit: REF EDIT$$,
file: REF FILE$$,
lib: REF LIBRARY$$,
patch: REF PATCH$$,
n,
nn,
val,
value ;
MAP
product: REF PRODUCT$$ ;
OWN
tab: REF TABLE$$ INITIAL(0) ;
$TRACE('Beginning','DISP_BUILD_FILES') ;
CK_DATATYPE(product,PRODUCT) ;
value = true ;
TTY((cr_lf,cr_lf,'[Files used by this batch job]',cr_lf)) ;
!
! Setup a table to keep track of patch files displayed
!
IF .tab EQL 0
THEN
tab = GET_TABLE(10)
ELSE
PURGE_TABLE(tab) ;
!
! Display utility files
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_UTL_LIST],file) EQL true DO
BEGIN
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file)
END ;
!
! Display patch and build file and patch command file
!
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.product[PROD_CTL_FILE]) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.product[PROD_PCF_FILE]) ;
!
! Display current copies of library files
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_LIB_LIST],lib) EQL true DO
BEGIN
CK_DATATYPE(lib,LIBRARY) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.lib[LIB_FILE])
END ;
!
! Display copies of component build files and component input files
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_COMP_LIST],component) EQL true DO
BEGIN
CK_DATATYPE(component,COMPONENT) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.component[COMP_BLD]) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.component[COMP_INP_LIST],file) EQL true DO
BEGIN
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file)
END ;
END ;
!
! Display patch files for all selected patches to this product
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_SP_LIST],patch) EQL true DO
BEGIN
CK_DATATYPE(patch,PATCH) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.patch[PAT_EDIT_LIST],edit) EQL true DO
BEGIN
CK_DATATYPE(edit,EDIT) ;
IF NOT A_LOOKUP(.tab,.edit[EDIT_FILE],val)
THEN
BEGIN
A_ENTER(.tab,.edit[EDIT_FILE],0) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.edit[EDIT_FILE]) ;
END ;
END ;
END ;
.value
END ; !End of DISP_BUILD_FILES
GLOBAL ROUTINE DISP_NEW_FILES(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the name, checksum, and version
! number of the files created by the patch and build file for
! the specified product. This includes:
!
! newest copies of libraries
! component output files
!
!
! FORMAL PARAMETERS:
!
! product:
! the descriptor for the product (PRODUCT$$)
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DISP_NEW_FILES
LOCAL
component: REF COMPONENT$$,
file: REF FILE$$,
lib: REF LIBRARY$$,
n,
nn,
value ;
MAP
product: REF PRODUCT$$ ;
$TRACE('Beginning','DISP_NEW_FILES') ;
CK_DATATYPE(product,PRODUCT) ;
value = true ;
TTY((cr_lf,cr_lf,'[Files created by this batch job]',cr_lf)) ;
!
! Display newest copies of library files
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_LIB_LIST],lib) EQL true DO
BEGIN
CK_DATATYPE(lib,LIBRARY) ;
file = .lib[LIB_FILE] ;
CK_DATATYPE(file,FILE) ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file[FILE_NEWEST])
END ;
!
! Display newest copies of component output files
!
n = 0 ;
WHILE
GET_VALUE((n=.n+1),.product[PROD_COMP_LIST],component) EQL true DO
BEGIN
CK_DATATYPE(component,COMPONENT) ;
nn = 0 ;
WHILE
GET_VALUE((nn=.nn+1),.component[COMP_OUT_LIST],file) EQL true DO
BEGIN
CK_DATATYPE(file,FILE) ;
file = .file[FILE_NEWEST] ;
![071] TTY((cr_lf,' ')) ;
DISP_FILE(.file)
END ;
END ;
.value
END ; !End of DISP_NEW_FILES
GLOBAL ROUTINE DISP_FILE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the name, checksum, and version
! number of the file specified in the file descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be displayed
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the file cannot be open and read
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DISP_FILE
LITERAL
byte_size = 36 ;
LOCAL
checksum,
error,
ifn,
version ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','DISP_FILE') ;
CK_DATATYPE(file,FILE) ;
![071] Check length of filespec. If null, then return.
IF CH$LEN(FMT_FILE(file)) EQL 0
THEN
RETURN true ;
TTY((cr_lf,' ')) ; ![071]
IF $F_IOPN(.file[FILE_FD],byte_size,ifn,error)
THEN
BEGIN
file[FILE_IFN] = .ifn ;
! TTY(FMT_FILE(file),(cr_lf)) ;
TTY(FMT_FILE(file)) ;
IF $F$CHKS(.ifn,checksum,error)
THEN
TTY((' sequential checksum '),FMT_OCT(.checksum)) ;
IF $F$VERS(.ifn,version,error)
THEN
TTY((', version '),FMT_VER(.version)) ;
R_REL(.file) ;
true
END
ELSE
TTY(FMT_FILE(file),$GERROR(.error)) ;
false
END ; !End of DISP_FILE
GLOBAL ROUTINE DISP_LN_DEFS =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the logical name definitions for the
! autopatch related logical names.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE DISP_LN_DEFS
LOCAL
address,
error ;
$TRACE('Beginning','DISP_LN_DEFS') ;
$GET$LND(ln_pat,address,error) ;
TTY((cr_lf,' '),ln_pat,(': (autopatching directory) defined as '),
.address) ;
$GET$LND(ln_dis,address,error) ;
TTY((cr_lf,' '),ln_dis,(': (distribution directory) defined as '),
.address) ;
$GET$LND(ln_bak,address,error) ;
TTY((cr_lf,' '),ln_bak,(': (backup directory) defined as '),
.address) ;
$GET$LND(ln_ins,address,error) ;
TTY((cr_lf,' '),ln_ins,(': (installation directory) defined as '),
.address) ;
$GET$LND(ln_asl,address,error) ;
TTY((cr_lf,' '),ln_asl,(': (autopatch search list) defined as '),
.address) ;
RETURN true ;
END ; !End of DISP_LN_DEFS
GLOBAL ROUTINE FILE_COPY(file1,file2) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine copies the file specified by file descriptor
! file1 to the file specified by descriptor file2.
!
! FORMAL PARAMETERS:
!
! file1: the address of the FILE$$ for the source file
!
! file2: the address of the FILE$$ for the destination
! file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The CKSUM and VER fields of the descriptor for file2 are
! updated.
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if copy operation cannot be completed
!
! SIDE EFFECTS:
!
! A copy of file1 is made.
!
!--
BEGIN !Beginning ROUTINE FILE_COPY
MAP
file1: REF FILE$$,
file2: REF FILE$$ ;
$TRACE('Beginning','FILE_COPY') ;
CK_DATATYPE(file1,FILE) ;
CK_DATATYPE(file2,FILE) ;
IF F_COPY(.file1,.file2)
THEN
BEGIN
file2[FILE_EXP_CKSUM] = .file1[FILE_EXP_CKSUM] ;
file2[FILE_ACT_CKSUM] = .file1[FILE_ACT_CKSUM] ;
file2[FILE_EXP_VER] = .file1[FILE_EXP_VER] ;
file2[FILE_ACT_VER] = .file1[FILE_ACT_VER] ;
true
END
ELSE
false
END ; !End of FILE_COPY
GLOBAL ROUTINE F_COPY(source_file,destination_file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine copies the file referenced by source_file to
! destination_file.
!
! FORMAL PARAMETERS:
!
! source_file:
! the address of the FILE$$ for the source file
!
! destination_file:
! the address of the FILE$$ for the destination file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if copy operation cannot be completed
!
! SIDE EFFECTS:
!
! A copy of source_file is made.
!
!--
BEGIN !Beginning ROUTINE F_COPY
MACRO
$ABORT = NOT(R_REL(.source_file) ; R_REL(.destination_file))% ;
LITERAL
byte_size = 36 ;
LOCAL
ifn, ![116]
error, ![116]
source_name, ![116]
destination_name, ![116]
address,
byte_count,
ret ;
MAP
source_file: REF FILE$$,
destination_file: REF FILE$$ ;
MACRO
COPY_FILESPEC_NOVER(ss) =
![116] This macro fetches the filespec up to, but not including
! the version number. It assumes that a version number is
! present on TOPS20. There are no version numbers on TOPS10.
%IF %SWITCHES(TOPS20)
%THEN
BEGIN
LOCAL
a,
len;
len = CH$LEN(ss);
WHILE CH$RCHAR(CH$PTR(ss,.len)) NEQ %C'.' DO len = .len - 1;
$M_GMEM(.len/5 + 1, a);
CH$COPY(.len,CH$PTR(ss),
0,
.len+1,CH$PTR(.a));
.a
END
%ELSE
COPY_STR(ss)
%FI %;
$TRACE('Beginning','F_COPY') ;
IF (.source_file EQL .destination_file) THEN RETURN true ;
IF NOT OPEN_I(.source_file,byte_size) THEN RETURN false ;
IF NOT OPEN_O(.destination_file,byte_size) THEN RETURN $ABORT ;
source_name = COPY_FILESPEC_NOVER(FMT_FILE(source_file)); ![116]
destination_name = COPY_FILESPEC_NOVER(FMT_FILE(destination_file)); ![116]
![116]
IF EQL_STR(.source_name,.destination_name) ![116]
THEN ![116]
BEGIN ![116]
R_REL(.source_file); ![116]
R_REL(.destination_file); ![116]
RETURN true; ![116]
END; ![116]
TTY((cr_lf,' '),FMT_FILE(source_file),
(' => '),FMT_FILE(destination_file)) ;
UNTIL
(ret = BUF_READ(.source_file,byte_count,address)) EQL $$eof_flag DO
BEGIN
IF NOT .ret
THEN
RETURN $ABORT ;
IF NOT BUF_WRITE(.destination_file,.byte_count,.address)
THEN
RETURN $ABORT ;
END ;
IF NOT CLOSE(.source_file) THEN RETURN $ABORT ;
IF NOT CLOSE(.destination_file) THEN RETURN false ;
TTY_OK ;
true
END ; !End of F_COPY
GLOBAL ROUTINE GET_BYTES(file,byte_count,address) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine inputs a specified number of bytes from a file
! and stores them at a specified starting address.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be read
!
! byte_count:
! the number of bytes to get
! (the byte size is set when the file is OPENed)
! (restriction---it must be 36 bits)
!
! address:
! the starting address for storing the bytes
!
! IMPLICIT INPUTS:
!
! The file referenced must already be OPENed.
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! 0 if read fails (false)
! 1 if read successful (true)
! 2 if EOF (false) (literal $$eof_flag)
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE GET_BYTES
LOCAL
error ;
MAP
file: REF FILE$$ ;
OWN
bytes_avail: INITIAL(0),
source ;
$TRACE('Beginning','GET_BYTES') ;
CK_DATATYPE(file,FILE) ;
INCR n FROM 0 TO (.byte_count - 1) DO
BEGIN
IF .bytes_avail EQL 0
THEN
IF NOT BUF_READ(.file,bytes_avail,source)
THEN
RETURN false ;
(.address + .n) = .(.source) ;
bytes_avail = .bytes_avail - 1 ;
source = .source + 1 ;
END ;
true
END ; !End ROUTINE GET_BYTES
GLOBAL ROUTINE OPEN_I(file,byte_size) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine opens the file specified in the file
! descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be opened
!
! byte_size:
! the byte size to use when accessing the file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The IFN for this file will be stored in the FILE$$ data
! descriptor.
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the OPEN fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE OPEN_I
LOCAL
error,
ifn ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','OPEN_I') ;
CK_DATATYPE(file,FILE) ;
IF $F_IOPN(.file[FILE_FD],.byte_size,ifn,error)
THEN
( file[FILE_IFN] = .ifn ; true )
ELSE
$ERROR(W$COF,*,FMT_FILE(file),S(' for input'),$GERROR(.error))
END ; !End of OPEN_I
GLOBAL ROUTINE OPN_IE(file,byte_size,ERROR_ADR) = !This routine added
! in edit [110]
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine opens the file specified in the file
! descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be opened
!
! byte_size:
! the byte size to use when accessing the file
!
! ERROR_ADR:
! The address to return the error code to...
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The IFN for this file will be stored in the FILE$$ data
! descriptor.
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the OPEN fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE OPN_IE
LOCAL
ifn ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','OPN_IE') ;
CK_DATATYPE(file,FILE) ;
IF $F_IOPN(.file[FILE_FD],.byte_size,ifn,.error_ADR)
THEN
( file[FILE_IFN] = .ifn ; true )
ELSE
$ERROR(W$COF,*,FMT_FILE(file),S(' for input'),$GERROR(..error_ADR))
END ; !End of OPN_IE
GLOBAL ROUTINE OPEN_O(file,byte_size) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine opens the file specified in the file
! descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be opened
!
! byte_size:
! the byte size to use when accessing the file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The IFN for this file will be stored in the FILE$$ data
! structure.
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the OPEN fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE OPEN_O
LOCAL
error,
ifn ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','OPEN_O') ;
CK_DATATYPE(file,FILE) ;
IF $F_OOPN(.file[FILE_FD],.byte_size,ifn,error)
THEN
( file[FILE_IFN] = .ifn ; true )
ELSE
$ERROR(W$COF,*,FMT_FILE(file),S(' for output'),$GERROR(.error))
END ; !End of OPEN_O
GLOBAL ROUTINE R_REL(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine resets and releases the file specified by the
! file descriptor. It provides a mechanism for aborting all
! operations on a file.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be RESET
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The IFN stored in the FILE$$ data structure is zeroed.
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE R_REL
LOCAL
ifn ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','R_REL') ;
IF NOT DATATYPE(file) THEN RETURN (NOT $ERROR(C$IDT,*)) ;
IF .file[FILE_IFN] EQL 0 THEN RETURN true ;
$F_RREL(.file[FILE_IFN]) ;
file[FILE_IFN] = 0 ;
true
END ; !End of R_REL
GLOBAL ROUTINE UPD_FILE(file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This function gets the version number and checksum of a
! file and updates the FILE$$ descriptor.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ to be updated
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE UPD_FILE
LITERAL
byte_size = 36 ;
LOCAL
checksum,
error,
version,
value ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','UPD_FILE') ;
CK_DATATYPE(file,FILE) ;
IF NOT OPEN_I(.file,byte_size) THEN RETURN false ;
value = true ;
IF $F$VERS(.file[FILE_IFN],version,error)
THEN
BEGIN
file[FILE_ACT_VER] = .version ;
file[FILE_EXP_VER] = .version ;
END
ELSE
BEGIN
file[FILE_ACT_VER] = 0 ;
file[FILE_EXP_VER] = 0 ;
IF .error NEQ ERNEF$
THEN
$ERROR(W$CGV,*,FMT_FILE(file),$GERROR(.error)) ;
END ;
IF $F$CHKS(.file[FILE_IFN],checksum,error)
THEN
BEGIN
file[FILE_ACT_CKSUM] = .checksum ;
file[FILE_EXP_CKSUM] = .checksum ;
END
ELSE
BEGIN
file[FILE_ACT_CKSUM] = 0 ;
file[FILE_EXP_CKSUM] = 0 ;
$ERROR(W$CGC,*,FMT_FILE(file),$GERROR(.error)) ;
END ;
R_REL(.file) ;
.value
END ; !End ROUTINE UPD_FILE
END
ELUDOM
! Local Modes:
! Mode:TEXT
! Display Matching Paren: -1
! Tab Stop Definitions: " : : : : : : : : : : : : : : : : : : : : : : : :"
! End: