Trailing-Edge
-
PDP-10 Archives
-
BB-FB49A-RM
-
sources/sntusp.b36
There are no other files named sntusp.b36 in the archive.
%title 'SNT Utility Support Procedures'
module SNTUSP (ident = 'Version 1.00') =
begin
! Copyright (c) 1984, 1985 by
! DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts
!
! 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: DECnet/SNA TOPS-20 Trace Protocol Utility Support Package.
!
! ABSTRACT: This module provide routines to do utility support, i.e.
! buffer allocation, enqueue/dequeue.
!
! ENVIRONMENT: TOPS-20 Operating Systems, user mode.
!
! AUTHOR: Dennis Brannon CREATION DATE: April 20, 1984.
!
! MODIFIED BY:
!
! D. Brannon, 11-Oct-84 : VERSION 1.00
!
! 1.01 D. Brannon, 26-Oct-84
! Added routine USP$TRANSLATE_SNAGAT to translate the logical name
! SNAGAT into the default SNA Gateway node name.
!--
!
! REQUIRED FILES
!
library 'MONSYM'; ! Monitor symbols
library 'SYS:TXTLIB'; ! Text Processing Library
library 'SNTDEF'; ! PSITST common definitions
require 'JSYS'; ! TOPS-20 JSYS declarations
!
! FORWARD REFERENCES
!
forward routine
USP$AUTHORIZATION: novalue,
USP$PLURALIZE,
USP$ERROR_MESSAGE: novalue,
USP$FINAL_STATISTICS: novalue,
USP$GET_TIME_STAMP,
USP$LOCK: novalue,
USP$PUT_TIME_STAMP: novalue,
USP$RESET_CONTROL: novalue,
USP$RESET_TERMINAL: novalue,
USP$RUN_TIME: novalue,
USP$SYSTEM_IDENTIFICATION: novalue,
USP$TIME_ZONE: novalue,
USP$TRANSLATE_SNAGAT: novalue,
USP$UNLOCK: novalue;
!
! OWN STORAGE
!
own
ERRORS: ERROR_MESSAGES_BLOCK preset (ERROR_MESSAGES);
!
! EXTERNAL REFERENCES
!
external
CONTROL: GLOBAL_CONTROL_BLOCK;
external routine
BLISS_PSI_ROUTINES;
external routine
MEM$GET,
MEM$INITIALIZE: novalue,
MEM$RETURN: novalue,
USP$BUFFER_INITIALIZE: novalue,
TXT$WRITE;
%global_routine ('USP$AUTHORIZATION') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine to verify the WHEEL, OPERATOR, or MAINTENANCE capability
! of the SNT user.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! $TRUE User has WHEEL or OPERATOR capability enabled.
! $FALSE User did not pass the check.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
CAPABILITIES;
jsys_rpcap ($fhslf; ,, CAPABILITIES); ! Get user's enabled capabilities
if .CAPABILITIES<$(sc_whl)> ! Does user have WHEEL ?
or .CAPABILITIES<$(sc_opr)> ! or OPERATOR ?
or .CAPABILITIES<$(sc_mnt)> ! or MAINTENANCE ?
then return; ! Successful verification
! If failed, issue a warning message
jsys_psout (CH$ASCIZ ('Need more priviledges'));
jsys_haltf (); ! Stop the program
end; ! End of USP$AUTHORIZATION
%global_routine ('USP$PLURALIZE', COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Return the unit text string in bytes.
!
! FORMAL PARAMETERS:
!
! COUNT Length in bytes.
!
! ROUTINE VALUE:
!
! Pointer to the appropriate unit text string.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
POINTER;
if .COUNT eqlu 1
then POINTER = CH$ASCIZ (' ')
else POINTER = CH$ASCIZ ('s');
return .POINTER;
end; ! End of USP$PLURALIZE
%global_routine ('USP$ERROR_MESSAGE', ERROR) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! ERROR Error code.
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
BUFFER,
POINTER,
STRING;
BUFFER = MEM$GET (1);
STRING = .ERRORS[.ERROR,ERB_MESSAGE];
POINTER = ch$ptr (.BUFFER);
TXT_WRITE (POINTER, $MEMORY_BUFFER_SIZE * 5, '? %a%/', .STRING);
jsys_psout (ch$ptr (.BUFFER));
! if LOG$LOGGING (0, 0)
! then LOG$TEXT (ch$ptr (.BUFFER));
MEM$RETURN (.BUFFER);
return;
end; ! End of USP$ERROR_MESSAGE
%global_routine ('USP$FINAL_STATISTICS') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Tabulate final statistics of the session.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
return;
end; ! End of USP$FINAL_STATISTICS
%global_routine ('USP$GET_TIME_STAMP', POINTER) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Extract time stamp from trace header.
!
! FORMAL PARAMETERS:
!
! POINTER Address of pointer to beginning of data record.
!
! ROUTINE VALUE:
!
! Date and Time are returned in the TOPS-20 internal format.
!
! SIDE EFFECTS:
!
! Pointer to the header record is updated to point to the byte after
! the date and time fields.
!
!--
begin
local
TEMP,
TIME;
jsys_sin (..POINTER, ch$ptr (TEMP,,8), -3; .POINTER); ! Date
TEMP = .TEMP ^ -12; ! Shift right to make binary value
TIME<18,18> = .TEMP<0,18>; ! Save date value
jsys_sin (..POINTER, ch$ptr (TEMP,,8), -3; .POINTER); ! Time
TEMP = .TEMP ^ -12; ! Shift right to make binary value
TIME<0,18> = .TEMP<0,18>; ! Save time value
return .TIME;
end; ! End of USP$GET_TIME_STAMP
%global_routine ('USP$LOCK', KEY) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine to perform the locking of a resource area by ENQueue.
!
! FORMAL PARAMETERS:
!
! KEY The value to be used as a key to access the area.
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
ENQUEUE: ENQUEUE_DEQUEUE_BLOCK;
ENQUEUE[EDQ_LN] = $$(1,$ennlk) + 6; ! Length of argument block
ENQUEUE[EDQ_ID] = 0; ! No interrupt channel and request id
ENQUEUE[EDQ_LV] = en_bln + en_job; ! Resource used by forks only
ENQUEUE[EDQ_UC] = .KEY; ! User code key
ENQUEUE[EDQ_RS] = 0; ! One resource at a time
ENQUEUE[EDQ_MS] = 0; ! No mask
while not jsys_enq ($enqbl, ENQUEUE)
do; ! Block job until resource allocated
PSIDIR ($fhslf); ! Disable the interrupt system
return;
end; ! End of USP$LOCK
%global_routine ('USP$PUT_TIME_STAMP', POINTER) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get current time and date and write to buffer as a 6 byte unit.
!
! FORMAL PARAMETERS:
!
! POINTER Address of variable containing pointer to
! destination buffer.
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
TEMP,
TIME;
jsys_gtad (; TIME); ! Get current time and date
TEMP = .TIME<18,18>; ! Current date
TEMP = .TEMP ^ 12; ! Shift left to make 3 8-bit bytes
.POINTER = ch$move (3, ch$ptr (TEMP,,8), ..POINTER); ! Write date
TEMP = .TIME<0,18>; ! Current time
TEMP = .TEMP ^ 12; ! Shift left to make 3 8-bit bytes
.POINTER = ch$move (3, ch$ptr (TEMP,,8), ..POINTER); ! Write time
return;
end; ! End of USP$PUT_TIME_STAMP
%global_routine ('USP$RESET_CONTROL') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Initialize control block data base.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
USP$BUFFER_INITIALIZE (CONTROL, $GLOBAL_CONTROL_BLOCK_SIZE);
MEM$INITIALIZE (); ! Initialize buffer pool area
CONTROL[GCB_VERSION] = $VERSION_NUMBER;
CONTROL[GCB_MINOR] = $MINOR_NUMBER;
CONTROL[GCB_EDIT] = $EDIT_NUMBER;
CONTROL[GCB_EXIT] = $FALSE;
CONTROL[GCB_COMMAND_STRING] = MEM$GET (1);
CONTROL[GCB_CPU_TIME] = MEM$GET (1);
jsys_time (; .CONTROL[GCB_CPU_TIME]);
jsys_gtad (; CONTROL[GCB_START_CLOCK]);
return;
end; ! End of USP$RESET_CONTROL
%global_routine ('USP$RUN_TIME') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Calculate the total run time of PSITST.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
TEMP,
TIME,
TIME_BLOCK: ref vector [5];
jsys_time (; TIME);
! Get total run time in milliseconds
TIME = .TIME - .(.CONTROL[GCB_CPU_TIME]);
TIME_BLOCK = .CONTROL[GCB_CPU_TIME];
TIME_BLOCK[0] = .TIME / 3600000;
TIME_BLOCK[1] = (.TIME - (TEMP = .TIME_BLOCK[0] * 3600000)) / 60000;
TIME_BLOCK[2] = (.TIME - (.TEMP + (.TIME_BLOCK[1] * 60000))) / 1000;
TIME_BLOCK[3] = (.TIME mod 1000) / 20;
TIME_BLOCK[4] = 50; ! Number of ticks (20 msec) per second
return;
end; ! End of USP$RUN_TIME
%global_routine ('USP$RESET_TERMINAL') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Refresh terminal screen and display software herald.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
TYPE,
STATUS,
CCOC: vector [2];
jsys_gttyp ($priou; , TYPE); ! Get control terminal type
jsys_rfcoc ($priou; , CCOC[0], CCOC[1]);
STATUS = .CCOC[1];
(CCOC[1])<16,2> = %B'10';
jsys_sfcoc ($priou, .CCOC[0], .CCOC[1]);
selectone .TYPE of
set
[$ttv52]: ! VT52
jsys_psout (CH$ASCIZ (%char(%O'33'),'H',%char(%O'33'),'J'));
[$tt100]: ! VT100
jsys_psout (CH$ASCIZ (%char(%O'33'),'[2J',%char(%O'33'),'[0;0H'));
[otherwise]:
0;
tes;
jsys_sfcoc ($priou, .CCOC[0], .STATUS);
return;
end; ! End of USP$RESET_TERMINAL
%global_routine ('USP$SYSTEM_IDENTIFICATION') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine to obtain the system identification.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
external
%name('P.VERS'),
%name('E.VERS');
local
NODPTR,
POINTER,
LENGTH,
INDEX,
SYSVER: vector [2],
SIB: ref SYSTEM_INFORMATION_BLOCK;
SIB = CONTROL[GCB_SYSTEM_INFORMATION_BLOCK];
POINTER = ch$ptr (SIB[SIB_SYSTEM_NAME]);
jsys_node ($ndgln, POINTER); ! Get node name known to the network
SIB[SIB_SYSTEM_VERSION] = MEM$GET (2);
POINTER = ch$ptr (.SIB[SIB_SYSTEM_VERSION]);
LENGTH = $MEMORY_BUFFER_SIZE * 5 * 2;
INDEX = 0;
while $TRUE
do begin
jsys_getab ((.INDEX^18)+$sysve; SYSVER[0]);
SYSVER[1] = 0; ! Make an ASCIZ string
INDEX = .INDEX + 1;
if .SYSVER[0] eql 0
then exitloop
else LENGTH = .LENGTH - TXT_WRITE (POINTER,
.LENGTH,
'%a%N',
ch$ptr (SYSVER));
end;
LENGTH = .LENGTH - TXT_WRITE (POINTER,
.LENGTH,
'%/TOPS-20 SNT Version %D.%D(%D)%/%N',
.CONTROL[GCB_VERSION],
.CONTROL[GCB_MINOR],
.CONTROL[GCB_EDIT]);
TXT_WRITE (POINTER, .LENGTH, '%2y %4z%3/');
jsys_psout (ch$ptr (.SIB[SIB_SYSTEM_VERSION]));
return;
end; ! End of USP$SYSTEM_IDENTIFICATION
%global_routine ('USP$TIME_ZONE', POINTER) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get the time zone and write to buffer.
!
! FORMAL PARAMETERS:
!
! POINTER Address of variable containing pointer to
! destination buffer.
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
BUFFER,
STRING,
LENGTH;
BUFFER = MEM$GET (1); ! Get temporary buffer for time string
jsys_odtim (ch$ptr (.BUFFER), -1, ot_nda+ot_nsc+ot_nco+ot_tmz+ot_scl);
STRING = ch$find_ch ($MEMORY_BUFFER_SIZE * 5, ch$ptr (.BUFFER), $MINUS);
STRING = ch$plus (.STRING,1); ! Get time zone string
LENGTH = CH$LEN (.STRING); ! Get string length
ch$wchar_a (.LENGTH, .POINTER); ! Write count byte
.POINTER = ch$move (.LENGTH, .STRING, ..POINTER); ! Rest of the string
MEM$RETURN (.BUFFER); ! Return temporary buffer
return;
end; ! End of USP$TIME_ZONE
%global_routine ('USP$TRANSLATE_SNAGAT') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Translate the logical name SNAGAT: and store it in the SNAGAT.
!
! FORMAL PARAMETERS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
external
SNAGAT;
local
LEN,
PTR,
SNA_GATEWAY,
BUF: block [2];
!
! Translate SNAGAT = SNA Gateway Node Name
!
SNA_GATEWAY = ch$ptr (uplit ('SNAGAT'));
PTR = ch$ptr (BUF);
if not (jsys_lnmst ($lnsjb, .SNA_GATEWAY, .PTR))
then begin
if not (jsys_lnmst ($lnssy, .SNA_GATEWAY, .PTR)) then return
end;
LEN = CH$LEN (.PTR);
CH$MOVE (.LEN, .PTR, CH$PTR (SNAGAT));
return;
end; ! End of USP$TRANSLATE_SNAGAT
%global_routine ('USP$UNLOCK', KEY) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine to perform the unlocking of a resource area by DEQueue.
!
! FORMAL PARAMETERS:
!
! KEY The value to be used as a key to access the area.
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
DEQUEUE: ENQUEUE_DEQUEUE_BLOCK;
DEQUEUE[EDQ_LN] = $$(1,$ennlk) + 6; ! Length of argument block
DEQUEUE[EDQ_ID] = 0; ! No interrupt channel and request id
DEQUEUE[EDQ_LV] = en_bln + en_job; ! Resource used by forks only
DEQUEUE[EDQ_UC] = .KEY; ! User code key
DEQUEUE[EDQ_RS] = 0; ! One resource at a time
DEQUEUE[EDQ_MS] = 0; ! No mask
while not jsys_deq ($deqdr, DEQUEUE)
do; ! Release locked resource
PSIEIR ($fhslf); ! Enable the interrupt system
return;
end; ! End of USP$UNLOCK
end ! End of SNTUSP module
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: