Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/utlset.b36
There are 3 other files named utlset.b36 in the archive. Click here to see a list.
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE utlset (IDENT = '3'
) =
BEGIN
!
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985, 1986.
! ALL RIGHTS RESERVED.
!
! 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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY: RMSUTL
!
! ABSTRACT:
!
! UTLSET initializes RMSUTL in one of two ways. When the RMSUTL image
! is first run, UTLSET merges in RMS-SINGLE-SECTION.EXE, the RMS which
! is built to run in section 0. UTLSET stores RMS's entry vector word
! for later use and builds some PDVs (to track version numbers of both
! RMSUTL and RMS). The image should then be SAVEd (as RMSUTL).
!
! In subsequent runs, UTLSET will set up the RMS entry vector.
!
! ENVIRONMENT: RMS-SINGLE-SECTION should be on DSK: somewhere.
!
! AUTHOR: Ron Lusk , CREATION DATE: 5-Mar-85
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
! 24-Jan-86 asp - make PDV have TOPS-20 V6 symbol table vector
! so DDT works on RMSUTL.
!--
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
utlset : NOVALUE, ! Set up RMS
error : NOVALUE; ! Print error messages
!
! INCLUDE FILES:
!
LIBRARY 'tops20'; ! System definitions
!
! MACROS:
!
MACRO
!
! Equivalent of XWD directive
!
xwd (lh, rh) =
(lh^18 OR (rh AND %O'777777')) %,
!
! Create pointer to literal string
!
st$ptr [] =
CH$PTR (UPLIT (%ASCIZ %STRING(%REMAINING))) %,
!
! Return a CRLF as a string
!
crlf =
%CHAR (13, 10) %,
!
! Create instruction word with JRST to address
!
jrst (address) =
xwd (%O'254000', (address)) %,
!
! Define some BLISS names for JOBDAT addresses
!
$jbsym =
%NAME ('.JBSYM') %, ! Symbol table pointer
$jbsa =
%NAME ('.JBSA') %, ! Starting address of program
$jbver =
%NAME ('.JBVER') %, ! Version number of program
$jbren =
%NAME ('.JBREN') %; ! Re-entry address of program
!
! EQUATED SYMBOLS:
!
LITERAL
rh = %O'777777', ! Right-half mask
lh = rh^18, ! Left-half mask
wd = lh OR rh, ! Fullword mask
ev_len = 3, ! Length of entry vector
pdv_len = $pvsym + 1; ! Length of our PDVs
!
! OWN STORAGE:
!
OWN
first_time : INITIAL (1), ! Zeroed after first run
rmsjfn, ! JFN: RMS-SINGLE-SECTION.EXE
rms_ev_word, ! RMS entry vector word
utl_ev_word, ! RMSUTL entry vector word
utl_ev : VECTOR [ev_len], ! RMSUTL entry vector
utl_pdv : VECTOR [pdv_len], ! RMSUTL PDV
rms_pdv : VECTOR [pdv_len]; ! RMS PDV
!
! EXTERNAL REFERENCES:
!
EXTERNAL
$jbsym, ! Symbol table pointer
$jbsa, ! Start address
$jbver, ! Version number
$jbren; ! Re-entry address
GLOBAL ROUTINE utlset : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! UTLSET performs one-time initialization functions
! for RMSUTL; it does this in two different ways,
! however: the first time RMSUTL runs, UTLSET merges
! in RMS-SINGLE-SECTION.EXE and sets up some PDVs and
! entry vectors. UTLSET executes a HALTF and RMSUTL
! is then SAVEd.
!
! Henceforth, UTLSET will set the entry vector for RMS
! using SDVEC% and return to the caller.
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! FIRST_TIME - determines whether to initialize RMS or set EV
! .JBSA, .JBREN - these JOBDAT addresses are used for setting up
! .JBVER, .JBSYM the RMSUTL entry vector and PDV.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! A TOPS-20 entry vector for RMSUTL is set up, as are
! PDVs for both RMSUTL and RMS.EXE (which gives
! version numbers for both).
!
! RMS-SINGLE-SECTION.EXE is merged in from disk,
! increasing the size of the image from 57 to 141
! pages. The program name is also changed using
! SETNM.
!--
BEGIN
LOCAL
rmsev : REF monblock, ! Pointer to RMS entry vector
pdvdat : VECTOR [2], ! Data block for PDVOP%
pdvarg : VECTOR [$poade + 1]; ! Arg block for PDVOP%
IF .first_time ! Initial set-up or not
THEN
BEGIN ! Set up for saving
first_time = 0; ! Don't do this ever again
gevec ($fhslf; utl_ev_word); ! Save our entry vector
!+
! Try to get RMS-SINGLE-SECTION.EXE
!-
IF NOT gtjfn (gj_old OR gj_sht, ! Get a JFN for the .EXE
st$ptr ('RMS-SINGLE-SECTION.EXE'); ! ...
rmsjfn) ! ...
THEN
error (st$ptr ('GTJFN%'));
IF NOT get (xwd ($fhslf, .rmsjfn)) ! GET% RMS into memory
THEN
error (st$ptr ('GET%'));
gevec ($fhslf; rms_ev_word); ! Store RMS's entry vector
!
! Set up TOPS-20 style entry vector for RMSUTL
!
utl_ev [0] = jrst (.$jbsa); ! Get start address
utl_ev [1] = jrst (.$jbsa); ! Reentry address is same
utl_ev [2] = .$jbver; ! Version number
sevec ($fhslf, xwd (ev_len, utl_ev)); ! Set new RMSUTL EV
!
! Set up RMSUTL PDV
!
utl_pdv [$pvcnt] = pdv_len; ! Length of block
utl_pdv [$pvnam] = UPLIT ('RMSUTL'); ! Program name
utl_pdv [$pvstr] = .$jbsa<0, 18>; ! Starting address
utl_pdv [$pvree] = .$jbsa<0, 18>; ! Reentry address (same thing)
utl_pdv [$pvver] = .$jbver; ! Version number
utl_pdv [$pvsym] = .$jbsym; ! Symbol table pointer
!
! Set up RMS PDV
!
rmsev = .rms_ev_word<0, 18>; ! Address of RMS EV
rms_pdv [$pvcnt] = pdv_len; ! Length of block
rms_pdv [$pvnam] = UPLIT ('RMS'); ! Program name
rms_pdv [$pvstr] = .rmsev [$sdine, rh]; ! Starting address
rms_pdv [$pvree] = .rmsev [$sdead, rh]; ! Reentry address
rms_pdv [$pvver] = .rmsev [$sdver, wd]; ! Version number
rms_pdv [$pvsym] = 0; ! Symbol table pointer
!
! Tell the monitor about the PDVs
!
pdvarg [$poct1] = $podat + 1; ! Length of arg block
pdvarg [$pophd] = $fhslf; ! This process
pdvarg [$poct2] = 2; ! Two PDVs
pdvarg [$podat] = pdvdat; ! Location of PDVAs
pdvdat [0] = MINA (utl_pdv, rms_pdv); ! Set addresses
pdvdat [1] = MAXA (utl_pdv, rms_pdv); ! ...
IF NOT pdvop_ ($poadd, pdvarg, 0) ! Set the PDVs
THEN
error (st$ptr ('PDVOP%'));
!
! Set our name
!
setnm (%SIXBIT'RMSUTL'); ! Set this to be our name
psout (st$ptr ('[Enter SAVE command]', crlf)); ! Inform user
haltf (); ! Quit and let user save RMSUTL
END ! End of initialization
ELSE
sdvec ($fhslf, .rms_ev_word); ! Set RMS entry vector
END; ! End UTLSET
ROUTINE error (jname) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! ERROR is called when a JSYS fails. The name of the
! offending JSYS is printed (it is an argument) and
! then the TOPS-20 error message is printed. ERROR
! does not return.
!
! FORMAL PARAMETERS
!
! JNAME - pointer to ASCIZ JSYS name
!
! IMPLICIT INPUTS
!
! None.
!
! COMPLETION CODES:
!
! None - the routine does not return.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
psout (st$ptr ('?Error in ')); ! Print error prefix
psout (.jname); ! JSYS name
psout (st$ptr (' JSYS: ')); ! Error intermediate string
erstr ($priou, xwd ($fhslf, -1), 0); ! Monitor error
WHILE 1 DO
BEGIN
haltf (); ! Loop forever
psout (st$ptr ('?Can''t continue', crlf));
END;
END; ! End ERROR
END ! End of Module UTLSET
ELUDOM