Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
blsglx.b36
There are no other files named blsglx.b36 in the archive.
MODULE BLSGLX (
LANGUAGE(BLISS36),
ENTRY (
$F_DEL,
$F_FD,
$F_IBUF,
$F_IOPN,
$F_OBUF,
$F_OOPN,
$F_REL,
$F_RREL,
$F$CHKS,
$F$VERS,
$I_INIT,
$K_SOUT,
$M_GMEM,
$M_RMEM,
$S_TBAD,
$S_TBDL,
$S_TBLK,
$FMT$FD,
$FMT$ERR,
$FMT$NUM,
$FMT$OCT,
$FMT$VRS,
$T$FD,
$A$INIT,
$A$PDFD,
$DEF$LN,
$GET$LND
)
) =
BEGIN !Begin body of MODULE BLSGLX
!
! 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:
!
! BLISS Interface to TOPS-10/20 GALAXY Library (GLXLIB)
!
! ABSTRACT:
!
! This module contains a set of routines that interface to
! the GALAXY Library (GLXLIB). In order to call a routine in
! the GALAXY Library, all programs should call the associated
! interface routine in this module. This scheme localizes
! the GALAXY calling conventions to this module and isolates
! the calling routine from any of the details of some of the
! data structures required by the GLXLIB routines.
!
! In order to use the GALAXY Library:
!
! 1. The GALAXY run time library, GLXLIB, must either
! be linked with the resultant object code produced
! from the BLISS compilation or be available on SYS:
! when the program is run.
!
! 2. The program must follow the address space
! conventions used by GLXLIB. Specifically, GLXLIB
! must reside at 400000, it is not relocatable. This
! may be accomplished by linking GLXLIB ensuring it is
! the first HISEG object module encountered by LINK.
! If it is not desired to link GLXLIB at object time
! then the BLISS code which will be loaded in the
! HISEG must be relocated when loading with LINK by
! using the /SEG:.HIGH.:nnnnnn switch, where, nnnnnn
! is the address at which the BLISS code will be
! loaded. The area at 600000 is used by GLXLIB for its
! variables.
!
!
! ENVIRONMENT: TOPS-10 / TOPS-20
!
! AUTHOR: Donald R. Brandt, CREATION DATE: 18 March 1980
!
! MODIFIED BY:
!
! Revision history follows
!
!--
!
! Edit History for BLSGLX
!
! GLX001 by DRB on 15-Jun-81
! Added code to zero control word of the file open block (FOB)
! since GLXMAC now defines additional fields for this word.
!
GLOBAL BIND EDTGLX = %O'01' ; ! Edit level of this module
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
$F_DEL,
$F_FD,
$F_IBUF,
$F_IOPN,
$F_OBUF,
$F_OOPN,
$F_REL,
$F_RREL,
$F$CHKS,
$F$VERS,
$I_INIT,
$K_SOUT,
$M_GMEM,
$M_RMEM,
$S_TBAD,
$S_TBDL,
$S_TBLK,
$FMT$ERR,
$FMT$FD,
$FMT$NUM,
$FMT$OCT,
$FMT$VRS,
$T$FD,
$A$INIT,
$A$PDFD,
$DEF$LN,
$GET$LND ;
!
! INCLUDE FILES:
!
LIBRARY 'BLI:MONSYM' ; !TOPS-20 symbols
LIBRARY 'BLI:TENDEF' ; !PDP-10 definitions
REQUIRE 'BLSGLX.R36' ; !GALAXY data structures
!
! MACROS:
!
MACRO TRUE = 1 % ;
MACRO FALSE = 0 % ;
!
! This macro ensures that there are no register allocation
! conflicts when interfacing with GALAXY library routines
! that want to return values in S1 and S2. This interface
! macro immediately moves the returned register values into
! local variables.
!
! Parameters are passed to the GALAXY routines by means of a
! BLISS LINKAGE attribute.
!
! GALAXY library routines always set the true/false condition
! in AC0.
!
! Calling sequence:
!
! GLX( function_call, ret_variable_1, ret_variable_2 )
!
MACRO
GLX(F,ret1,ret2) =
BEGIN
REGISTER
AC0 = 0,
AC1 = 1,
AC2 = 2 ;
F ;
%IF NOT %NULL(ret1) %THEN ret1 = .AC1 ; %FI
%IF NOT %NULL(ret2) %THEN ret2 = .AC2 ; %FI
.AC0
END % ;
!
! EQUATED SYMBOLS:
!
!
! FORWARD REFERENCES:
!
!
! OWN STORAGE:
!
! GALAXY INITIALIZATION BLOCK (IB)
! (from GLXMAC.MAC, 7-Mar-80)
!
! All programs which make use of the GALAXY library or
! runtime system must go through an initialization call to
! insure that the modules are in a determinant state, and
! also to set up the profile that this program wants. This
! initialization is carried out using a communications area,
! the Initialization Block, from which parameters are read
! and information filled in.
!
! The initialization call to I%INIT is made with S1
! containing the size of the IB and S2 containing its
! address.
!
! Initialization Block (IB):
!
! !=======================================================!
! ! Address of output routine for defaulted $TEXTs !
! !-------------------------------------------------------!
! !OCT!STP! program-wide flags !
! !-------------------------------------------------------!
! ! Base of program's interrupt vector(s) !
! !-------------------------------------------------------!
! ! PID block address !
! !-------------------------------------------------------!
! ! $TEXT error exit routine !
! !-------------------------------------------------------!
! ! Name of Program in SIXBIT !
! !=======================================================!
!
FIELD IB_FIELDS =
SET
IB$OUT = [0,0,36,0], !Address of routine to call from
! output routine if $TEXT
! specifies none
IB$FLG = [1,0,36,0], !Program wide flag word
IP$STP = [1,34,1,0], !Send stopcodes to ORION as WTO
IT$OCT = [1,35,1,0], !OPEN command terminal
IB$INT = [2,0,36,0], !Base of interrupt vector(s)
IB$PIB = [3,0,36,0], !Address of PID block
IB$ERR = [4,0,36,0], !User $TEXT error exit routine
! address
IB$PRG = [5,0,36,0] !Name of program, in SIXBIT
TES;
LITERAL IB$SZ = 6; !Size of GALAXY Initialization Block (IB)
MACRO IB_BLOCK = BLOCK[IB$SZ] FIELD(IB_FIELDS) %;
OWN IB: IB_BLOCK INITIAL (0,0,0,0,0,%SIXBIT'BLSGLX') ;
!
! EXTERNAL REFERENCES:
!
! Linkage to GALAXY routine
LINKAGE GALAXY = PUSHJ(REGISTER=1,REGISTER=2):
LINKAGE_REGS (15,14,0)
NOPRESERVE(0,3,4)
PRESERVE(5,6,7,8,9,10,11,12,13);
EXTERNAL ROUTINE
!GALAXY routines
F_DEL: GALAXY, !Delete a file
F_FD: GALAXY, !Return the FD of a file
F_IBUF: GALAXY, !Input a buffer
F_IOPN: GALAXY, !Open a file for input
F_OBUF: GALAXY, !Output a buffer
F_OOPN: GALAXY, !Open a file for output
F_REL: GALAXY, !Release a file
F_RREL: GALAXY, !Reset and release a file
F$CHKS: GALAXY, !Return sequential cksum of file
F$VERS: GALAXY, !Return .JBVER of EXE file
I_INIT: GALAXY, !GLXLIB initialization
K_SOUT: GALAXY, !GALAXY String Output Routine
M_GMEM: GALAXY, !GALAXY Get Memory Routine
M_RMEM: GALAXY, !GALAXY Return Memory Routine
S_TBAD: GALAXY, !Add table entry routine
S_TBDL: GALAXY, !Delete table entry routine
S_TBLK: GALAXY, !Table lookup routine
FMT$ER: GALAXY, !Format GAXAXY error message
FMT$FD: GALAXY, !Format file spec from FD
FMT$NUM: GALAXY, !Format number
FMT$OCT: GALAXY, !Format octal number
FMT$VRS: GALAXY, !Format version number
T$FD: GALAXY, !Output file spec from FD
A$INIT: GALAXY, !Apex initialization
A$PDFD: GALAXY, !Get patch directory FD
DEF$LN: GALAXY, !Define logical name
GET$LN: GALAXY ; !Get logical name definition
GLOBAL ROUTINE $F_DEL(fd,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine DELETEs an unopened file.
!
! FORMAL PARAMETERS:
!
! fd: the address of the FD for the file to be DELETEd
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the DELETE fails.
!
! SIDE EFFECTS:
!
! The file is DELETEd.
!
!--
BEGIN !Beginning ROUTINE $F_DEL
STACKLOCAL
FOB: FOB$$ ;
LOCAL
S1 ;
fob[FOB_FD] = .fd ;
fob[FOB_CW] = 0 ;
fob[FOB_BSZ] = 0 ;
fob[FOB_NFO] = 0 ;
fob[FOB_LSN] = 0 ;
fob[FOB_US] = 0 ;
fob[FOB_CD] = 0 ;
IF GLX(F_DEL(FOB_SZ,FOB),S1)
THEN
true
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_DEL
GLOBAL ROUTINE $F_FD(ifn,flag) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns the FD associated with an opened file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file
!
! flag: specifies which FD to return
! 0 to obtain a copy of the original FD
! -1 to obtain an exact FD of the file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns address of the FD.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $F_FD
LOCAL
S1 ;
GLX(F_FD(.ifn,.flag),S1) ;
.S1
END ; !End ROUTINE $F_FD
GLOBAL ROUTINE $F_IBUF(ifn,byte_count,address,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine inputs a buffer of data from a file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be read
!
! byte_count:
! the address to return the count of available bytes in
!
! address:
! the address to return the address of the data in
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the read fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $F_IBUF
LOCAL
S1,
S2 ;
IF GLX(F_IBUF(.ifn),S1,S2)
THEN
BEGIN
.byte_count = .S1 ;
IF (.S2<30,6> - .S2<24,6> GEQ 0) ! Convert pointer to address
THEN
.address = .S2<0,18>
ELSE
.address = .S2<0,18> + 1 ;
true
END
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_IBUF
GLOBAL ROUTINE $F_IOPN(fd,byte_size,ifn,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine OPENs a file for input.
!
! FORMAL PARAMETERS:
!
! fd: the address of the FD for the file to be OPENed
!
! byte_size:
! the byte size for accessing data in the file
!
! ifn: the address to return the IFN of the file in
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the OPEN fails.
!
! SIDE EFFECTS:
!
! The file is OPENed.
!
!--
BEGIN !Beginning ROUTINE $F_IOPN
STACKLOCAL
FOB: FOB$$ ;
LOCAL
S1 ;
fob[FOB_FD] = .fd ;
fob[FOB_CW] = 0 ;
fob[FOB_BSZ] = .byte_size ;
fob[FOB_NFO] = 0 ;
IF .byte_size EQL 7
THEN
fob[FOB_LSN] = 1
ELSE
fob[FOB_LSN] = 0 ;
fob[FOB_US] = 0 ;
fob[FOB_CD] = 0 ;
IF GLX(F_IOPN(FOB_SZ,FOB),S1)
THEN
( .ifn = .S1 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_IOPN
GLOBAL ROUTINE $F_OBUF(ifn,byte_count,data_adr,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine outputs a buffer of data to a file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be read
!
! byte_count:
! the number of bytes to output
!
! data_adr:
! the starting address of the data to be output
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the read fails.
!
! SIDE EFFECTS:
!
! Data is written to the file.
!
!--
BEGIN !Beginning ROUTINE $F_OBUF
LOCAL
S1,
XWD ;
xwd<0,18,0> = .data_adr<0,18> ;
xwd<18,18,0> = .byte_count ;
IF GLX(F_OBUF(.ifn,.xwd),S1)
THEN
true
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_OBUF
GLOBAL ROUTINE $F_OOPN(fd,byte_size,ifn,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine OPENs a file for output.
!
! FORMAL PARAMETERS:
!
! fd: the address of the FD for the file to be OPENed
!
! byte_size:
! the byte size for accessing data in the file
!
! ifn: the address to return the IFN of the file in
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the OPEN fails.
!
! SIDE EFFECTS:
!
! The file is OPENed.
!
!--
BEGIN !Beginning ROUTINE $F_OOPN
STACKLOCAL
FOB: FOB$$ ;
LOCAL
S1 ;
fob[FOB_FD] = .fd ;
fob[FOB_CW] = 0 ;
fob[FOB_BSZ] = .byte_size ;
fob[FOB_NFO] = 0 ;
fob[FOB_LSN] = 0 ;
fob[FOB_US] = 0 ;
fob[FOB_CD] = 0 ;
IF GLX(F_OOPN(FOB_SZ,FOB),S1)
THEN
( .ifn = .S1 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_OOPN
GLOBAL ROUTINE $F_REL(ifn,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine closes and releases a file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be closed
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the CLOSE fails.
!
! SIDE EFFECTS:
!
! The file referenced by the IFN is CLOSEd and the IFN
! released.
!
!--
BEGIN !Beginning ROUTINE $F_REL
LOCAL
S1 ;
IF GLX(F_REL(.ifn),S1)
THEN
( .error = 0 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F_REL
GLOBAL ROUTINE $F_RREL(ifn) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine resets and releases a file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be reset
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE
!
! SIDE EFFECTS:
!
! The file referenced by the IFN is RESET and the IFN
! released.
!
!--
BEGIN !Beginning ROUTINE $F_RREL
GLX(F_RREL(.ifn))
END ; !End ROUTINE $F_RREL
GLOBAL ROUTINE $F$CHKS(ifn,address,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns the sequential checksum of a file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be read
!
! address:
! the address to return the checksum in
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! The file must be already open with 36 bit byte size.
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the read fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $F$CHKS
LOCAL
S1,
S2 ;
IF GLX(F$CHKS(.ifn),S1,S2)
THEN
( .address = .S2 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F$CHKS
GLOBAL ROUTINE $F$VERS(ifn,address,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns .JBVER of an EXE file.
!
! FORMAL PARAMETERS:
!
! ifn: the IFN of the file to be read
!
! address:
! the address to return the contents of .JBVER in
!
! error: the address to return error code in
!
! IMPLICIT INPUTS:
!
! The file must be already open with 36 bit byte size.
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the read fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $F$VERS
LOCAL
S1,
S2 ;
IF GLX(F$VERS(.ifn),S1,S2)
THEN
( .address = .S2 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $F$VERS
GLOBAL ROUTINE $I_INIT(name) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine calls the GALAXY routine I%INIT to initialize
! the GLXLIB environment and if not already present to obtain
! the runtime system into the programs address space.
!
! FORMAL PARAMETERS:
!
! name: A string of up to six SIXBIT characters which
! specify the name of the program.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! If not already loaded, the GALAXY run-time system is loaded
! into the programs address space at location 400000.
!
! ROUTINE VALUE:
!
! Returns TRUE if function completed successfully.
! Returns FALSE if function not completed successfully.
!
! COMPLETION CODES:
!
! None
!
! SIDE EFFECTS:
!
! The GLXLIB runtime module is loaded.
!
!--
BEGIN !Beginning ROUTINE $I_INIT
IB[IB$PRG] = .NAME ; ! Copy name supplied
IB[IT$OCT] = 1 ; ! Open command terminal
GLX(I_INIT(IB$SZ,IB)) ! Initialize GLXLIB runtime system
END ; !End ROUTINE $I_INIT
GLOBAL ROUTINE $K_SOUT (string_address) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! string_address:
! the address of the ASCIZ string
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if the function fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $K_SOUT
GLX(K_SOUT(.string_address))
END ; !End ROUTINE $K_SOUT
GLOBAL ROUTINE $M_GMEM (mem_size,address_adr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine obtains a block of free memory mem_size words
! long. The memory obtained is initialized to zero.
!
! FORMAL PARAMETERS:
!
! mem_size:
! the number of words of memory to get
!
! address_adr:
! the address to return the starting address of
! the memory block in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! The allocated memory is preset to zero.
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! Additional memory is made available to the caller.
!
!--
BEGIN !Beginning ROUTINE $M_GMEM
LOCAL
S1,
S2 ;
GLX(M_GMEM(.mem_size),S1,S2) ;
.address_adr = .S2 ;
true
END ; !End ROUTINE $M_GMEM
GLOBAL ROUTINE $M_RMEM (mem_size,address) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns a block of memory obtained with
! $M_RMEM.
!
! FORMAL PARAMETERS:
!
! mem_size:
! the number of words of memory to return
!
! address:
! the starting address of the block of memory to
! return
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE.
!
! SIDE EFFECTS:
!
! The returned memory is no longer available to the caller.
!
!--
BEGIN !Beginning ROUTINE $M_RMEM
GLX(M_RMEM(.mem_size,.address))
END ; !End ROUTINE $M_RMEM
GLOBAL ROUTINE $S_TBAD (table,string_adr,value,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine adds an entry to a table. The table is in
! TOPS-20 TBLUK format.
!
! FORMAL PARAMETERS:
!
! table: the address of the table header
!
! string_adr:
! the address of the string to enter in table
!
! value: the value associated with the string
!
! error: the address to store error code in on failure
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if operation succeeds.
! Returns FALSE if operation fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $S_TBAD
LOCAL
S1 ;
STACKLOCAL
entry ;
entry = .string_adr^18 OR .value ;
IF GLX(S_TBAD(.table,.entry),S1)
THEN
true
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $S_TBAD
GLOBAL ROUTINE $S_TBDL (table,entry_adr,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine deletes an entry from a table. The table is
! in TOPS-20 TBLUK format.
!
! FORMAL PARAMETERS:
!
! table: the address of the table header
!
! entry_adr:
! the address of the entry to delete
!
! error: the address to store error code in on failure
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if operation succeeds.
! Returns FALSE if operation fails.
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $S_TBDL
LOCAL
S1 ;
IF GLX(S_TBDL(.table,.entry_adr),S1)
THEN
true
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $S_TBDL
GLOBAL ROUTINE $S_TBLK (table,string_ptr,entry_adr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine looks up an entry in a table. The table is
! in TOPS-20 TBLUK format.
!
! FORMAL PARAMETERS:
!
! table: the address of the table header
!
! string_ptr:
! a pointer to the string to lookup in the table
!
! entry_adr:
! the address to return the address of the entry in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! 0 if no match (false)
! 1 if exact match (true)
! 2 if ambiguous (false)
! 3 if unique abbreviation (true)
! 4 if internal error (false)
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $S_TBLK
LOCAL
S1,
S2 ;
GLX(S_TBLK(.table,.string_ptr),S1,S2) ;
.entry_adr = .S1 ;
SELECTONE .S2 OF
SET
[%O'400000000000']: 0 ; ! No match
[%O'200000000000']: 2 ; ! Ambiguous
[%O'100000000000']: 3 ; ! Unique abbreviation
[%O'040000000000']: 1 ; ! Exact match
[OTHERWISE]: 4 ;
TES
END ; !End ROUTINE $S_TBLK
GLOBAL ROUTINE $FMT$ERR(number) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats up an ASCIZ string of a GALAXY error
! message from a corresponding error number.
!
! FORMAL PARAMETERS:
!
! number: the error number
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of ASCIZ string
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $FMT$ERR
FMT$ER(.number)
END ; !End ROUTINE $FMT$ERR
GLOBAL ROUTINE $FMT$FD(fd) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats up an ASCIZ string of a file
! specification given the FD.
!
! FORMAL PARAMETERS:
!
! fd: the address of the FD
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of ASCIZ string
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $FMT$FD
FMT$FD(.fd)
END ; !End ROUTINE $FMT$FD
GLOBAL ROUTINE $FMT$NUM(num) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats up an ASCIZ string for a number.
!
! FORMAL PARAMETERS:
!
! num: the value of the number
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of ASCIZ string
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $FMT$NUM
FMT$NUM(.num)
END ; !End ROUTINE $FMT$NUM
GLOBAL ROUTINE $FMT$OCT(num) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats up an ASCIZ string for an octal number.
!
! FORMAL PARAMETERS:
!
! num: the value of the number
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of ASCIZ string
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $FMT$OCT
FMT$OCT(.num)
END ; !End ROUTINE $FMT$OCT
GLOBAL ROUTINE $FMT$VRS(num) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats up an ASCIZ string for a version number.
!
! FORMAL PARAMETERS:
!
! num: the version number value
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of ASCIZ string
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $FMT$VRS
FMT$VRS(.num)
END ; !End ROUTINE $FMT$VRS
GLOBAL ROUTINE $T$FD(fd) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine outputs a file specification given the FD.
!
! FORMAL PARAMETERS:
!
! fd: the address of the FD
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $T$FD
T$FD(.fd)
END ; !End ROUTINE $T$FD
GLOBAL ROUTINE $A$INIT =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine does initialization processing for APEX.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Always returns TRUE
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $A$INIT
A$INIT()
END ; !End ROUTINE $A$INIT
GLOBAL ROUTINE $A$PDFD(num) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns the FD for the specified patch directory.
!
! FORMAL PARAMETERS:
!
! num: the number of the patch tape
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Address of system-specific FD
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $A$PDFD
A$PDFD(.num)
END ; !End ROUTINE $A$PDFD
GLOBAL ROUTINE $DEF$LN(ln,lnd,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine defines a logical name.
!
! FORMAL PARAMETERS:
!
! ln: address of string specifying logical name
!
! lnd: address of string specifying definition
!
! error: address to return address of error message in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if definition succeeds
! Returns FALSE if definition fails
!
! SIDE EFFECTS:
!
! Logical name defined.
!
!--
BEGIN !Beginning ROUTINE $DEF$LN
LOCAL
S1 ;
IF GLX(DEF$LN(.ln,.lnd),S1)
THEN
true
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $DEF$LN
GLOBAL ROUTINE $GET$LND(ln,lnd,error) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns the string associated with a logical name.
!
! FORMAL PARAMETERS:
!
! ln: address of string specifying logical name
!
! lnd: address to return address of string in
!
! error: address to return address of error message in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if definition found
! Returns FALSE if definition not available
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN !Beginning ROUTINE $GET$LND
LOCAL
S1 ;
IF GLX(GET$LN(.ln),S1)
THEN
( .lnd = .S1 ; true )
ELSE
( .error = .S1 ; false )
END ; !End ROUTINE $GET$LND
END !End body of MODULE BLSGLX
ELUDOM