Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
apxckp.b36
There are no other files named apxckp.b36 in the archive.
MODULE APXCKP (
ENTRY (
DB_READ,
DB_WRITE
),
LANGUAGE(BLISS36)
) =
BEGIN !Begin body of MODULE APXCKP
!
! 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 Database Checkpointing Support Routines
!
! ABSTRACT:
!
!
!
!
! ENVIRONMENT: TOPS-20 / TOPS-10
!
! AUTHOR: Donald R. Brandt, CREATION DATE: 19 March 1980
!
! MODIFIED BY:
!
! Revision history follows
!
!--
!
! Edit History for APXCKP
!
! 102 by DRB on 6-Jun-83
! Added code to DB_READ so that static tables for IP_LIST and
! MP_LIST could be larger than the checkpointed copies. DB_READ
! was overwriting the MAX_ENTRIES field.
!
! 106 by DRB on 19-Aug-83
! Fixed a problem with edit 102.
!
! 107 by DRB on 19-Aug-83
! Added master_index to speed up the table searches during DB_READ
! and DB_WRITE. Now instead of doing a linear search on a single
! table, multiple tables are used. The master_index points to
! the tables. Also fix table purging changing PURGE_TABLE(.tab)
! to PURGE_TABLE(tab).
!
GLOBAL BIND EDTCKP = %O'107' ; ! Edit level of this module
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
DB_READ,
DB_WRITE,
ENTER_ADDRESS,
LOOKUP_ADDRESS,
RELOC,
RELOCATE,
SAVE_OBJ ;
!
! INCLUDE FILES:
!
LIBRARY 'BLI:MONSYM' ; !TOPS-20 symbols
LIBRARY 'BLI:TENDEF' ; !PDP-10 definitions
LIBRARY 'APEX' ; !APEX macros
LIBRARY 'DEBUG' ; !Debugging macros
!
! EXTERNAL REFERENCES:
!
GLOBAL BIND EDTAPX = APEX_EDT ; ! Edit level of APEX.R36
EXTERNAL
IP_LIST: TABLE$$,
MP_LIST: TABLE$$ ;
!
! The BLISS interface routines to the GALAXY library
! These are defined in BLSGLX.B36
!
EXTERNAL ROUTINE $F_FD ; !Return FD for a file
EXTERNAL ROUTINE $K_SOUT ; !String output routine
EXTERNAL ROUTINE $M_GMEM ; !Memory allocation routine
EXTERNAL ROUTINE $M_RMEM ; !Memory deallocation routine
EXTERNAL ROUTINE $FMT$FD ; !Format name from FD for a file
EXTERNAL ROUTINE $FMT$NUM ; !Format number
EXTERNAL ROUTINE $FMT$OCT ; !Format octal number
!
! APEX support routines
!
EXTERNAL ROUTINE GET_KEY ; !Get item key from TBLUK table
EXTERNAL ROUTINE GET_VALUE ; !Get item value from TBLUK table
EXTERNAL ROUTINE T_DELETE ; !Delete entry in a table
EXTERNAL ROUTINE T_ENTER ; !Make entry in a 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
EXTERNAL ROUTINE BUF_READ ; !Read a buffer of data
EXTERNAL ROUTINE BUF_WRITE ; !Write a buffer of data
EXTERNAL ROUTINE CLOSE ; !Close a file
EXTERNAL ROUTINE CK_FILE ; !Check validity of a file
EXTERNAL ROUTINE GET_BYTES ; !Get bytes from a file
EXTERNAL ROUTINE OPEN_I ; !Open a file for input
EXTERNAL ROUTINE OPEN_O ; !Open a file for output
!
! MACROS
!
MACRO
CKP(size,address) =
IF NOT BUF_WRITE(.file,size,address)
THEN
RETURN false % ;
MACRO
SAVE_COMPONENT(a) =
IF NOT SAVE_OBJ(.file,a,dt_component,0)
THEN
RETURN false %,
SAVE_EDIT(a) =
IF NOT SAVE_OBJ(.file,a,dt_edit,0)
THEN
RETURN false %,
SAVE_FD(a) =
IF NOT SAVE_OBJ(.file,a,dt_fd,0)
THEN
RETURN false %,
SAVE_FILE(a) =
IF NOT SAVE_OBJ(.file,a,dt_file,0)
THEN
RETURN false %,
SAVE_LIBRARY(a) =
IF NOT SAVE_OBJ(.file,a,dt_library,0)
THEN
RETURN false %,
SAVE_PATCH(a) =
IF NOT SAVE_OBJ(.file,a,dt_patch,0)
THEN
RETURN false %,
SAVE_PRODUCT(a) =
IF NOT SAVE_OBJ(.file,a,dt_product,0)
THEN
RETURN false %,
SAVE_STRING(a) =
IF NOT SAVE_OBJ(.file,a,dt_string,0)
THEN
RETURN false %,
SAVE_LIST(a,dt) =
IF NOT SAVE_OBJ(.file,a,dt_table,dt)
THEN
RETURN false % ;
!
! MACRO to change a reference field in a descriptor to a new address
! and then relocate the fields of the referenced descriptor.
!
! a is field to relocate
! dt1 is dt of object referenced by this field
! dt2 is dt of table items if field references a table
!
MACRO
RELOC_COMPONENT(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_component,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to component in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_EDIT(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_edit,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to edit in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_ENTRY(a,dt) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to datatype '),FMT_NUM(DT),
(' in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_FD(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
END
ELSE
BEGIN
TTY((' Reference to FD in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_FILE(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_file,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to file in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_LIBRARY(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_library,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to library in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_PATCH(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_patch,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to patch in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_PRODUCT(a) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_product,0)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to product in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_STRING(a) =
IF .a NEQA 0
THEN
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
END
ELSE
BEGIN
TTY((' Reference to string in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END %,
RELOC_LIST(a,dt) =
IF RELOC(.a,new_address)
THEN
BEGIN
a = .new_address ;
IF NOT RELOCATE(.a,dt_table,dt)
THEN
RETURN false ;
END
ELSE
BEGIN
TTY((' Reference to list of datatype '),FMT_NUM(dt),
(' in datatype '),FMT_NUM(.dt1)) ;
RETURN false ;
END % ;
!
! EQUATED SYMBOLS
!
LITERAL
index_elements = 128, ! Number of elements in master index
! (must be a power of 2)
ckp_format = 1 ; ! Format number of checkpointed file
!
! Master index table used for hashing. The symbol
! index_elements defines the number of entries. This must be
! a power of 2! Each index entry points to a TABLE data
! structure.
!
STRUCTURE
INDEX [a;] =
[index_elements]
(INDEX + (a MOD index_elements)) ;
!
! OWN STORAGE:
!
OWN
mast_header: MAST_HEADER$$,
mast_trailer: OBJ_HEADER$$,
obj_header: OBJ_HEADER$$ ;
OWN
master_index: INDEX[] INITIAL(REP index_elements OF (0));
GLOBAL ROUTINE DB_READ (file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine reads the data base file.
!
! FORMAL PARAMETERS:
!
! file:
! the file descriptor of the file to be read
!
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
!
!--
BEGIN !Beginning ROUTINE DB_READ
LITERAL
byte_size = 36 ; ! Byte size of file
LOCAL
actual_ip_list_sz,
actual_mp_list_sz,
address ;
MAP
file: REF FILE$$ ;
$TRACE('Beginning','DB_READ') ;
TTY((' (Reading database ... ')) ;
CK_DATATYPE(file,FILE) ;
!
! Remember size of static MP_LIST and IP_LIST tables
!
actual_ip_list_sz = .ip_list[TBL_MAX_ENTRIES] ;
actual_mp_list_sz = .mp_list[TBL_MAX_ENTRIES] ;
!
! Set up symbol table to keep track of restored objects
!
BEGIN
LOCAL
nnn ;
nnn = 0 ;
DO
BEGIN
LOCAL
tab: REF TABLE$$ ;
tab = .master_index[.nnn] ;
IF .tab NEQ 0
THEN
PURGE_TABLE(tab) ; ![107]
END
UNTIL (nnn=.nnn+1) GEQ index_elements ;
END ;
!
! Open file
!
IF NOT OPEN_I(.file,byte_size)
THEN
RETURN false ;
!
! Read master header
!
IF NOT GET_BYTES(.file,mast_header_sz,mast_header)
THEN
RETURN false ;
IF .mast_header[MAST_HEADER_DT] NEQ dt_ckp_header
THEN
RETURN $ERROR(F$CDC,*) ;
IF .mast_header[MAST_HEADER_FORMAT] NEQ ckp_format
THEN
RETURN $ERROR(F$FCW,*,S(' expected '),FMT_NUM(ckp_format),
S(' but found '),FMT_NUM(.mast_header[MAST_HEADER_FORMAT])) ;
!
! Read object headers and objects from file
!
WHILE true DO
BEGIN
IF NOT GET_BYTES(.file,obj_header_sz,obj_header)
THEN
RETURN false ;
SELECTONE .obj_header[OBJ_HEADER_DT] OF
SET
[dt_ip_table]: address = ip_list ;
[dt_mp_table]: address = mp_list ;
[dt_component, dt_edit, dt_file, dt_library, dt_patch,
dt_product, dt_table, dt_string, dt_fd]:
$M_GMEM(.obj_header[OBJ_HEADER_LEN],address) ;
[dt_ckp_trailer]:
BEGIN
IF RELOCATE(mp_list,dt_table,dt_string)
THEN
IF RELOCATE(ip_list,dt_table,dt_product)
THEN
BEGIN
IF .mp_list[TBL_MAX_ENTRIES] LEQ .actual_mp_list_sz
THEN
mp_list[TBL_MAX_ENTRIES] = .actual_mp_list_sz
ELSE
RETURN $ERROR(C$TEF,*,
S(' master product list')) ;
IF .ip_list[TBL_MAX_ENTRIES] LEQ .actual_ip_list_sz
THEN
ip_list[TBL_MAX_ENTRIES] = .actual_ip_list_sz
ELSE
RETURN $ERROR(C$TEF,*,
S(' selected product list')) ;
TTY((')')) ;
RETURN CLOSE(.file) ;
END ;
RETURN false ;
END ;
[OTHERWISE]:
RETURN $ERROR($C$UDT,*,
FMT_NUM(.obj_header[OBJ_HEADER_DT])) ;
TES ;
!
! Now read object and enter previous address and new address
! in linear table
!
IF NOT GET_BYTES(.file,.obj_header[OBJ_HEADER_LEN],.address)
THEN
RETURN false ;
IF NOT ENTER_ADDRESS(.obj_HEADER[OBJ_HEADER_ADDRESS],.address)
THEN
RETURN false ;
END
END ; !End ROUTINE DB_READ
GLOBAL ROUTINE DB_WRITE (file) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine writes the checkpointed data base file.
!
! FORMAL PARAMETERS:
!
! file:
! the file descriptor of the file to be written
!
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
!
!--
BEGIN !Beginning ROUTINE DB_WRITE
MACRO SAVE_MAST_LIST(a,m_dt,dt) =
IF NOT SAVE_OBJ(.file,a,m_dt,dt)
THEN
RETURN false % ;
LITERAL
byte_size = 36 ; ! Byte size of file
MAP
file: REF FILE$$ ;
$TRACE('Beginning','DB_WRITE') ;
CK_DATATYPE(file,FILE) ;
!
! Set up table to keep track of saved objects
!
BEGIN
LOCAL
nnn ;
nnn = 0 ;
DO
BEGIN
LOCAL
tab: REF TABLE$$ ;
tab = .master_index[.nnn] ;
IF .tab NEQ 0
THEN
PURGE_TABLE(tab) ; ![107]
END
UNTIL (nnn=.nnn+1) GEQ index_elements ;
END ;
IF NOT OPEN_O(.file,byte_size)
THEN
RETURN false ;
!
! Write file header
!
mast_header[MAST_HEADER_DT] = dt_ckp_header ;
mast_header[MAST_HEADER_FORMAT] = ckp_format ;
mast_header[MAST_HEADER_LEN] = mast_header_sz ;
CKP(mast_header_sz,mast_header) ;
!
! Save MP_LIST and IP_LIST
!
SAVE_MAST_LIST(mp_list,dt_mp_table,dt_string) ;
SAVE_MAST_LIST(ip_list,dt_ip_table,dt_product) ;
!
! Write file trailer
!
mast_TRAILER[OBJ_HEADER_DT] = dt_ckp_trailer ;
mast_TRAILER[OBJ_HEADER_LEN] = obj_header_sz ;
CKP(obj_header_sz,mast_trailer) ;
!
! Done
!
CLOSE(.file)
END ; !End ROUTINE DB_WRITE
ROUTINE ENTER_ADDRESS(address,value) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine enters an address and an associated value in the
! symbol table.
!
! FORMAL PARAMETERS:
!
! address:
! the address to enter in the table
!
! value:
! the value to enter
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Error message if entry fails.
!
! ROUTINE VALUE:
!
! Returns TRUE if the entry succeeds.
! Returns FALSE if the entry operation fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE ENTER_ADDRESS
$TRACE('Beginning','ENTER_ADDRESS') ;
IF .master_index[.address] EQL 0
THEN
master_index[.address] = GET_TABLE(64) ;
A_ENTER(.master_index[.address],.address,.value)
END; !End ROUTINE ENTER_ADDRESS
ROUTINE LOOKUP_ADDRESS(address,value_adr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine looks up an address in the symbol table.
!
! FORMAL PARAMETERS:
!
! address:
! the address to find in the table
!
! value_adr:
! the address to return the retrieved value in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Stores the retrieved value at the address contained in
! value_adr.
!
! ROUTINE VALUE:
!
! Returns TRUE if the address is found.
! Returns FALSE if the address is not in the table.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE LOOKUP_ADDRESS
$TRACE('Beginning','LOOKUP_ADDRESS') ;
IF .master_index[.address] EQL 0
THEN
false
ELSE
A_LOOKUP(.master_index[.address],.address,.value_adr)
END ; !End ROUTINE LOOKUP_ADDRESS
ROUTINE RELOC(original_adr,new_adr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns a new address that is associated with
! an original address.
!
! FORMAL PARAMETERS:
!
! original_adr:
! the original address
! new_adr:
! the address to store the new address in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if there is a new address associated
! with the original address.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE RELOC
$TRACE('Beginning','RELOC') ;
IF LOOKUP_ADDRESS(.original_adr,.new_adr)
THEN
RETURN true
ELSE
RETURN $ERROR(C$AEM,*) ;
END ; !End ROUTINE RELOC
ROUTINE RELOCATE(object,dt1,dt2) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! file:
! the file descriptor of the file to be written
!
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
!
!--
BEGIN !Beginning ROUTINE RELOCATE
LOCAL
new_address ;
$TRACE('Beginning','RELOCATE') ;
SELECTONE .dt1 OF
SET
[dt_component]:
BEGIN
MAP
object: REF COMPONENT$$ ;
$TRACE_ARG((' component ')) ;
CK_DATATYPE(object,COMPONENT) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_STRING(object[COMP_NAME]) ;
$TRACE_ARG(.object[COMP_NAME]) ;
RELOC_STRING(object[COMP_CODE]) ;
RELOC_PRODUCT(object[COMP_PROD]) ;
RELOC_FILE(object[COMP_BLD]) ;
RELOC_LIST(object[COMP_INP_LIST],dt_file) ;
RELOC_LIST(object[COMP_OUT_LIST],dt_file) ;
true
END ;
[dt_edit]:
BEGIN
MAP
object: REF EDIT$$ ;
$TRACE_ARG((' edit ')) ;
CK_DATATYPE(object,EDIT) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_STRING(object[EDIT_NAME]) ;
$TRACE_ARG(.object[EDIT_NAME]) ;
RELOC_LIBRARY(object[EDIT_LIB]) ;
RELOC_FILE(object[EDIT_FILE]) ;
RELOC_LIST(object[EDIT_MOD_LIST],dt_string) ;
true
END ;
[dt_file]:
BEGIN
MAP
object: REF FILE$$ ;
$TRACE_ARG((' file ')) ;
CK_DATATYPE(object,FILE) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_FD(object[FILE_FD]) ;
$TRACE_ARG(FMT_FILE(object)) ;
IF .object[FILE_BACKUP] NEQ 0
THEN
RELOC_FILE(object[FILE_BACKUP]) ;
IF .object[FILE_NEWEST] NEQ 0
THEN
RELOC_FILE(object[FILE_NEWEST]) ;
true
END ;
[dt_fd]:
BEGIN
MAP
object: REF BLOCK[1] FIELD(HEADER_FIELDS) ;
$TRACE_ARG((' FD')) ;
true
END ;
[dt_library]:
BEGIN
MAP
object: REF LIBRARY$$ ;
$TRACE_ARG((' library ')) ;
CK_DATATYPE(object,LIBRARY) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_STRING(object[LIB_NAME]) ;
$TRACE_ARG(.object[LIB_NAME]) ;
RELOC_PRODUCT(object[LIB_PROD]) ;
RELOC_LIST(object[LIB_COMP_LIST],dt_component) ;
RELOC_FILE(object[LIB_FILE]) ;
RELOC_LIST(object[LIB_EDIT_LIST],dt_edit) ;
IF .object[LIB_EDT] NEQ 0
THEN
RELOC_FILE(object[LIB_EDT]) ;
true
END ;
[dt_patch]:
BEGIN
MAP
object: REF PATCH$$ ;
$TRACE_ARG((' patch ')) ;
CK_DATATYPE(object,PATCH) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_STRING(object[PAT_NAME]) ;
$TRACE_ARG(.object[PAT_NAME]) ;
RELOC_PRODUCT(object[PAT_PROD]) ;
RELOC_LIST(object[PAT_EDIT_LIST],dt_edit) ;
RELOC_LIST(object[PAT_RP_LIST],dt_patch) ;
RELOC_STRING(object[PAT_DESCRIPTION]) ;
RELOC_STRING(object[PAT_SPR]) ;
RELOC_STRING(object[PAT_DATE]) ;
true
END ;
[dt_product]:
BEGIN
MAP
object: REF PRODUCT$$ ;
$TRACE_ARG((' product ')) ;
CK_DATATYPE(object,PRODUCT) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[HEADER_CKP_FLAG]
THEN
object[HEADER_CKP_FLAG] = false
ELSE
RETURN true ;
RELOC_STRING(object[PROD_NAME]) ;
$TRACE_ARG(.object[PROD_NAME]) ;
RELOC_STRING(object[PROD_CODE]) ;
RELOC_STRING(object[PROD_BAK_LND]) ;
RELOC_STRING(object[PROD_INS_LND]) ;
RELOC_STRING(object[PROD_DIS_LND]) ;
RELOC_STRING(object[PROD_PAT_LND]) ;
RELOC_LIST(object[PROD_UTL_LIST],dt_file) ;
RELOC_LIST(object[PROD_PAT_LIST],dt_patch) ;
RELOC_LIST(object[PROD_COMP_LIST],dt_component) ;
RELOC_LIST(object[PROD_LIB_LIST],dt_library) ;
RELOC_LIST(object[PROD_SP_LIST],dt_patch) ;
RELOC_FILE(object[PROD_CTL_FILE]) ;
RELOC_FILE(object[PROD_PCF_FILE]) ;
RELOC_FILE(object[PROD_BCF_FILE]) ;
true
END ;
[dt_string]:
BEGIN
$TRACE_ARG((' string ')) ;
true
END ;
[dt_table, dt_ip_table, dt_mp_table]:
BEGIN
MAP
object: REF TABLE$$ ;
$TRACE_ARG((' table of datatypes '),FMT_NUM(.dt2)) ;
CK_DATATYPE(object,TABLE) ;
!
! If object has already been relocated, RETURN;
! otherwise, mark it as relocated and relocate it now.
!
IF .object[TABLE_CKP_FLAG]
THEN
object[TABLE_CKP_FLAG] = false
ELSE
RETURN true ;
object[TABLE_REF] = .object + .object[HEADER_LEN] ;
INCR n FROM 1 to .object[TBL_ACTUAL_ENTRIES] DO
BEGIN
RELOC_STRING(object[.n,TBL_ITEM_ADR]) ;
RELOC_ENTRY(object[.n,TBL_ITEM_VALUE],.dt2) ;
END ;
true
END ;
[OTHERWISE]: false ;
TES
END ; !End ROUTINE RELOCATE
ROUTINE SAVE_OBJ(file,object,dt1,dt2) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine WRITEs the data base file.
!
! FORMAL PARAMETERS:
!
! file:
! the file descriptor of the file to be written
!
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
!
!--
BEGIN !Beginning ROUTINE SAVE_OBJ
LOCAL
value ;
$TRACE('Beginning','SAVE_OBJ') ;
!
! Do linear search of list of addresses of objects already saved.
! If this object has already been saved, return.
!
IF LOOKUP_ADDRESS(.object,value)
THEN
RETURN true ;
!
! Object has not already been saved
! Enter its address in list and save it now.
!
IF NOT ENTER_ADDRESS(.object,0)
THEN
RETURN false ;
SELECTONE .dt1 OF
SET
[dt_component]:
BEGIN
MAP
object: REF COMPONENT$$ ;
$TRACE_ARG((' component'),.object[COMP_NAME]) ;
CK_DATATYPE(object,COMPONENT) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_STRING(.object[COMP_NAME]) ;
SAVE_STRING(.object[COMP_CODE]) ;
SAVE_PRODUCT(.object[COMP_PROD]) ;
SAVE_FILE(.object[COMP_BLD]) ;
SAVE_LIST(.object[COMP_INP_LIST],dt_file) ;
SAVE_LIST(.object[COMP_OUT_LIST],dt_file) ;
true
END ;
[dt_edit]:
BEGIN
MAP
object: REF EDIT$$ ;
CK_DATATYPE(object,EDIT) ;
$TRACE_ARG((' edit '),.object[EDIT_NAME]) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_STRING(.object[EDIT_NAME]) ;
SAVE_LIBRARY(.object[EDIT_LIB]) ;
SAVE_FILE(.object[EDIT_FILE]) ;
SAVE_LIST(.object[EDIT_MOD_LIST],dt_string) ;
true
END ;
[dt_file]:
BEGIN
MAP
object: REF FILE$$ ;
CK_DATATYPE(object,FILE) ;
$TRACE_ARG((' file '),FMT_FILE(object)) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_FD(.object[FILE_FD]) ;
IF .object[FILE_BACKUP] NEQ 0
THEN
SAVE_FILE(.object[FILE_BACKUP]) ;
IF .object[FILE_NEWEST] NEQ 0
THEN
SAVE_FILE(.object[FILE_NEWEST]) ;
true
END ;
[dt_fd]:
BEGIN
MAP
object: REF BLOCK[1] FIELD(HEADER_FIELDS) ;
$TRACE_ARG((' FD')) ;
IF .object[HEADER_LEN] EQL 0
THEN
RETURN $ERROR(C$NFD,*,FMT_OCT(.object)) ;
obj_header[OBJ_HEADER_DT] = dt_fd ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
true
END ;
[dt_library]:
BEGIN
MAP
object: REF LIBRARY$$ ;
CK_DATATYPE(object,LIBRARY) ;
$TRACE_ARG((' library '),.object[LIB_NAME]) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_STRING(.object[LIB_NAME]) ;
SAVE_PRODUCT(.object[LIB_PROD]) ;
SAVE_LIST(.object[LIB_COMP_LIST],dt_component) ;
SAVE_FILE(.object[LIB_FILE]) ;
SAVE_LIST(.object[LIB_EDIT_LIST],dt_edit) ;
IF .object[LIB_EDT] NEQ 0
THEN
SAVE_FILE(.object[LIB_EDT]) ;
true
END ;
[dt_patch]:
BEGIN
MAP
object: REF PATCH$$ ;
CK_DATATYPE(object,PATCH) ;
$TRACE_ARG((' patch '),.object[PAT_NAME]) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_STRING(.object[PAT_NAME]) ;
SAVE_PRODUCT(.object[PAT_PROD]) ;
SAVE_LIST(.object[PAT_EDIT_LIST],dt_edit) ;
SAVE_LIST(.object[PAT_RP_LIST],dt_patch) ;
SAVE_STRING(.object[PAT_DESCRIPTION]) ;
SAVE_STRING(.object[PAT_SPR]) ;
SAVE_STRING(.object[PAT_DATE]) ;
true
END ;
[dt_product]:
BEGIN
MAP
object: REF PRODUCT$$ ;
CK_DATATYPE(object,PRODUCT) ;
$TRACE_ARG((' product '),.object[PROD_NAME]) ;
object[HEADER_CKP_FLAG] = true ;
obj_header[OBJ_HEADER_DT] = .object[HEADER_DT] ;
obj_header[OBJ_HEADER_LEN] = .object[HEADER_LEN] ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
SAVE_STRING(.object[PROD_NAME]) ;
SAVE_STRING(.object[PROD_CODE]) ;
SAVE_STRING(.object[PROD_BAK_LND]) ;
SAVE_STRING(.object[PROD_INS_LND]) ;
SAVE_STRING(.object[PROD_DIS_LND]) ;
SAVE_STRING(.object[PROD_PAT_LND]) ;
SAVE_LIST(.object[PROD_UTL_LIST],dt_file) ;
SAVE_LIST(.object[PROD_PAT_LIST],dt_patch) ;
SAVE_LIST(.object[PROD_COMP_LIST],dt_component) ;
SAVE_LIST(.object[PROD_LIB_LIST],dt_library) ;
SAVE_LIST(.object[PROD_SP_LIST],dt_patch) ;
SAVE_FILE(.object[PROD_CTL_FILE]) ;
SAVE_FILE(.object[PROD_PCF_FILE]) ;
SAVE_FILE(.object[PROD_BCF_FILE]) ;
true
END ;
[dt_string]:
BEGIN
LOCAL
count ;
$TRACE_ARG((' string '),.object) ;
IF .object EQL 0
THEN
RETURN true ;
count = ((CH$LEN(.object) + 1 - 1) / 5) + 1 ;
obj_header[OBJ_HEADER_DT] = dt_string ;
obj_header[OBJ_HEADER_LEN] = .count ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.count,.object) ;
true
END ;
[dt_table, dt_ip_table, dt_mp_table]:
BEGIN
LOCAL
count,
key,
n,
obj2 ;
MAP
object: REF TABLE$$ ;
CK_DATATYPE(object,TABLE) ;
$TRACE_ARG((' table of datatypes '),FMT_NUM(.dt2)) ;
object[TABLE_CKP_FLAG] = true ;
count = .object[HEADER_LEN] + .object[TBL_MAX_ENTRIES] + 1 ;
obj_header[OBJ_HEADER_DT] = .dt1 ;
obj_header[OBJ_HEADER_LEN] = .count ;
obj_header[OBJ_HEADER_ADDRESS] = .object ;
CKP(obj_header_sz,obj_header) ;
CKP(.object[HEADER_LEN],.object) ;
CKP(.object[TBL_MAX_ENTRIES]+1,.object[TABLE_REF]) ;
n = 0 ;
WHILE GET_KEY((n=.n+1),.object,key) EQL true DO
BEGIN
SAVE_STRING(.key) ;
GET_VALUE(.n,.object,obj2) ;
IF NOT SAVE_OBJ(.file,.obj2,.dt2,0)
THEN
RETURN false ;
END ;
true
END ;
[OTHERWISE]: false ;
TES
END ; !End ROUTINE SAVE_OBJ
END !End body of MODULE APXCKP
ELUDOM