Google
 

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