Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/diushd.b36
There are 4 other files named diushd.b36 in the archive. Click here to see a list.
%TITLE 'DIU Show Defaults Routine'
MODULE DIUSHD (IDENT = '252',
LANGUAGE(BLISS36),
ENTRY(SHODEF)
) =
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 Data Interchange Utility
!
! ENVIRONMENT: TOPS-20 V6.1 XPORT
! BLISS-36 V4 FAO-36
!
! ABSTRACT: This module contains the routine needed to show the DIU
! defaults chain.
!
! AUTHOR: Rick Fricchione CREATED: 21-Feb-1985
! HISTORY:
!
! 252 Remove library of CONDIT.
! Sandy Clemens 1-Jul-86
!
! 252 Target string for wild match wasn't made ASCIZ, causing SHOW DEFAULTS
! node:: to work strangely.
! Gregory A. Scott 7-Jun-86
!
! 174 Remove library of TOPS20.
! Gregory A. Scott 20-May-86
!
! 164 Rename D$SHDF to SHODEF and don't accept an unused third argument.
! Using RMS for terminal IO was causing us problems here too, so don't do
! it anymore here.
! Gregory A. Scott 16-May-86
!
! 131 Remove external of diudbg which wasn't referenced and is no longer
! used.
! Gregory A. Scott 28-Apr-86
!
! 117 Make room for the entire 39 character username and account to be
! displayed. Repair display of "queued" default. Adjust columns.
! Gregory A. Scott 17-Apr-86
!
! 102 Conform SHOW DEFAULTS to make it like show queue (i.e. no version
! output and time and date on same line).
! Gregory A. Scott 27-Mar-86
!
! 100 Get version number from .JBVER and print via FAO's !V.
! Gregory A. Scott 26-Mar-86
!
! 50 Clean up SHOW DEFAULTS (again).
! Sandy Clemens 4-Nov-85
!
! 40 Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
! conditional.
! Sandy Clemens 7-Oct-85
!
! SC00002 V01-000 Sandy Clemens 20-Sept-1985
! Fix bug in clearing (zeroing) buffers with CH$FILL.
!
! RDF0001 V01-000 Rick Fricchione 21-Feb-1985
! Original version of D$SHDF. Convert from VAX DIU
! version (DIU$SHO_DEFAULTS).
!
!--
!************************************************************************
! L I B R A R I E S
!************************************************************************
! Libraries
LIBRARY 'BLI:XPORT'; ! XPORT of course
LIBRARY 'FAO'; ! FAO services
LIBRARY 'DIU'; ! DIU Data Structures
! Externals
EXTERNAL tty : $XPO_IOB(); ! IOB for the TTY
EXTERNAL ROUTINE wild_match; ! Wild match routine
!******************************************************************
! F A O O U T P U T
!******************************************************************
LITERAL fao_buf_len = 160; ! fao_buf size in bytes
OWN fao_desc : $STR_DESCRIPTOR(CLASS=BOUNDED),
fao_buf : VECTOR[CH$ALLOCATION(fao_buf_len)];
! Macro to print a FAOized string to the terminal
MACRO $put_fao (control) =
BEGIN
LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=%STRING(control,%CHAR(13,10)));
$STR_DESC_INIT(DESC=fao_desc, ! Re-init the buffer
CLASS=BOUNDED,
STRING=(fao_buf_len,CH$PTR(fao_buf)));
$FAO(fao_ctl,0,fao_desc,%REMAINING); ! Format string
$XPO_PUT(IOB=tty, ! Slurp to terminal
STRING=fao_desc);
END %;
! Own strings are for output below
OWN defer : VECTOR[4] INITIAL(CH$PTR(UPLIT(%ASCIZ'No')),
CH$PTR(UPLIT(%ASCIZ'Yes')),
CH$PTR(UPLIT(%ASCIZ'Conditional'))),
notify : VECTOR[5] INITIAL(CH$PTR(UPLIT(%ASCIZ'None')),
CH$PTR(UPLIT(%ASCIZ'Terminal')),
CH$PTR(UPLIT(%ASCIZ'Mail')),
CH$PTR(UPLIT(%ASCIZ'IPCF')));
LITERAL notify_max = 3;
!******************************************************************
! S H O _ N O D E
!******************************************************************
ROUTINE SHO_NODE (default : REF $DEF_DECL,
default_seen) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine dumps the default block given to the terminal.
!
! FORMAL PARAMETERS
!
! default - Address of default node
! default_seen - flag indicating that we have been called once
!
! IMPLICIT PARAMETERS
!
! All of the OWN storage at the module level.
!
!--
BIND nodespec = default[DEF$D_NODE] : $STR_DESCRIPTOR(),
user = default[DEF$D_USER] : $STR_DESCRIPTOR(),
account = default[DEF$D_ACCOUNT] : $STR_DESCRIPTOR(),
password = default[DEF$D_PASSWORD] : $STR_DESCRIPTOR(),
log_file = default[DEF$D_LOG] : $STR_DESCRIPTOR();
$TRACE('SHO_NODE');
! Print the banner but once...
IF NOT .default_seen
THEN $PUT_FAO('!/!AZ!2(_)!%D!/Session Defaults Display!/',
diu$$system_banner,0);
! Print the username, or tell them none specified or we will prompt for it soon
! For some reason the compiler thinks nodespec as an initial value means 0.
IF $STR_EQL(STRING1=user,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!10<!AS::!>Username: <prompt>',nodespec)
ELSE IF .user[STR$H_LENGTH] NEQ 0
THEN $PUT_FAO('!10<!AS::!>Username: !AS',nodespec,user)
ELSE $PUT_FAO('!10<!AS::!>Username: <none specified>',nodespec);
! Tell me the account if you know it, or at least if you are prompting for one
IF $STR_EQL(STRING1=account,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!_ Account: <prompt>')
ELSE IF .account[STR$H_LENGTH] NEQ 0
THEN $PUT_FAO('!_ Account: !AS',account)
ELSE $PUT_FAO('!_ Account: <none specified>');
! Tell me about the password; are you prompting, none specified, or do you know
IF $STR_EQL(STRING1=password,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!_ Password: <prompt>')
ELSE IF .password[STR$H_LENGTH] NEQ 0
THEN $PUT_FAO('!_ Password: <specified>')
ELSE $PUT_FAO('!_ Password: <none specified>');
! Now please tell him about the defaut log file for this request.
IF .log_file[STR$H_LENGTH] NEQ 0
THEN $PUT_FAO('!_ Log File: !AS',log_file)
ELSE $PUT_FAO('!_ Log File: <none specified>');
! Next tell the guy about the default notification method and queueing default.
IF .default[DEF$B_NOTIFY] GTR notify_max THEN SIGNAL(DIU$_BUG);
$PUT_FAO('!_ Notify: !16AZ!_Queued: !AZ',
.notify[.default[DEF$B_NOTIFY]],
.defer[.default[DEF$B_DEFER]]);
! Print a blank line, free that memory and then return.
$PUT_FAO(' ');
END; ! SHO_NODE
!******************************************************************
! S H O D E F
!******************************************************************
GLOBAL ROUTINE SHODEF(p_root, p_node) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! List on the terminal the default table entries. The passed root
! address is the start of the default chain. The passed node is the
! address of a ASCIZ string that is to be matched for the listing. The
! output always goes to the terminal.
!
! FORMAL PARAMETERS:
!
! root: Address of defaults root list.
! node: Address of ASCIZ node spec (possibly wild).
!
! ROUTINE VALUE
!
! DIU$_NORMAL: successful display of request block
!
!--
BIND default_root = .p_root : $DEF_DECL,
node = .p_node;
LOCAL flag : INITIAL(0),
target : VECTOR[CH$ALLOCATION(10)],
wild_desc : REF $STR_DESCRIPTOR(),
default : REF $DEF_DECL;
! Point to head of chain, zero buffer
default = default_root;
CH$FILL(0,10,CH$PTR(target));
! Set up for wildcard match
$TRACE_FAO('SHODEF pattern given is !AZ',CH$PTR(node));
! Loop through the node table and display whatever matches.
DO BEGIN
BIND wild_desc = default[DEF$D_NODE] : $STR_DESCRIPTOR();
CH$COPY(.wild_desc[STR$H_LENGTH],.wild_desc[STR$A_POINTER], ! Source
0, ! Fill 0
10,CH$PTR(target)); ! Destination
$TRACE_FAO('SHODEF Comparing pattern with !AZ', CH$PTR(target));
IF WILD_MATCH(CH$PTR(node),CH$PTR(target))
THEN BEGIN
SHO_NODE(.default,.flag);
flag = true;
END;
END UNTIL (default = .default[DEF$A_NXT]) EQL 0;
! Print message if nothing matched.
IF NOT .flag
THEN $PUT_FAO('?DIU command error: No defaults match node "!AZ"',CH$PTR(node));
END; ! SHODEF
END
ELUDOM