Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/diumod.b36
There are 4 other files named diumod.b36 in the archive. Click here to see a list.
%TITLE 'Modify DIU Requests'
MODULE DIUMOD (IDENT = '252',
LANGUAGE(BLISS36),
ENTRY(DIU$MODIFY)) =
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 handles modifications to existing queued
! reqeusts.
!
! ENVIRONMENT: TOPS-20 V6.1 XPORT
! BLISS-32 V4 RMS V3
!
! AUTHOR: Andrew Nourse CREATED: 5-Dec-1981
! HISTORY:
!
! 252 Remove library of CONDIT.
! Sandy Clemens 1-Jul-86
!
! 213 Bad call to S$USERNAME was causing modify requests to occasionally fail
! and also not default the username correctly.
! Gregory A. Scott 2-Jun-86
!
! 205 Make the NEXT function set the after time to zero and release the
! request. Clean up DIU$MODIFY, move MODREQ outside DIU$MODIFY block.
! Gregory A. Scott 27-May-86
!
! 146 Last edit was a bit too adventerous about printing the node name.
! Only output it if there wasn't a request number specified. Add a
! number of errors to list in MODREQ.
! Gregory A. Scott 7-May-86
!
! 144 Rename Q$MESSAGE to be DIU$MMESSAGE, and make it print better messages
! including the node name specified. Change call to DIU$MESSAGE to not
! enter these messages into the system log file.
! Gregory A. Scott 6-May-86
!
! 127 Remove strange hack where a negative request id meant that you really
! wanted /SEQ:CONT.
! Gregory A. Scott 26-Apr-86
!
! V01-031 Sandy Clemens 17-Sep-85
! Change name of DIU-COMMAND.R36 to DIUCOMMAND.R36 to make porting
! to TOPS-10 easier. (TOPS-10 will truncate DIUCOMMAND to DIUCOM,
! but cannot bypass the "-").
!
! V01-004 Doug Rayner 14-Aug-85
! Add support for TOPS-10 [P,Pn]'s
!
! V01-003 Rick Fricchione 26-Oct-1984
! Modify for DIU. Use new queue find routines. Handle
! new request block format, and clean up.
!
! V01-002 Andy Nourse --no date--
! 02 - Put in ENTRY points
!--
%SBTTL 'Forward Routine'
FORWARD ROUTINE
DIU$MODIFY, ! Modify existing DIU request(s)
MODREQ, ! Modify one request
DIU$MMESSAGE: NOVALUE; ! Print an error with a request block
%SBTTL 'Libraries and Externals'
! Libraries
LIBRARY 'BLI:XPORT'; ! XPORT is not your friend
LIBRARY 'DIU'; ! DIU Data Structures
LIBRARY 'FAO'; ! FAO macros and symbols
LIBRARY 'DIUCOMMAND'; ! DIU command macros
! External routines
EXTERNAL ROUTINE IP_FIND, ! Find a request
IP_MODIFY, ! Modify a request
IP_DELETE, ! Delete a request
DIU$MESSAGE, ! ASCIIze an error message
S$CRIF, ! Output CRLF if needed
S$USERNAME, ! Username from usernumber
S$JOBNO, ! Return our job number
S$JOBUSR; ! Usernumber from job number
EXTERNAL TTY: $XPO_IOB(); ! TTY IOB
MACRO $ = 0, 0, 0, 0 %;
! Static data
OWN modtab: VECTOR[M_MAX+1]
PRESET(
[M_HOLD] =PP('held'),
[M_KILL] =PP('cancelled'),
[M_MODIFY] =PP('modified'),
[M_NEXT] =PP('next'),
[M_RELEASE]=PP('released'));
%SBTTL 'Routine DIU$MODIFY'
GLOBAL ROUTINE DIU$MODIFY (request_block : REF $DIU_BLOCK,
mfunct,
mopt : REF BITVECTOR
)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Perform work for the following commands: HOLD, RELEASE, KILL, NEXT,
! and of course MODIFY.
!
! FORMAL PARAMETERS:
!
! request_block: Template request to modify
! mfunct: Function code for command (M_MODIFY, M_HOLD, etc).
! mopt: Bit map for what to modify.
!--
! Condition handler for this routine - just frees memory
ROUTINE modfree (signal_args : REF VECTOR,
mech_args,
enable_args : REF VECTOR)=
BEGIN ! Routine to free block we allocated
LOCAL tchn;
tchn =..enable_args[1]; ! Head of chain
SELECT .signal_args[1] OF
SET
[SS$_UNWIND]: WHILE .tchn NEQ 0 ! Until we reach the end of chain
DO BEGIN
LOCAL ttc;
ttc = .tchn;
tchn = ..tchn; ! Next link
$XPO_FREE_MEM(BINARY_DATA=(DIU$K_LEN+%UPVAL,.ttc));
SS$_RESIGNAL
END;
[OTHERWISE]: RETURN SS$_RESIGNAL;
TES
END; ! MODFREE
LOCAL req_count : INITIAL(0), ! Number of requests processed
line : $STR_DESCRIPTOR(CLASS=DYNAMIC), ! Line to print on terminal
chain : REF VECTOR, ! Pointer to chain of requests
tchain : VOLATILE REF VECTOR,
status;
ENABLE MODFREE(tchain); ! Enable our memory free routine
! If no username specified, then default properly to requestor's own requests
IF .request_block[DIU$H_USERNAME] EQL 0
%IF %SWITCHES(TOPS10) %THEN
AND (.request_block[DIU$G_USER_NUMBER] EQL 0)
%FI
THEN BEGIN
LOCAL usrdesc : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(40,CH$PTR(request_block[DIU$T_USERNAME])));
! Default our user name into the passed request block
%IF %SWITCHES(TOPS20)
%THEN
request_block[DIU$H_USERNAME] = S$USERNAME(S$JOBUSR(S$JOBNO()),usrdesc);
%ELSE
request_block[DIU$H_USERNAME] = S$USERNAME(S$JOBNO(),usrdesc);
%FI
END;
! Loop through all requests looking for one that matches to change
IF (status = IP_FIND(request_block[$],chain)) ! Look for something to fiddle
THEN DO BEGIN ! Got something
BIND REQ=CHAIN[%UPVAL]: $DIU_BLOCK; ! Bind to current request
! Request found, do it to this one
modreq(request_block[$],req[$],.mfunct,.mopt,req_count);
! Free memoru that IP_FIND got for us
tchain = .chain; ! Save addr of block so we can free it
chain = .chain[0]; ! Point to next one in chain
$XPO_FREE_MEM(BINARY_DATA=(DIU$K_LEN+%UPVAL,.tchain)); ! Free one req
END WHILE .chain NEQ 0 ! Loop until no more requests to check
ELSE DIU$MMESSAGE(.status,0,request_block[$]); ! Request wasn't found
! Give message telling how many requests were modified.
S$CRIF(); ! CRLF if needed
$STR_DESC_INIT(DESC=line, CLASS=DYNAMIC);
$GET_FAO('[!SL request!%S !AZ]!/', ! Make the line up
line,
.req_count,
.modtab[.mfunct]);
$XPO_PUT(IOB=tty, STRING=line); ! Send it to the user
$XPO_FREE_MEM(STRING=line); ! Free dynamic string memory
.status ! Return what IP_FIND returned
END; ! DIU$MODIFY
%SBTTL 'Routine MODREQ'
ROUTINE modreq (request_block: REF $DIU_BLOCK, ! Template
req: REF $DIU_BLOCK, ! Current request
mfunct, ! Which command (M_whatever)
mopt: REF BITVECTOR, ! Bitmap of modify options
req_count ! Count of requests hacked
) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine hacks one request for routine DIU$MODIFY.
!
! FORMAL PARAMETERS:
!
! request_block: user's modify request template
! req: current request to modify
! mfunct: command to perform
! mopt: bitmask of fields that change
! req_count: count of request successfully modified
!
! SIDE EFFECTS:
!
! The specified request is modified.
!--
! Routine to handle conditions from here... all it does is print messages.
ROUTINE modhan (signal_args: REF VECTOR,
mech_args: REF VECTOR,
enable_args: REF VECTOR) = ! [1]=request block
BEGIN
SELECT .signal_args[1] OF
SET
! Request finished or killed while we were running this
[DIU$_REQ_NOT_FOUND]: RETURN SETUNWIND();
[DIU$_INSUFF_PRIVS, ! These errors should not stop
DIU$_ACTIVE, ! the command
DIU$_NO_PREREQ,
DIU$_HAS_DEPENDENT,
DIU$_INVALID_PREREQ,
DIU$_PREREQ_NON_EXIST,
DIU$_PREREQ_NOT_YOURS,
DIU$_PREREQ_LOOP]: BEGIN
DIU$MMESSAGE(.signal_args[1],
0,..enable_args[1]);
RETURN SETUNWIND();
END;
[OTHERWISE]: RETURN SS$_RESIGNAL;
TES
END; ! End of MODHAN condition handler
LOCAL reqsav: VOLATILE; ! Request ID of this request
ENABLE modhan (reqsav); ! Enable message printer
reqsav = req[$];
CASE .mfunct FROM M_MIN TO M_MAX OF ! Figure out what to do
SET
[M_KILL]: IP_DELETE(.req[DIU$H_REQUEST_ID]); ! KILL command
[M_MODIFY]: BEGIN ! MODIFY command
IF .mopt[DIUQ$K_AFTER] ! /AFTER
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_AFTER,
.request_block[DIU$G_AFTER]);
IF .mopt[DIUQ$K_DEADLINE] ! /DEADLINE
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_DEADLINE,
.request_block[DIU$G_DEADLINE]);
IF .mopt[DIUQ$K_PRIORITY] ! /PRIORITY
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_PRIORITY,
.request_block[DIU$B_PRIORITY]);
IF .mopt[DIUQ$K_LOG_FILESPEC] ! /[NO]LOG
THEN BEGIN
LOCAL d_log: $STR_DESCRIPTOR();
$STR_DESC_INIT(DESC=d_log,
STRING=(.request_block[DIU$H_LOG_FILESPEC],
CH$PTR(request_block[DIU$T_LOG_FILESPEC])));
IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_LOG_FILESPEC,D_LOG);
END;
IF .mopt[DIUQ$K_SEQUENCE] ! /SEQUENCE
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_SEQUENCE,
.request_block[DIU$V_SEQ_CONTINUE]);
IF .mopt[DIUQ$K_PREREQUISITE_ID] ! /PREREQUISITE
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],
DIUQ$K_PREREQUISITE_ID,
.request_block[DIU$H_PREREQUISITE_ID]);
IF .mopt[DIUQ$K_NOTIFY]
THEN IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_NOTIFY,
.request_block[DIU$Z_NOTIFY]);
END; ! End of MODIFY command
[M_NEXT]: BEGIN ! NEXT command
IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_PRIORITY,63);
IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_AFTER,0);
IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_HOLDING,0);
END; ! End of NEXT command
[M_HOLD]: IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_HOLDING,1);
[M_RELEASE]: IP_MODIFY(.req[DIU$H_REQUEST_ID],DIUQ$K_HOLDING,0);
[INRANGE,OUTRANGE]: SIGNAL(DIU$_BUG); ! owie
TES; ! End of CASE
(.req_count) = ..req_count+1 ! Count the request as modified
END; ! MODREQ
%SBTTL 'Routine DIU$MMESSAGE'
GLOBAL ROUTINE DIU$MMESSAGE (primary,
secondary,
req: REF $DIU_BLOCK): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Print an error message related to a request block
!
! FORMAL PARAMETERS:
!
! primary: Primary error code
! secondary: Secondary error code
! req: Address of request block
!--
LOCAL addtext: $STR_DESCRIPTOR(CLASS=DYNAMIC);
$STR_DESC_INIT(DESC=addtext, CLASS=DYNAMIC);
! Build a description of the request into addtext
IF .req[DIU$H_REQUEST_ID] NEQ 0 ! Request number or all requests
THEN $STR_COPY(TARGET=addtext,
STRING=$STR_CONCAT('Request ',
$STR_ASCII(.req[DIU$H_REQUEST_ID])))
ELSE BEGIN
$STR_COPY(TARGET=addtext, ! No request number specified
STRING='All requests with');
IF .req[DIU$H_SOURCE_FILESPEC] NEQ 0 ! Was there a node name?
THEN $STR_APPEND(TARGET=addtext,
STRING=$STR_CONCAT(' node ',
$STR_FORMAT((.req[DIU$H_SOURCE_FILESPEC],
CH$PTR(req[DIU$T_SOURCE_FILESPEC])),
UP_CASE),
'::'));
END;
IF .req[DIU$H_USERNAME] NEQ 0 ! Was there a user name?
THEN $STR_APPEND(TARGET=addtext,
STRING=$STR_CONCAT(' user ',
$STR_FORMAT((.req[DIU$H_USERNAME],
CH$PTR(req[DIU$T_USERNAME])),
UP_CASE)));
IF .req[DIU$H_JOBNAME] NEQ 0 ! Was there a job name?
THEN $STR_APPEND(TARGET=addtext,
STRING=$STR_CONCAT(' job ',
$STR_FORMAT((.req[DIU$H_JOBNAME],
CH$PTR(req[DIU$T_JOBNAME])),
UP_CASE)));
%IF %SWITCHES(TOPS10) %THEN
IF .req[DIU$G_USER_NUMBER] NEQ 0
THEN $STR_APPEND(TARGET=addtext, ! Was there a PPN? [10,33]?
STRING=$STR_CONCAT(' [',
$STR_ASCII(.REQ[DIU$G_USER_NUMBER]^-18,
LEADING_BLANK, UNSIGNED, BASE8),
',',
$STR_ASCII(.REQ[DIU$G_USER_NUMBER] AND %O'777777',
LEADING_BLANK, UNSIGNED, BASE8),
']'))
%FI
! Get all of that turned into a error message, and print it out.
DIU$MESSAGE(.primary, .secondary, addtext, FALSE); ! Not to system log file
! Free memory and return
$XPO_FREE_MEM(STRING=addtext);
END;
END
ELUDOM