Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/diut20.b36
There are 4 other files named diut20.b36 in the archive. Click here to see a list.
%TITLE 'DIUT20.B36 - TOPS-20 interface routines'
MODULE DIUT20 (IDENT = '257',
ENTRY(s$nomount, ! Let spooler ignore mount counts
s$breathe, ! Let interrupts happen if spooler
s$ifrms, ! Check file class bit in FDB
s$ati, ! Attach terminal interrupt
s$dti, ! Detach terminal interrupt
s$rir, ! Read interrupt table addresses
s$restart, ! Restart this fork
s$time, ! Return system time of day
s$node_check, ! Check to see if a node is up
s$strchk, ! Check to see if a structure is up
s$timint, ! Post timer interrupt
s$activate, ! Activate an interrupt channel
s$dtstr, ! Date and time to string
s$jfn_str, ! JFN to string
s$deactivate, ! Deactivate an interrupt channel
s$username, ! Translate user no. to user name
s$cdir, ! Return connected directory
s$jobno, ! Return job number
s$ttyno, ! Return TTY number
s$ttyjob, ! Convert TTY no. to job number
s$jobusr, ! Convert job no. to user no.
s$jobtime, ! Get runtime for job
s$broadcast, ! TTMSG
s$setname, ! Set program name
s$halt, ! Do a HALTF
s$noint, ! Disable interrupts
s$okint, ! Enable interrupts
s$crif, ! CRLF if not at left margin
s$enable, ! Enable capabilities
s$mountem, ! Mount all required structures
s$geterror, ! Return last TOPS20 error for process
s$topint, ! Set network topology change interrupt
s$dirno, ! Convert user name to user number
s$connect ! Connect a job to a given directory
)
)=
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 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: DIU-20 (Data Interchange Utility for TOPS-20)
!
! ABSTRACT: This module contains various interface routines to TOPS-20.
!
! ENVIRONMENT: TOPS-20 V6.1 XPORT
! BLISS-36 V4 RMS V3
!
! AUTHOR: Larry Campbell CREATION DATE: March 19, 1982
%SBTTL 'Revision History'
! HISTORY:
!
! 257 Change library BLI:MONSYM to just MONSYM.
! Gregory A. Scott 7-Jul-86
!
! 231 Add back S$IFRMS.
! Sandy Clemens 16-Jun-86
!
! 224 Remove routine S$IFRMS.
! Sandy Clemens 9-Jun-86
!
! 216 Let the spooler ignore mount counts by calling new routine S$NOMOUNT.
! Increment the mount count for the structure to be connected to in the
! S$MOUNTEM routine.
! Gregory A. Scott 4-Jun-86
!
! 210 Fix S$DIRNO to check for reasonable sized directory string. Also remove
! all commented out code.
! Gregory A. Scott 28-May-86
!
! 202 Remove S$IDCNV, it is no longer used.
! Gregory A. Scott 23-May-86
!
! 177 Add routine S$BREATHE, which turns off then on the interrupt system if
! we are (yet) the spooler so IPCF messages can be recieved while we have
! a section 0 stack.
! Gregory A. Scott 22-May-86
!
! 173 Add routine S$IFRMS, which will check the file class bit for a JFN.
! Gregory A. Scott 20-May-86
!
! 172 Add routine S$TRACE, which doesn't call RMS to enter trace mode but
! instead is used to output a string to the terminal for $TRACE.
! Gregory A. Scott 20-May-86
!
! 171 S$LGOUT (logout this job) and S$TRACE (tell RMS to trace DAP messages)
! aren't called by anybody any more, so remove them.
! Gregory A. Scott 19-May-86
!
! 164 Make noint_depth global so it can be cleared on a restart.
! Gregory A. Scott 16-May-86
!
! 154 Remember the job number the first time through s$jobno and return it
! from then on rather than getting it each time. Don't cancel any timer
! interrupts in s$timint for the future. Comment out s$local_nodeid and
! s$strdt.
! Gregory A. Scott 12-May-86
!
! 152 Insure that s$username returns as ASCIZ string.
! Gregory A. Scott 11-May-86
!
! 137 Add routine S$CDIR which returns the connected directory number.
! Gregory A. Scott 2-May-86
!
! 135 Remove S$MOUNTONE since it was never called, clean up S$MOUNTEM.
! Gregory A. Scott 1-May-86
!
! 132 Add routine S$ATI which does an ATI JSYS; and S$RIR which does an RIR
! JSYS; S$DTI which does a DTI JSYS.
! Gregory A. Scott 28-Apr-86
!
! 126 Remove JSYS_CLZFF ($FHSLF OR CZ_UNR OR CZ_ABT) (!) from S$LGOUT.
! Routine S$TIMINT doesn't need to do an AIC.. this is done already.
! S$TIMINT should always post timer interupts to t_channel. S$ACTIVATE
! is a little smarter now and takes the channel and routine so that it
! can call PSIINT to set the CHNTAB entry.
! Gregory A. Scott 26-Apr-86
!
! 123 Add S$RESTART which will restart this fork.
! Gregory A. Scott 23-Apr-86
!
! 112 Add S$IDCNV to convert seperate numbers to UDT.
! Gregory A. Scott 3-Apr-86
!
! V01-02 AWN0001 Andy Nourse 10-Jun-85
! Put in action routine for TRACE command.
!
! V01-00 RDF0001 Rick Fricchione 24-Oct-1984
! Original DIU version. Make any modifications needed to use
! different library files, or to use DIU facilities. Add S$DTSTR
! and S$JFN_STR from DAPT20.
!
! V00-00 AWN0001 Andy Nourse --no date--
! FTS-20 patches.
! Implement S$JOBTIME, get runtime for job. Remove SIGNAL from
! S$TOPINT. People do not want to know since FTS recovers flawlessly
! anyway. Put in ENTRY points. Make S$MOUNTONE (and thereby S$MOUNTEM),
! ACCESS domestic structure. Break out routines needed by DAP
! interface into DAPT20
!--
%SBTTL 'Forward Routine'
FORWARD ROUTINE
%IF %SWITCHES(DEBUG)
%THEN
s$trace : NOVALUE, ! Outptu trace string to terminal
%FI
s$nomount : NOVALUE, ! Let the spooler ignore mount counts
s$breathe : NOVALUE, ! Let teh spooler breathe
s$ifrms, ! Check file class bit
s$ati : NOVALUE, ! Attach terminal interrupt
s$dti : NOVALUE, ! Detatch terminal interrupt
s$rir, ! Read interrupt table addresses
s$restart : NOVALUE, ! Restart this fork
s$jfn_str, ! JFN to string
s$dtstr : NOVALUE, ! Date and time to string
s$time, ! Return system time of day
s$node_check, ! Check to see if a node is up
s$strchk, ! Check to see if a structure is up
s$timint : NOVALUE, ! Post timer interrupt
s$activate : NOVALUE, ! Activate an interrupt channel
s$deactivate : NOVALUE, ! Deactivate an interrupt channel
s$username, ! Translate user no. to user name
s$cdir, ! Return connected directory number
s$jobno, ! Return job number
s$ttyno, ! Return TTY number
s$ttyjob, ! Convert TTY no. to job number
s$jobtime, ! Get runtime for job
s$jobusr, ! Convert job no. to user no.
s$broadcast : NOVALUE, ! TTMSG
s$setname : NOVALUE, ! Set program name
s$halt : NOVALUE, ! Do a HALTF
s$noint : NOVALUE, ! Disable interrupts
s$okint : NOVALUE, ! Enable interrupts
s$crif : NOVALUE, ! CRLF if not at left margin
s$enable : NOVALUE, ! Enable capabilities
s$mountem : NOVALUE, ! Mount all required structures
s$geterror, ! Return last TOPS20 error for process
s$topint, ! Set network topology change interrupt
s$dirno, ! Convert user name to user number
s$connect; ! Connect a job to a given directory
%SBTTL 'Library Files and Externals'
! Library files
LIBRARY 'BLI:XPORT'; ! XPORT string handling
LIBRARY 'MONSYM'; ! TOPS-20 Monitor symbols
LIBRARY 'DIU'; ! DIU Data structures
REQUIRE 'JSYSDEF'; ! TOPS-20 Jsys definitions
LIBRARY 'RMSINT'; ! RMS literals and macros
UNDECLARE %QUOTE lh;
UNDECLARE %QUOTE rh;
MACRO lh = 18, 18 %,
rh = 0, 18 %;
LITERAL minute = %O'1000000'/(24*60); ! One minute
OWN job_num; ! Our job number
GLOBAL noint_depth : INITIAL (0), ! Depth of NOINT/OKINT nesting.
i_channel : INITIAL(0), ! IPCF interrupt channel
t_channel : INITIAL(1), ! Timer interrupt channel
n_channel : INITIAL(2), ! Network topology interrupt channel
c_channel : INITIAL(3); ! Control C interrupt channel
! Externals
EXTERNAL mst_flag; ! 1 if er are yet the spooler
EXTERNAL ROUTINE
IP_CONNECT_ME : NOVALUE, ! Connect me to a directory
PSIINT, ! Set up tables for use by channel
PSISIR; ! Set up fork's interrupt table addrs
%SBTTL 'Routine S$NOMOUNT'
GLOBAL ROUTINE s$nomount : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine lets the spooler access any structure without incrementing
! the mount count for that structure. This is needed so that the spooler
! can write to user log files and check the access the user has to a log
! file.
!
!--
BEGIN
JSYS_MSTR($MSIIC); ! Set to ignore mount counts
END; ! s$nomount
%SBTTL 'Routine S$BREATHE'
GLOBAL ROUTINE s$breathe : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine lets the spooler breathe. DIU is a multi section program,
! with most of the work being done in section 0, including the interrupt
! system. CHNTAB and LEVTAB are in section 0. This works fine until we
! start running in section 3 (RMS) and we get an IPCF interrupt from a
! user or a slave job. If we are running in RMS then we have a section 3
! stack (e.g. 3,,1033). The monitor sees that we have channel 0
! interrupts enabled and tries to execute the instructio pointed to by
! CHNTAB - a PUSHJ 17,INTHAN. However the PUSHJ doesn't work because we
! are in section 0 and the stack pointer is illegal for section 0. So
! what DIUC20 does is shut off the interrupt system while a non-queued
! request is being processed. The problem is that we allow long commands
! from the spooler job (like a COPY) and if a user job or a slave job
! tries to talk to us we may not be listening for a long time. So, this
! routine turns off the interrupt system (to allow those IPCFs to come
! in) and then turns it back off (so we don't get tapped on the shoulder
! while running in section 3). This makes everybody happy.
!
!--
BEGIN
IF NOT .mst_flag ! Are we yet the spooler?
THEN RETURN; ! No, return now please
S$OKINT(); ! Turn on interrupts
! Any IPCFs get done here
S$NOINT(); ! Turn them back off
END; ! s$breathe
%SBTTL 'Routine S$TRACE'
%IF %SWITCHES(DEBUG) ! Only include the following if debug
%THEN
GLOBAL ROUTINE s$trace (text) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine outputs the message pointed to by the given argument if we
! are yet debugging. This is included only if we are debugging and is
! done this way so you can set breakpoints here with SIX12.
!
! FORMAL PARAMETERS:
!
! text: pointer to ASCIZ string
!
!--
BEGIN ! This will be easy
JSYS_PSOUT(.text); ! Splat to terminal
END; ! s$trace
%FI; ! End of %IF %SWITCHES(DEBUG)
%SBTTL 'Routine S$IFRMS'
GLOBAL ROUTINE s$ifrms (jfn) : =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns TRUE if the file specified by the JFN has the RMS
! file class field set.
!
! FORMAL PARAMETERS:
!
! jfn: jfn of file
!
! ROUTINE VALUE:
!
! TRUE if the file is an RMS file
! FALSE if its not or there is an error
!
!--
BEGIN
LOCAL sfile_class;
IF NOT JSYS_GTFDB(.jfn, ! JFN of file
(1^18 OR $fbctl), ! One word at .FBCTL
sfile_class) ! Return it here
THEN RETURN FALSE; ! If it failed, return false
IF .sfile_class<18,4> EQL $fbrms ! Is the file's class set to RMS?
THEN RETURN TRUE ! Yes, return true
ELSE RETURN FALSE; ! No, return false
END; ! s$ifrms
%SBTTL 'Routine S$RIR'
GLOBAL ROUTINE s$rir : =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine returns the levtab,,chntab entry for the current fork.
!
!--
BEGIN
LOCAL returnvalue;
JSYS_RIR($FHSLF; returnvalue);
RETURN(.returnvalue);
END; ! s$rir
%SBTTL 'Routine S$ATI'
GLOBAL ROUTINE s$ati (character, channel) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine attaches the specified character to the specified channel.
!
! FORMAL PARAMETERS:
! character: ASCII control character to interrupt on
! channel: channel for the interrupt
!
!--
BEGIN
JSYS_ATI((.character^18)+.channel); ! Attach the channel
END; ! s$ati
%SBTTL 'Routine S$DTI'
GLOBAL ROUTINE s$dti (character) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine detaches the specified character from the channel.
!
! FORMAL PARAMETERS:
! character: ASCII control character to interrupt on
!
!--
BEGIN
JSYS_DTI(.character); ! Detach the channel
END; ! s$dti
%SBTTL 'Routine S$RESTART'
GLOBAL ROUTINE s$restart : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine restarts the current fork, and is called when the master
! job wants to restart itself after a fatal error.
!
! SIDE EFFECTS:
!
! Program is restarted
!
!--
BEGIN
JSYS_SFRKV($FHSLF,0) ! Boom
END; ! End of s$restart
%SBTTL 'Routine S$TIME'
GLOBAL ROUTINE s$time =
!++
! FUNCTIONAL DESCRIPTION:
! Return universal date/time. This is a BLISS fullword representing
! days since November 17, 1858. It is a binary fraction with the
! binary point exactly in the middle of the fullword. Note that this
! will only be useful on 32-bit or 36-bit systems.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! The time of day is returned.
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL time_of_day;
JSYS_GTAD (; time_of_day); ! Get the universal time of day
RETURN (.time_of_day) ! Return it
END; ! End of s$time
%SBTTL 'Routine S$NODE_CHECK'
GLOBAL ROUTINE s$node_check (count, pointer) =
!++
! FUNCTIONAL DESCRIPTION:
! Check to see if a node is online.
!
! FORMAL PARAMETERS:
! count - count of number of characters in node name
! pointer - pointer to node name string
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 1 - node is online
! 0 - node is offline or unknown
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
node_arg_block : VECTOR [$NDFLG + 1],
string : VECTOR [CH$ALLOCATION (80)];
!
! If count is zero, assume local node, which is always reachable.
!
IF .count EQL 0
THEN
RETURN (1);
!
! Copy node name with null to insure ASCIZ
!
CH$COPY (.count, .pointer, 0, .count + 1, CH$PTR (string));
node_arg_block[$NDNOD] = CH$PTR (string);
node_arg_block[$NDFLG] = 0;
JSYS_NODE ($NDVFY, node_arg_block);
RETURN ((.node_arg_block[$NDFLG] AND ND_EXM) NEQ 0)
END; ! End of s$node_check
%SBTTL 'Routine S$STRCHK'
GLOBAL ROUTINE s$strchk (count, pointer) =
!++
! FUNCTIONAL DESCRIPTION:
! Check to see if a file structure is online.
!
! FORMAL PARAMETERS:
! count - number of characters in structure name
! pointer - character pointer to structure name
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 1 - structure is online
! 0 - structure is not online
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
mstr_args : VECTOR [$MSGST + 1],
str_name : VECTOR [7],
ac1;
!
! If no structure specified, return now.
!
IF .count EQL 0
THEN
RETURN (1);
!
! Make ASCIZ copy of structure name
!
CH$COPY (.count, .pointer,
0,
.count + 1, CH$PTR (str_name));
!
! Get the current status of the structure
!
mstr_args[$MSGSN] = CH$PTR (str_name);
ac1<lh> = $MSGST + 1;
ac1<rh> = $MSGSS;
RETURN (JSYS_MSTR (.ac1, mstr_args))
END; ! End of s$strchk
%SBTTL 'Routine S$TIMINT'
GLOBAL ROUTINE s$timint (time) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Set a timer interrupt.
!
! FORMAL PARAMETERS:
!
! time: date/time (in universal date/time format)
!
! SIDE EFFECTS:
!
! A timer interrupt will be generated at the specific time.
!
!--
BEGIN
LOCAL error_code;
IF NOT JSYS_TIMER (($FHSLF^18)+$TIMDT, .time, .t_channel; error_code)
THEN SIGNAL (DIU$_BUG, .error_code);
END; ! End of s$timint
%SBTTL 'Routine S$ACTIVATE'
GLOBAL ROUTINE s$activate (channel, handler) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Activate an interrupt channel.
!
! FORMAL PARAMETERS:
! channel: number of the channel to activate
! handler: the routine to call for interrupts on this channel
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
PSISIR($FHSLF); ! Set up the interrupt table addresses
PSIINT(.channel,.handler,3); ! set chntab with the routine and lev 3
JSYS_AIC($FHSLF,1^(35-.channel)); ! Activate the channels
END; ! End of s$activate
%SBTTL 'Routine S$DEACTIVATE'
GLOBAL ROUTINE s$deactivate (channel) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Deactivate an interrupt channel.
!
! FORMAL PARAMETERS:
! channel - channel number
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
JSYS_DIC($FHSLF,1^(35-.channel)); ! Deactivate the channel
END; ! End of s$deactivate
%SBTTL 'Routine S$USERNAME'
GLOBAL ROUTINE s$username (user_number, p_desc) =
!++
! FUNCTIONAL DESCRIPTION:
! Get the username string associated with a user number.
!
! FORMAL PARAMETERS:
! user_number - TOPS-20 user number
! p_desc - pointer to descriptor to receive string
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! The length of the filespec string is returned.
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
BIND dst_desc = .p_desc : $STR_DESCRIPTOR ();
LOCAL string_buff : VECTOR [CH$ALLOCATION (6+1+80+1)],
length;
! Do the DIRST JSYS please
JSYS_DIRST (CH$PTR (string_buff), .user_number);
! Copy string back to user
$STR_COPY (TARGET = dst_desc,
STRING = (length = asciz_len (CH$PTR (string_buff)),
CH$PTR (string_buff)));
! Insure its ASCIZ
CH$WCHAR (0, CH$PLUS (.dst_desc[STR$A_POINTER], .length));
RETURN (.length) ! Return the string's length
END; ! End of s$username
%SBTTL 'Routine S$JOBNO'
GLOBAL ROUTINE s$jobno =
!++
! FUNCTIONAL DESCRIPTION:
!
! Return my job number. The job number is acquired from the monitor and
! saved. If the saved job number is nonzero, return it.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! The job number is returned
!--
BEGIN
IF .job_num NEQ 0 ! If we have been here before,
THEN RETURN (.job_num); ! Return that job number
JSYS_GJINF (; , , job_num); ! Get the job number from the monitor
RETURN (.job_num) ! and return it
END; ! End of s$jobno
%SBTTL 'Routine S$CDIR'
GLOBAL ROUTINE s$cdir =
!++
! FUNCTIONAL DESCRIPTION:
!
! Returns the connected directory number
!
! ROUTINE VALUE:
!
! The currently connected directory number
!--
BEGIN
LOCAL connected_directory;
JSYS_GJINF (; , connected_directory);
RETURN (.connected_directory)
END; ! End of s$cdir
%SBTTL 'Routine S$TTYNO'
GLOBAL ROUTINE s$ttyno =
!++
! FUNCTIONAL DESCRIPTION:
! Return TTY number (line number, not device designator) for this job.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! TTY number.
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
tty_num;
JSYS_GJINF (; , , , tty_num);
RETURN (.tty_num)
END; ! End of s$ttyno
%SBTTL 'Routine S$TTYJOB'
GLOBAL ROUTINE s$ttyjob (tty) =
!++
! FUNCTIONAL DESCRIPTION:
! Given TTY number, return the job number on that TTY.
!
! FORMAL PARAMETERS:
! tty - terminal line number (NOT terminal designator!)
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 0 - no job on terminal
! or job number
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
getab_arg,
answer;
getab_arg<lh> = .tty;
getab_arg<rh> = $TTYJO;
IF JSYS_GETAB (.getab_arg; answer)
THEN
IF .answer<lh, 1> EQL -1
THEN
RETURN (0)
ELSE
RETURN (.answer<lh>)
ELSE
RETURN (0);
END; ! End of s$ttyjob
%SBTTL 'Routine S$JOBTIME'
GLOBAL ROUTINE s$jobtime (job) =
!++
! FUNCTIONAL DESCRIPTION:
! Return the runtime for a job
!
! FORMAL PARAMETERS:
! job - job number
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 0 - some sort of failure
! or runtime for job
!--
BEGIN ![6] Implement this routine
LOCAL
getji_block,
getji_arg2;
getji_arg2<lh> = -1;
getji_arg2<rh> = getji_block;
IF JSYS_GETJI (.job, .getji_arg2, $JIRT)
THEN
RETURN (.getji_block)
ELSE
RETURN (0);
END; ! End of s$jobtime
%SBTTL 'Routine S$JOBUSR'
GLOBAL ROUTINE s$jobusr (job) =
!++
! FUNCTIONAL DESCRIPTION:
! Return the user number under which a job is logged in.
!
! FORMAL PARAMETERS:
! job - job number
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 0 - some sort of failure
! or user number
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
getji_block,
getji_arg2;
getji_arg2<lh> = -1;
getji_arg2<rh> = getji_block;
IF JSYS_GETJI (.job, .getji_arg2, $JIUNO)
THEN
RETURN (.getji_block)
ELSE
RETURN (0);
END; ! End of s$jobusr
%SBTTL 'Routine S$BROADCAST'
GLOBAL ROUTINE s$broadcast (tty, p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Broadcast via TTMSG a message to a terminal or terminals.
!
! FORMAL PARAMETERS:
!
! tty - terminal number (-1 for all terminals)
! p_descr: pointer to descriptor of message
!
!--
BEGIN
BIND descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL msg_buff : VECTOR [255];
! Check string length
IF .descr[STR$H_LENGTH] GEQ 255
THEN SIGNAL(DIU$_INV_STR_LENGTH);
! Make ASCIZ copy of string for TTMSG
CH$COPY (.descr[STR$H_LENGTH], .descr[STR$A_POINTER],
0,
.descr[STR$H_LENGTH] + 1, CH$PTR (msg_buff));
! Do the work
JSYS_TTMSG (%O'400000' + .tty, CH$PTR (msg_buff));
! Return
END; ! End of s$broadcast
%SBTTL 'Routine S$SETNAME'
GLOBAL ROUTINE s$setname (name) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Set our program name for SYSTAT.
!
! FORMAL PARAMETERS:
! name - SIXBIT program name
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
JSYS_SETSN (.name, .name);
END; ! End of s$setname
%SBTTL 'Routine S$HALT'
GLOBAL ROUTINE s$halt : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Do a HALTF (stop the current process). For slave jobs, which
! run as the top fork of the job, this causes the job to log out.
!
!--
BEGIN
JSYS_HALTF (); ! Halt the fork
END; ! End of s$halt
%SBTTL 'Routine S$NOINT'
GLOBAL ROUTINE s$noint : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Disable the interrupt system. Calls to NOINT/OKINT can be nested.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! noint_depth - if already nonzero we don't bother to do a DIS
!
! IMPLICIT OUTPUTS:
! noint_depth - incremented each trip
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! A DIS JSYS disables the software interrupt system.
!
!--
BEGIN
noint_depth = .noint_depth + 1; ! Count down the depth
IF .noint_depth GTR 1 ! Do we really need to turn off ints?
THEN RETURN; ! No, return now
JSYS_DIR ($FHSLF); ! Turn off interrupt system
END; ! End of s$noint
%SBTTL 'Routine S$OKINT'
GLOBAL ROUTINE s$okint : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! (Re-)enable the interrupt system. Since NOINT/OKINT can be nested,
! we only enable interrupts if we're exiting the last (outermost) level.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! noint_depth - nesting depth. We only enable ints if this is 1.
!
! IMPLICIT OUTPUTS:
! noint_depth - decremented
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
noint_depth = .noint_depth - 1; ! Count down depth
IF .noint_depth LSS 0 ! Down too far?
THEN SIGNAL (DIU$_TOO_MANY_OKINT); ! Yes, punt
IF .noint_depth GTR 0 ! Down all the way?
THEN RETURN; ! Nope, wait for another OKINT
JSYS_EIR ($FHSLF); ! Enable the interrupt system again
END; ! End of s$okint
%SBTTL 'Routine S$CRIF'
GLOBAL ROUTINE s$crif : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! If the terminal's cursor is not at the left margin, type a CRLF.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
tty_pos;
JSYS_RFPOS ($PRIOU; tty_pos);
IF .tty_pos<rh> NEQ 0 ! If not at column zero, type a CRLF
THEN
JSYS_PSOUT (CH$PTR (UPLIT (%CHAR (13, 10, 0))));
END; ! End of s$crif
%SBTTL 'Routine S$ENABLE'
GLOBAL ROUTINE s$enable : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Enable all capabilities possible.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
possible,
enabled;
JSYS_RPCAP ($FHSLF; possible, enabled);
enabled = .possible;
JSYS_EPCAP ($FHSLF, .possible, .enabled);
END; ! End of s$enable
%SBTTL 'Routine S$MOUNTEM'
GLOBAL ROUTINE s$mountem (p_req_block) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine requests connection to a directory, if the request block
! indicates that the requestor was connected somewhere other than where
! we're connected right now.
!
! FORMAL PARAMETERS:
!
! p_req_block: pointer to request block
!
!
! SIDE EFFECTS:
!
! We are connected to the directory specified in the request block
!
!--
BEGIN
BIND req_block = .p_req_block : $DIU_BLOCK;
LOCAL target_dir_number,
target_dir_string : $STR_DESCRIPTOR (CLASS = FIXED),
mstr_arg,
retcode,
connected_directory;
! Increment mount count for that structure. This must be done before the call
! to S$DIRNO, or it will fail (is this a monitor bug)?
mstr_arg = CH$PTR(req_block[DIU$T_CONNECTED_DIRECTORY]); ! Point to dir
IF NOT (retcode = JSYS_MSTR (1^18+$MSIMC, mstr_arg)) ! Mount please
THEN SIGNAL(DIU$_NO_CONNECT,.retcode); ! Signal error
! Get our current connected directory number, and target directory number
$STR_DESC_INIT (DESCRIPTOR = target_dir_string, CLASS = FIXED,
STRING = (.req_block[DIU$H_CONNECTED_DIRECTORY],
CH$PTR(req_block[DIU$T_CONNECTED_DIRECTORY])));
target_dir_number = s$dirno(target_dir_string);
! Get our currently connected directory
JSYS_GJINF(; , connected_directory);
! If we're already connected there, just return
IF .connected_directory EQL .target_dir_number
THEN RETURN;
! Have the spooler connect me to the directory connected to when req created
! The spooler does it since we would need a password to access the str.
ip_connect_me(.target_dir_number, target_dir_string);
END; ! End of s$mountem
%(
%SBTTL 'Routine S$MONE'
ROUTINE s$mone (pointer) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Mount one structure, access directory on that structure if needed.
!
! FORMAL PARAMETERS:
!
! pointer: string pointer to string of the form GREEN:<GSCOTT.DIU>
!
!--
BEGIN
LOCAL mstatus, ! Status returned by MSTR
mstr_args : VECTOR [$MSGST + 1], ! argument block for MSTR
str_name : VECTOR [CH$ALLOCATION(7)], ! structure or dir name
str_desc : $STR_DESCRIPTOR (CLASS = FIXED), ! descriptor for above
usr_buff : VECTOR [CH$ALLOCATION(80)], ! buffer for directory
usr_desc : $STR_DESCRIPTOR (CLASS = BOUNDED, ! desc for dir buffer
STRING = (80,CH$PTR(usr_buff))),
dir_buff : VECTOR [CH$ALLOCATION(90)], ! buffer for directory
dir_desc : $STR_DESCRIPTOR (CLASS = BOUNDED, ! desc for dir buffer
STRING = (90,CH$PTR(dir_buff))),
acces_args : VECTOR[3], ! for ACCES JSYS
retcode; ! return value
! Create descriptor to structure name for error messages
$STR_DESC_INIT (DESCRIPTOR = str_desc, CLASS = FIXED,
STRING = (.count, .pointer));
! Create descriptor for my directory to connect to for later
s$username(s$jobusr(s$jobno()),usr_desc);
$STR_COPY(STRING=$STR_CONCAT(str_desc, ! Structure name
':<', ! delimiters
usr_desc, ! username
%STRING('>',%CHAR(0))), ! delimiters
TARGET=dir_desc); ! Make str:<username>
! Get the current status of the structure
mstr_args[$MSGSN] = .pointer;
IF NOT JSYS_MSTR(($MSGST+1)^18+$MSGSS, mstr_args)
THEN SIGNAL (DIU$_STRUCTURE_NOT_UP, s$geterror($FHSLF), 0, str_desc);
mstatus = .mstr_args[$MSGST]; ! Save structure status
! If structure is PS, no need to mount it
IF (.mstatus AND MS_PPS) NEQ 0
THEN RETURN;
! OK, try to mount the structure, if already mounted that's OK
mstr_args[$MSDEV] = .pointer; ! Point to structure
IF NOT JSYS_MSTR (($MSDEV+1)^18+$MSIMC, mstr_args) ! Mount it please
THEN BEGIN ! Failed, check error
IF (retcode = s$geterror ($FHSLF)) NEQ MSTX31 ! Structure mounted?
THEN SIGNAL (DIU$_STRUCTURE_NOT_UP, .retcode, 0, str_desc); ! Nope
END;
! If structure is Domestic, try to ACCESS our own directory on it
IF (.mstatus AND MS_DOM) NEQ 0 ! Is it domestic?
THEN BEGIN ! Yes, try ACCESSing my home there
acces_args[$ACDIR] = .dir_desc[STR$A_POINTER]; ! Dir to access
acces_args[$ACPSW] = 0; ! No password needed
acces_args[$ACJOB] = -1; ! Our job
JSYS_ACCES(AC_OWN+3,acces_args); ! Try it, and ignore failure
END;
END; ! End of s$mone
)%
%SBTTL 'Routine S$GETERROR'
GLOBAL ROUTINE s$geterror (fork_handle) =
!++
! FUNCTIONAL DESCRIPTION:
! Return the most recent TOPS20 error code for the process.
!
! FORMAL PARAMETERS:
! NONE
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
error_code;
JSYS_GETER ($FHSLF; error_code);
RETURN (.error_code<rh>)
END; ! End of s$geterror
%SBTTL 'Routine S$TOPINT'
GLOBAL ROUTINE s$topint (channel) =
!++
! FUNCTIONAL DESCRIPTION:
! Set up to receive interrupts on network topology changes.
!
! FORMAL PARAMETERS:
! channel - channel on which to generate the interrupt
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! 0 - failure, scheduler must wake up frequently instead
! 1 - success
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
JSYS_NODE ($NDSIC, channel)
END; ! End of s$topint
%SBTTL 'Routine S$DIRNO'
GLOBAL ROUTINE s$dirno (p_descr) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Convert directory name string to directory or user number.
!
! FORMAL PARAMETERS:
!
! p_descr: pointer to descriptor of string
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! The directory number is returned.
! If any errors occur, they are SIGNALled.
!
!--
BEGIN
BIND descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL string_buffer : VECTOR [CH$ALLOCATION (90)],
bits,
user_number;
IF .descr[STR$H_LENGTH] GTR 89
THEN SIGNAL (DIU$_INV_STR_LENGTH);
! Make ASCIZ copy of directory name
CH$COPY (.descr[STR$H_LENGTH], .descr[STR$A_POINTER],
0,
.descr[STR$H_LENGTH]+1, CH$PTR(string_buffer));
! Get the JSYS done
bits = RC_EMO; ! Exact match only
IF NOT JSYS_RCDIR (.bits, CH$PTR (string_buffer), 0; bits, , user_number)
THEN SIGNAL (DIU$_NO_CONNECT, s$geterror($FHSLF));
! Check returned bits for error, if so give "Invalid directory specification"
IF (.bits AND (RC_NOM OR RC_AMB OR RC_NMD)) NEQ 0 ! Any error?
THEN SIGNAL(DIU$_NO_CONNECT, RCDIX2); ! Yes, "Invalid dir"
! It was OK, return the user number
RETURN (.user_number)
END; ! End of s$dirno
%SBTTL 'Routine S$CONNECT'
GLOBAL ROUTINE s$connect (job, dir_num) =
!++
! FUNCTIONAL DESCRIPTION:
! Connect a job to a given directory number.
!
! FORMAL PARAMETERS:
! job - job number (-1 for current job)
! dir_num - 36-bit directory number
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! DIU$_NORMAL - OK, job connected
!
! code,,0 - TOPS20 error code
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
LOCAL
access_args : VECTOR [$ACJOB + 1];
access_args[$ACDIR] = .dir_num;
access_args[$ACPSW] = 0;
access_args[$ACJOB] = .job;
IF NOT JSYS_ACCES (AC_CON + $ACJOB + 1, access_args)
THEN
RETURN ((s$geterror ($FHSLF)) ^ 18)
ELSE
RETURN (DIU$_NORMAL)
END; ! End of s$connect
%SBTTL 'Routine S$DTSTR'
GLOBAL ROUTINE s$dtstr (date_time, p_descr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Convert internal date/time to string.
!
! FORMAL PARAMETERS:
! date_time - date and time in universal internal format
! (-1 means now)
! p_descr - pointer to descriptor to receive string
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
BIND
descr = .p_descr : $STR_DESCRIPTOR ();
LOCAL
ptr,
length,
string_buffer : VECTOR [CH$ALLOCATION (32)];
JSYS_ODTIM (CH$PTR (string_buffer), .date_time, 0);
ptr = CH$PTR (string_buffer);
length = 0;
UNTIL (CH$RCHAR_A (ptr) EQL 0)
DO
length = .length + 1;
$STR_COPY (STRING = (.length, CH$PTR (string_buffer)), TARGET = descr,
OPTION = TRUNCATE);
END; ! End of s$dtstr
%SBTTL 'Routine S$JFN_STR'
GLOBAL ROUTINE s$jfn_str (jfn, p_desc, bits) =
!++
! FUNCTIONAL DESCRIPTION:
! Convert a JFN to a filespec string.
!
! FORMAL PARAMETERS:
! jfn - the JFN
! p_desc - address of descriptor to receive the string
! bits - format control bits (AC3 of JFNS call). If 0, this
! defaults to the usual case (supply and punctuate everything)
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! The length of the filespec string is returned, or 0 if any errors (which
! are also signalled).
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
BIND desc = .p_desc : $STR_DESCRIPTOR ();
LOCAL temp_desc : $STR_DESCRIPTOR (CLASS = FIXED),
temp_desc_buffer : VECTOR [CH$ALLOCATION (255)],
adjusted_length,
jfns_bits,
new_ptr;
$STR_DESC_INIT (DESCRIPTOR = temp_desc,
STRING = (255, CH$PTR (temp_desc_buffer)));
IF .bits EQL 0 ! If he didn't specify any bits
THEN jfns_bits = %O'111110000001' ! Return all the usual fields
ELSE jfns_bits = .bits;
! Do the work
IF NOT JSYS_JFNS (.temp_desc[STR$A_POINTER], .jfn, .jfns_bits, 0; new_ptr)
THEN SIGNAL (XPO$_CHANNEL);
temp_desc[STR$H_LENGTH] = ABS(CH$DIFF(.new_ptr,
.temp_desc[STR$A_POINTER])) + 1;
$STR_COPY (STRING = temp_desc, TARGET = desc, OPTION = TRUNCATE);
! Unless the target descriptor was too short, we also copied the trailing
! null. Here we account for that. If the last character of the target
! is null, we copied the null, so must return a length one less.
adjusted_length = MIN (.desc[STR$H_LENGTH],
.temp_desc[STR$H_LENGTH]);
IF CH$RCHAR (CH$PLUS (.desc[STR$A_POINTER], .adjusted_length - 1)) EQL 0
THEN adjusted_length = .adjusted_length - 1;
RETURN (.adjusted_length) ! Return the real length
END; ! End of s$jfn_str
END ! End of module
ELUDOM