Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
apxbat.b36
There are no other files named apxbat.b36 in the archive.
MODULE APXBAT (
LANGUAGE(BLISS36),
MAIN = PEPB
) =
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 Batch Job Module
!
! ABSTRACT:
!
! This module along with common APEX support modules and
! GLXLIB modules is required to build PEPB.EXE. This module
! is not needed to build PEP.EXE.
!
! PEPB is the batch component of the Autopatching Exec. It
! runs as part of the .CTL file that applies the patches and
! rebuilds an autopatchable product. PEPB can access the
! database file created by PEP (the interactive component of
! the Autopatching Exec). It therefore can determine the
! status, files, and logical names associated with each
! autopatchable product.
!
! PEPB is run to perform the initialization required by the
! batch job. During this initialization, logical names are
! defined and the required files are verified.
!
! PEPB is also run at the termination of the batch job. At
! this time it writes a status file (to be read by PEP)
! containing information about the results of the batch job.
!
!
! ENVIRONMENT: TOPS-20 / TOPS-10
!
! AUTHOR: Donald R. Brandt, CREATION DATE: 17 Jun 1980
!
! MODIFIED BY:
!
! Revision history follows
!
!--
!
! Edit History for APXBAT
!
! BAT001 by DRB on 31-Oct-80
! Added error dispatch address ($ER$HK) to HELP command tree.
!
! BAT002 by DRB on 31-Oct-80
! Modified INIT routine to display applied edits in .LOG
! file.
!
! BAT003 by DRB on 26-Jan-81
! Modified INIT routine to define logical names before
! attempting to DELETE the .BCF file of the product.
! Otherwise, this routine would never delete the file.
!
! 060 by ESB on 12-Jan-82
! Remove references to Global Edit History. Global Edit History
! is now in module APXVER. No code changes.
!
! 062 by ESB on 3-Feb-82
! Remove the message in SETUP that gives the total number of patches
! being applied to the product. The number is stored in 8 bits, and
! overflows too easily. Fixing this properly will require changing
! the format of the checkpoint files in the field.
!
! 077 by HAH on 31-MAY-83
! Increase size of fixed tables IP_LIST_SZ and MP_LIST_SZ from 15 to 30
! to support more products.
!
! 115 by RBW on 12-NOV-83
! Process replacement type edits during batch job.
!
!
GLOBAL BIND EDTBAT = %O'115' ; ! Edit level of this module
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
PEPB: NOVALUE,
COMMAND_DISPATCH,
HELP,
INIT,
SIGNAL_FAILURE,
SIGNAL_SUCCESS,
WRITE_BCF ;
!
! INCLUDE FILES:
!
LIBRARY 'BLI:TENDEF' ; !PDP-10 Definitions
LIBRARY 'BLI:MONSYM' ; !TOPS-20 Monitor Symbols
LIBRARY 'APEX' ; !APEX macros
LIBRARY 'BLSPAR' ; !BLISS parser macros
LIBRARY 'DEBUG' ; !Debugging macros
REQUIRE 'FILES.REQ' ; !System dependent file info
!
! Edit symbol definitions
!
!
! Global edit symbols
!
EXTERNAL
EDTCHK, ! edit level of module APXCHK
EDTCKP, ! edit level of module APXCKP
EDTCMD, ! edit level of module APXCMD
EDTERR, ! edit level of module APXERR
EDTFIL, ! edit level of module APXFIL
EDTPAT, ! edit level of module APXPAT
EDTTBL, ! edit level of module APXTBL
EDTEXT, ! edit level of module GLXEXT
EDTGLX, ! edit level of module BLSGLX
EDTPAR ; ! edit level of module BLSPAR
GLOBAL BIND EDTAPX = APEX_EDT ; ! Edit level of APEX.R36
!
! EXTERNAL REFERENCES:
!
EXTERNAL
TAKFDB: PDB_BLOCK ; !PDB for TAKE command
! (defined in OPRPAR)
EXTERNAL !Parser error routines for
$ERR$C, !Illegal command
$ERR$G, !Not confirmed
$ER$HK, !Illegal HELP keyword
$ER$IP, !Illegal product
$ER$MP ; !Illegal product
!
! The BLISS interface routines to GALAXY parser routines
! These are defined in BLSPAR.B36
!
EXTERNAL ROUTINE $PRINIT ; !Library Initialization
EXTERNAL ROUTINE $PRCMND ; !Parse command
EXTERNAL ROUTINE $PARSE ; !Parse command
EXTERNAL ROUTINE $P$TAKE ; !Setup for TAKE
EXTERNAL ROUTINE $P$HELP ; !Setup for HELP
EXTERNAL ROUTINE $PRSETUP ; !Setup after parse
EXTERNAL ROUTINE $PRNFLD ; !Return next field type
EXTERNAL ROUTINE $PRKEY ; !Return keyword
EXTERNAL ROUTINE $PRNUM ; ! number
EXTERNAL ROUTINE $PRSWI ; ! switch value
EXTERNAL ROUTINE $PRFIL ; ! file spec
EXTERNAL ROUTINE $PRFLD ; ! character field
EXTERNAL ROUTINE $PRCFM ; ! confirmation (CRLF)
EXTERNAL ROUTINE $PRDIR ; ! directory
EXTERNAL ROUTINE $PRUSR ; ! user name
EXTERNAL ROUTINE $PRCMA ; ! comma
EXTERNAL ROUTINE $PRFLT ; ! floating point number
EXTERNAL ROUTINE $PRDEV ; ! device name
EXTERNAL ROUTINE $PRTXT ; ! text to EOL
EXTERNAL ROUTINE $PRTAD ; ! time and date
EXTERNAL ROUTINE $PRQST ; ! quoted string
EXTERNAL ROUTINE $PRUNQ ; ! unquoted string
EXTERNAL ROUTINE $PRTOK ; ! token
EXTERNAL ROUTINE $PRNUX ; ! digits terminated by nondigit
EXTERNAL ROUTINE $PRACT ; ! account string
EXTERNAL ROUTINE $PRNOD ; ! node name
EXTERNAL ROUTINE $PRSXF ; ! sixbit field
!
! EXTERNAL REFERENCES CONTINUED:
!
!
! 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 $FMT$VRS ; !Format version number
EXTERNAL ROUTINE $K_SOUT ; !String output routine
EXTERNAL ROUTINE $M_GMEM ; !Memory allocation routine
EXTERNAL ROUTINE $M_RMEM ; !Memory deallocation routine
EXTERNAL ROUTINE $A$INIT ; !Initialize APEX
EXTERNAL ROUTINE $DEF$LN ; !Define a logical name
EXTERNAL ROUTINE $FMT$FD ; !Format name from FD for a file
EXTERNAL ROUTINE $FMT$NUM ; !Format number
!
! APEX support routines
!
EXTERNAL ROUTINE BUF_WRITE ; !Write a buffer of data
EXTERNAL ROUTINE CLOSE ; !Close a file
EXTERNAL ROUTINE CK_FILE ; !Check a file
EXTERNAL ROUTINE SCK_FILE ; !Silently check a file
EXTERNAL ROUTINE DEF_LN ; !Define logical names
EXTERNAL ROUTINE DELETE ; !Delete a file
EXTERNAL ROUTINE DISP_BUILD_FILES ; !Display files to BUILD product
EXTERNAL ROUTINE DISP_LN_DEFS ; !Display logical names
EXTERNAL ROUTINE DISP_NEW_FILES ; !Display files built by batch
EXTERNAL ROUTINE OPEN_O ; !Open a file for output
EXTERNAL ROUTINE GET_COMMAND ; !Process a command
EXTERNAL ROUTINE DB_READ ; !Read checkpointed database
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 BCHECK ; !BUILD processing check
EXTERNAL ROUTINE BLD_MAST_PAT_LIST ; !Build master patch list
EXTERNAL ROUTINE BLD_PAT_LIST ; !Build selected patch list
EXTERNAL ROUTINE DISP_SP_LIST ; !Dsply selected patches to prod
EXTERNAL ROUTINE REP_PATCH ; ![115] Replacement patching
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! Define parameter values for compilation
!
LITERAL
IP_LIST_SZ = 30, ![077] Size of TBLUK portion of IP_LIST
! (does not include header)
MP_LIST_SZ = 30, ![077] Size of TBLUK portion of MP_LIST
! (does not include header)
PAT_LIST_SZ = 100 ; ! Initial size of patch lists
!
! Define associated values for keyword tables
!
LITERAL
$$EXIT = 1,
$$HELP = 2,
$$INIT = 3,
$$SIG_FAILURE = 4,
$$SIG_SUCCESS = 5 ;
!
! EQUATED SYMBOLS CONTINUED:
!
!
! Make forward reference for keyword tables
! note allocation is # entries + 1
!
FORWARD
CMDTAB: VECTOR[5],
CMDLST: VECTOR[6],
IP_TBLUK: VECTOR[ip_list_sz + 1],
MP_TBLUK: VECTOR[mp_list_sz + 1] ;
!
! Make forward references for PDB's using the
! special macro provided
!
$PDB (CMDINI,
CMDKEY,
CMDIPL,
CMDMPL,
CMDWLD,
CMDHLP,
CMDCFM,
NP0EXI,
NP0HEL,
NP0INI,
NP0SGF,
NP0SGS) ;
!
! GLOBAL STORAGE:
!
!
! MP_LIST and IP_LIST are static tables and cannot be
! expanded. The master product list, MP_LIST, has one entry
! for every possible autopatchable product. The installation
! product list, IP_LIST, has one entry for every SELECTed
! product. The tables are initialized during APEX
! initialization. The tables must remain static since some
! of the command syntax PDBs reference the TBLUK portion of
! these tables.
!
GLOBAL
IP_LIST: DTABLE$$(ip_tbluk), ! Installation Product List
IP_TBLUK: TBLUK$$(ip_list_sz) ;
GLOBAL
MP_LIST: DTABLE$$(mp_tbluk), ! Master Product List
MP_TBLUK: TBLUK$$(mp_list_sz) ;
!
! OWN STORAGE:
!
OWN
EXIT_FLAG: INITIAL (false) ;
!
! MAST_PAT_LIST is the master list of all patches. It is
! built dynamically during initialization.
!
OWN
MAST_PAT_LIST: REF TABLE$$ ; ! Master Patch List
!
! PAT_LIST is the master list of "selectable" patches. It
! is also built dynamically during initialization.
!
OWN
PAT_LIST: REF TABLE$$ ; ! Master Selected Patch List
!
! OWN STORAGE CONTINUED:
!
! Define the command parser related tables and data structures
!
!
! Dispatch keyword table for PEPB commands
!
OWN CMDTAB: $DSPTAB ((
(NP0EXI,'EXIT',$$EXIT),
! (NP0HEL,'HELP',$$HELP),
(NP0INI,'INITIALIZE',$$INIT),
(NP0SGF,'SIGNAL-FAILURE',$$SIG_FAILURE),
(NP0SGS,'SIGNAL-SUCCESS',$$SIG_SUCCESS)
)) ;
!
! Command List for HELP command
!
OWN CMDLST: $KEYKEY ((
('EXIT'),
('HELP'),
('INIT'),
('SIGNAL-FAILURE'),
('SIGNAL-SUCCESS'),
)) ;
!
! OWN STORAGE CONTINUED:
!
! Define the Parser Descriptor Blocks (PDB) for PEPB commands
!
OWN
CMDINI: $INIT (NEXT=CMDKEY) ; !Initialize parse and set prompt
OWN
CMDKEY: $KEYDSP (TABLE=CMDTAB, !Parse command keyword and
ERROR=$ERR$C) ; ! dispatch
OWN
CMDIPL: $KEY (TABLE=IP_TBLUK, !Product from installation list
ALTERNATE=CMDWLD,
ERROR=$ER$IP,
NEXT=CMDCFM) ;
OWN
CMDMPL: $KEY (TABLE=MP_TBLUK, !Parse product from master list
ALTERNATE=CMDWLD,
ERROR=$ER$MP,
NEXT=CMDCFM) ;
OWN
CMDWLD: $TOKEN (CHAR='*', !Parse wild character *
FLAGS=cm_sdh, !Suppress default help
HELP= '* for all of these products',
NEXT=CMDCFM) ;
OWN
CMDHLP: $KEY (TABLE=CMDLST, !Parse a command from HELP list
DEFAULT='HELP',
ERROR=$ER$HK,
NEXT=CMDCFM) ;
OWN
CMDCFM: $CONFIRM (ERROR=$ERR$G) ; !Parse command termination
!
! OWN STORAGE CONTINUED:
! Parser Descriptor Blocks (PDB) continued
! Noise phrases
!
OWN
NP0EXI: $NOISE (NEXT=CMDCFM,
TEXT='from program'),
NP0HEL: $NOISE (NEXT=CMDHLP,
TEXT='with subject name'),
NP0INI: $NOISE (NEXT=CMDIPL,
TEXT='for patching and rebuilding product name'),
NP0SGS: $NOISE (NEXT=CMDIPL,
TEXT='of patching and rebuilding product name'),
NP0SGF: $NOISE (NEXT=CMDIPL,
TEXT='of patching and rebuilding product name') ;
ROUTINE PEPB :NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Main routine for PEPB. This routine performs the
! initialization required for the object time system. It
! then reads the database file. This file must exist and is
! expected to be found in the connected directory (or default
! path) of the job. If this is not the case, an error
! message is issued so the batch job will terminate.
!
! After building the patch lists, this routine will dispatch
! control, depending on the command that is entered.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning routine PEPB
BIND
module_name = %SIXBIT 'PEPB', !Our name for GLXLIB
prompt = CH$ASCIZ(cr_lf,'PEPB>') ; !Command prompt string
!
! Do preliminary initialization for object time system.
!
$A$INIT() ; !Initialize APEX
$PRINIT(module_name) ; !Initialize GALAXY library
TTY(('[PEPB version '),FMT_VER(.JBVER),(']',cr_lf)) ;
TTY(('[Initializing ...]')) ;
!
! Read database file if it is around
!
IF CK_FILE(pepb_db_file)
THEN
IF DB_READ(pepb_db_file)
THEN
TTY_OK
ELSE
RETURN $ERROR(C$CRC,*,FMT_FILE(pepb_db_file))
ELSE
BEGIN
TTY((cr_lf,
' (This file should be in the autopatching directory and this',
cr_lf,
' job should be running with the autopatching structure and',
cr_lf,
' directory as the connected directory (or the default path).)')) ;
RETURN $ERROR(F$CCJ,*) ;
END ;
!
! Build the patch lists
!
mast_pat_list = GET_TABLE(pat_list_sz) ; ! Master patch list
pat_list = GET_TABLE(pat_list_sz) ; ! Selected patch list
IF NOT BLD_MAST_PAT_LIST(ip_list,.mast_pat_list)
THEN
RETURN $ERROR(C$CBL,*) ;
IF NOT BLD_PAT_LIST(ip_list,.pat_list)
THEN
RETURN $ERROR(C$CBL,*) ;
!
! Main processing loop
!
DO
BEGIN
GET_COMMAND(prompt,0,cmdini,command_dispatch)
END
UNTIL .exit_flag EQL true ;
END ; !End of PEPB
ROUTINE COMMAND_DISPATCH =
!++
! FUNCTIONAL DESCRIPTION:
!
! This is the command processing routine for APEX commands.
! It picks up the values stored during the parsing. In most
! cases it then dispatches to another routine where the
! actual processing is initiated. When this routine is
! invoked, the parser should have ensured that the command
! syntax is correct.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! Command parsing and P$SETUP processing must have been
! completed successfully.
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if a dispatch can't be made for this command.
!
! SIDE EFFECTS:
!
! Any processing associated with a command is performed.
!
!--
BEGIN !Beginning COMMAND_DISPATCH
MACRO
DISPATCH (ROUTINE_NAME,LIST) =
IF .type EQL $CMKEY
THEN
ROUTINE_NAME(.code)
ELSE
BEGIN
n = 0 ;
WHILE GET_VALUE((n=.n+1),LIST,code) EQL true DO
ROUTINE_NAME(.code)
END% ;
LOCAL
code,
command,
n,
type ;
$TRACE('Beginning','COMMAND_DISPATCH') ;
IF NOT $PRKEY(type,command) THEN RETURN false ;
SELECTONE .command OF
SET
[$$HELP, $$INIT, $$SIG_FAILURE, $$SIG_SUCCESS]:
BEGIN
$PRKEY(type,code) ;
SELECTONE .command OF
SET
[$$HELP]: HELP(.code) ;
[$$INIT]: ( DISPATCH(INIT,IP_LIST) ; true ) ;
[$$SIG_FAILURE]:
( DISPATCH(SIGNAL_FAILURE,IP_LIST) ; true ) ;
[$$SIG_SUCCESS]:
( DISPATCH(SIGNAL_SUCCESS,IP_LIST) ; true ) ;
[OTHERWISE]: false ;
TES
END ;
[$$EXIT]: exit_flag = true ;
[OTHERWISE]: false ;
TES
END ; !End of COMMAND_DISPATCH
ROUTINE HELP(command) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to produce a help text message for a specific command.
! This routine dispatches to the GALAXY P$HELP routine which
! handles all the details of reading the .HLP file.
!
! FORMAL PARAMETERS:
!
! command:
! address of string that is the key in .HLP file
!
! IMPLICIT INPUTS:
!
! pepb_help_file:
! the file descriptor (FILE$$) for PEPB.HLP
!
! IMPLICIT OUTPUTS:
!
! Error messages if:
! no .HLP file
! specified key not found
! IO error
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning routine HELP
$TRACE('Beginning','HELP') ;
$P$HELP(.pepb_help_file[FILE_FD],.command) ;
true
END; !End of HELP
ROUTINE INIT(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to perform the initialization necessary for the patch
! and rebuild of a product. The product must be one of the
! installation autopatchable products. (That is, it was
! previously SELECTed).
!
! This routine verifies that the product has been previously
! SETUP via PEP. If a batch communication file exists for
! this product, it is deleted. After checking the files
! required for building the product, the logical names and
! files to be used are displayed.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the PRODUCT$$
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning routine INIT
MAP
product: REF PRODUCT$$ ;
OWN
msgext: INITIAL(S(' before this batch job can be run')) ;
$TRACE('Beginning','INIT') ;
CK_DATATYPE(product,PRODUCT) ;
IF ((.product[PROD_STATUS] EQL prod_state_rbb) OR
(.product[PROD_STATUS] EQL prod_state_bfq))
THEN
BEGIN
IF DEF_LN(.product)
THEN
BEGIN
IF SCK_FILE(.product[PROD_BCF_FILE])
THEN
DELETE(.product[PROD_BCF_FILE]) ;
IF BCHECK(.product)
THEN
BEGIN
TTY((cr_lf,cr_lf,
'[Logical names setup for this job]',cr_lf)) ;
DISP_LN_DEFS() ;
DISP_BUILD_FILES(.product) ;
!**;[062] Comment out 3 lines, add 1 line, and change 1 line near the
!**;[062] end of routine SETUP.
!**;[062] PROD_PAT_COUNT is an 8 bit field, and overflows too easily.
!**;[062] Fixing this properly will require changing the format of
!**;[062] the checkpoint files in the field. Also, always call
!**;[062] DISP_SP_LIST, since PROD_PAT_COUNT might be wrong.
%( [062]
TTY((cr_lf,cr_lf,'[')) ;
TTY_PAT_COUNT(.product[PROD_PAT_COUNT]) ;
TTY((' will be applied to '),.product[PROD_NAME],
(']',cr_lf)) ;
IF .product[PROD_PAT_COUNT] GTR 0
THEN
[062] )%
TTY((cr_lf,cr_lf)) ; ![062]
DISP_SP_LIST(.product) ; ![062]
TTY((cr_lf,cr_lf)); ![115]
IF NOT REP_PATCH(.product) ![115]
THEN ![115]
RETURN $ERROR(F$CBP,.product[PROD_NAME],*) ;![115]
RETURN true
END
END
END
ELSE
RETURN $ERROR(F$PNS,.product[PROD_NAME],*,.msgext) ;
$ERROR(F$CBP,.product[PROD_NAME],*)
END; !End of INIT
ROUTINE SIGNAL_FAILURE(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to signal failure of the patch and rebuild batch job
! for a specific product.
!
! This routine writes a batch communication file with a
! message indicating that the batch job failed.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the PRODUCT$$
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning SIGNAL_FAILURE
BIND
message = S('BAD') ;
MAP
product: REF PRODUCT$$ ;
CK_DATATYPE(product,PRODUCT) ;
IF WRITE_BCF(.product[PROD_BCF_FILE],message)
THEN
true
ELSE
false
END ; !End of SIGNAL_FAILURE
ROUTINE SIGNAL_SUCCESS(product) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Here to signal success of the patch and rebuild batch job
! for a specific product.
!
! This routine writes a batch communication file with a
! message indicating that the batch job succeeded.
!
! FORMAL PARAMETERS:
!
! product:
! the address of the PRODUCT$$
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning SIGNAL_SUCCESS
BIND
message = S('GOOD') ;
MAP
product: REF PRODUCT$$ ;
CK_DATATYPE(product,PRODUCT) ;
DISP_NEW_FILES(.product) ;
IF WRITE_BCF(.product[PROD_BCF_FILE],message)
THEN
true
ELSE
false
END ; !End of SIGNAL_SUCCESS
ROUTINE WRITE_BCF(file,message) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine writes a batch communication file with a
! specified message.
!
! FORMAL PARAMETERS:
!
! file: the address of the FILE$$ descriptor
!
! message:
! the address of ASCIZ message text
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if operation not completed successfully.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning WRITE_BCF
LITERAL
byte_size = 36 ; ! Byte size of file
LOCAL
count ; ! Header record words,
MAP
file: REF FILE$$ ;
CK_DATATYPE(file,FILE) ;
IF NOT OPEN_O(.file,byte_size)
THEN
RETURN false ;
count = ((CH$LEN(.message)+1-1) / 5) + 1 ;
IF NOT BUF_WRITE(.file,1,count)
THEN
RETURN false ;
IF NOT BUF_WRITE(.file,.count,.message)
THEN
RETURN false ;
RETURN CLOSE(.file) ;
END; !End of WRITE_BCF
END
ELUDOM