Trailing-Edge
-
PDP-10 Archives
-
cuspjul86upd_bb-jf24a-bb
-
10,7/decmai/mx/mxhost.bli
There are 7 other files named mxhost.bli in the archive. Click here to see a list.
MODULE MXHOST =
BEGIN
!
! COPYRIGHT (c) 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: Decmail/MS - Message eXchange Host File Parsing Routines
!
! ABSTRACT: This module contains routines to parse files containing
! host/routing information. At present, the only file format understood is
! the one used by the DECNET-HOSTS.TXT file.
!
! ENVIRONMENT: Tops-10/Tops-20
!
! AUTHOR: Richard B. Waddington, CREATION DATE: 18-February, 1985
!
! MODIFIED BY:
!
! MX: VERSION 1.0
! 01 -
!--
!
! INCLUDE FILES:
!
%IF %SWITCHES(TOPS20) %THEN
LIBRARY 'monsym';
UNDECLARE time;
LIBRARY 'mxjlnk';
%FI
LIBRARY 'mxnlib'; ! Our version of NML's utility library
LIBRARY 'mxlib';
LIBRARY 'tbl';
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
mx$parse_host_file,
parse_line,
ptext,
get_key,
get_data,
loop_check;
!
! MACROS:
!
MACRO parse_block =
VECTOR[2] INITIAL(0,0) %,
parse_blk =
VECTOR[] %;
!
! EQUATED SYMBOLS:
!
LITERAL
txt_ptr = 0,
txt_cnt = 1;
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL
uc_tab, !Upper case conversion table
nodnam;
EXTERNAL ROUTINE
tbl_lookup,
tbl_add,
nmu$text_manager,
nmu$memory_manager,
nmu$sched_manager,
mx$release_asciz,
mx$file_routines,
mx$error_routines,
mx$database_routines;
%global_routine('MX$PARSE_HOST_FILE', fil_ptr, tab_, format): = !
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine uses .FIL_PTR as the file spec of the file containing host
! name/routing information, and parses that file. The information contained
! in the file is added to the TBLUK table using calls to the MX$DATA_ADD_NODE
! routine.
!
! FORMAL PARAMETERS:
!
! FIL_PTR: A CH$PTR to an asciz filespec.
!
! TAB: An address containing the address of a TBLUK table.
!
! FORMAT: An integer value which determines which file format to use.
! The following formats are defined:
!
! 1: DECNET-HOSTS.TXT file format
! Others are undefined.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The TBLUK table gets updated and, in fact, a new larger table may be
! allocated if necessary. Consequently the table address may change.
!
! ROUTINE VALUE:
!
! 1 If successful, 0 otherwise
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND
tab = .tab_: tbl;
STACKLOCAL
buf: VECTOR[CH$ALLOCATION(132)];
LOCAL
len,
fid,
line,
error,
data_block,
ndex,
pause_flag,
node;
IF .format NEQ mp$decnet_hosts_format
THEN
RETURN $error( CODE=mp$uhf, !Unsupported format
SEVERITY=$severe,
FACILITY=$internal);
pause_flag = .tab[TBL_ACTUAL_ENTRIES] NEQ 0;
fid = mx$file_open(.fil_ptr, file_access_read_only, error);
IF .fid LEQ 0
THEN
BEGIN
%IF %SWITCHES(TOPS20) %THEN IF .error EQL uf$fnf
%ELSE IF .error EQL uf$fpe %FI
THEN
RETURN $true;
$error( CODE=uf$fof, !File open error
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.fil_ptr,
OPTIONAL_MESSAGE=$error_code,
OPTIONAL_DATA=.error);
RETURN 2
END;
line = 0;
WHILE (len = mx$file_read(.fid, CH$PTR(buf), 132, error)) GTR 0 DO
BEGIN
node = 0;
line = .line + 1;
IF .pause_flag
THEN
nmu$sched_pause();
IF NOT parse_line(CH$PTR(buf), format, node, data_block)
THEN
$error( CODE=mp$syn, !Syntax error in file
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=(.line, .fil_ptr));
IF .node GTR 0
THEN
BEGIN
MX$DATA_ADD_NODE(tab, .node, ndex, .data_block);
mx$release_asciz(.node);
END
END;
IF .len NEQ 0
THEN
$error( CODE=uf$frf, !File read error
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.fil_ptr,
OPTIONAL_MESSAGE=$error_code,
OPTIONAL_DATA=.error);
MX$FILE_CLOSE(.fid, file_abort, error);
RETURN 1
END; !End of TEMP_EXAMPLE
%routine('PARSE_LINE', ptr, format, node_, data_) = !
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine parses a line from a host-name file. FORMAT is used to
! determine the format of the file. Initially, there will be only one
! format, that used in DECNET-HOSTS.TXT. Eventually other formats may be
! added.
!
! FORMAL PARAMETERS:
!
! PTR: A CH$PTR to the line of text in memory to be parsed.
!
! FORMAT: 1 - DECNET-HOSTS.TXT format. Others are undefined.
!
! NODE: The address to return the address of the node-name in.
!
! DATA: The address to return the address of the PMR/synonym block
! in.
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND
node = .node_,
data = .data_;
LOCAL
ch,
key,
nptr,
ncnt,
bptr,
eptr,
len,
idx,
key_block: parse_block,
pmr_block: parse_block;
GLOBAL
buf: VECTOR[CH$ALLOCATION(132)];
STACKLOCAL
loops: TBLUK_TABLE(10); !Use with loop_check ONLY.
STACKLOCAL
swtchs: tbluk_table(0,
'INVALID',$invalid,(),
'STRIP-QUOTES',$strip,()
);
bptr = CH$PTR(buf);
data = len = 0;
ch = ptext(ptr, key_block);
SELECTONE .ch OF
SET
[%C',']:
BEGIN
ch = ptext(ptr, pmr_block);
IF .ch EQL %C':'
THEN
BEGIN
WHILE $true DO
IF loop_check(loops,pmr_block)
THEN
BEGIN
nptr = .pmr_block[txt_ptr];
ncnt = .pmr_block[txt_cnt];
ptr = CH$PLUS(.ptr, 1);
ch = ptext(ptr, pmr_block);
SELECTONE .ch OF
SET
[%C';', %C'!', %O'15', 0]:
EXITLOOP;
[%C':']:
BEGIN
CH$WCHAR_A(%C'@', bptr);
bptr = CH$MOVE(.ncnt, .nptr, .bptr);
CH$WCHAR_A(%C',', bptr);
len = .len + .ncnt + 2;
END;
[OTHERWISE]:
RETURN $error( CODE=mp$tel,
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.ptr);
TES;
END
ELSE
BEGIN
loop_check(loops,0);
RETURN $error( CODE=mp$pld,
FACILITY=$internal,
SEVERITY=$warning,
MESSAGE_DATA=.pmr_block[txt_ptr]);
END;
CH$COPY(4,CH$PTR(UPLIT(':%A@')),
.ncnt,.nptr,
0,
4+1+.ncnt, CH$PTR(buf, .len-1));
data = get_data(CH$PTR(buf), .len+.ncnt+3, mp$pmr);
END
ELSE
RETURN $error( CODE=mp$tel,
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.ptr);
END;
[%C'/']:
BEGIN
ptext(ptr,pmr_block);
CH$WCHAR(0,
CH$MOVE(.pmr_block[txt_cnt], .pmr_block[txt_ptr], .bptr));
IF NOT tbl_lookup(swtchs, .bptr, idx)
THEN
RETURN $error( CODE=mp$tel,
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.pmr_block[txt_ptr]);
!Assuming that the switch is /INVALID or /STRIP-QUOTES...
data = .swtchs[.idx, TBL_DATA];
END;
[%C';', %C'!', %O'15', 0]:;
[OTHERWISE]:
RETURN $error( CODE=mp$tel,
SEVERITY=$warning,
FACILITY=$internal,
MESSAGE_DATA=.ptr);
TES;
IF .key_block[txt_cnt] EQL 0
THEN !The line had no key
IF .pmr_block[txt_cnt] GTR 0
THEN
RETURN $error( CODE=mp$mkf, !Missing key field
SEVERITY=$warning,
FACILITY=$internal)
ELSE
RETURN 1; !Line was blank or comment
node = GET_KEY(key_block);
loop_check(loops,0);
RETURN 1;
END; !End of TEMP_EXAMPLE
%routine('LOOP_CHECK',table_, node_) =
BEGIN
BIND
table = .table_: TBL,
node = .node_: parse_blk;
LOCAL
key,
ndx;
IF .table[TBL_ACTUAL_ENTRIES] EQL 0
THEN
tbl_add(table,nodnam,ndx,0);
IF node NEQ 0
THEN
BEGIN
key = nmu$memory_get(CH$ALLOCATION(.node[txt_cnt]+1));
CH$COPY(.node[txt_cnt],.node[txt_ptr],
0,
.node[txt_cnt]+1,CH$PTR(.key));
RETURN tbl_add(table,.key,ndx,CH$ALLOCATION(.node[txt_cnt]+1));
END
ELSE
BEGIN
INCR i FROM 1 TO .table[TBL_ACTUAL_ENTRIES] DO
IF .table[.i,TBL_DATA] NEQ 0
THEN
nmu$memory_release(.table[.i,TBL_KEY],.table[.i,TBL_DATA]);
table[TBL_ACTUAL_ENTRIES] = 0;
END;
RETURN 0
END;
%routine('PTEXT', p_, blk_) = !
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine parses text. The pointer is advanced until either a
! comma, a "=", a ";", a "!", a CR, or a 0 is seen. Spaces, tabs, and
! switches will delimit the text, but will otherwise be ignored. A count of
! the characters in the text and a CH$PTR to the beginning of the text are
! returned in the parse block.
!
! FORMAL PARAMETERS:
!
! P: The address of a CH$PTR pointing to the beginning of the switch
! BLK: The address of a parse_block.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! The terminator
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND
p = .p_,
blk = .blk_: VECTOR[2];
LOCAL
start_flag: INITIAL(0),
end_flag: INITIAL(0),
cnt: INITIAL(0);
blk[txt_cnt] = 0;
WHILE 1 DO
BEGIN
SELECTONE CH$RCHAR(.p) OF
SET
[%C' ',%C' ']: IF .start_flag THEN end_flag = 1;
[%C':', %C',', %C'!', %C'=', %C'/',
%C';', %o'0', %O'15']: EXITLOOP;
[OTHERWISE]: BEGIN
IF .start_flag EQL 0
THEN
BEGIN
start_flag = 1;
blk[txt_ptr] = .p;
END;
IF NOT .end_flag
THEN
blk[txt_cnt] = .blk[txt_cnt] + 1;
END;
TES;
p = CH$PLUS(.p, 1);
END;
RETURN CH$RCHAR_A(p);
END; !End of PTEXT
%ROUTINE('GET_KEY', blk_) = !
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine gets memory for the key string, copys the key string, and
! returns the address of the key string to the caller.
!
! FORMAL PARAMETERS:
!
! P: The address the key's parse block.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND
blk = .blk_: VECTOR[2];
LOCAL
b;
b = nmu$memory_get(CH$ALLOCATION(.blk[txt_cnt] + 1));
IF .b NEQ 0
THEN
CH$COPY(.blk[txt_cnt], .blk[txt_ptr],
0,
.blk[txt_cnt] + 1, CH$PTR(.b));
RETURN .b
END; !End of GET_KEY
%ROUTINE('GET_DATA', ptr, len, typ) = !
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine gets memory for the data header, and the data string. It
! sets up the data header and returns the address of the data header to the
! caller.
!
! FORMAL PARAMETERS:
!
! PBLK: The address of the pmr string's parse block.
! SBLK: The address of the synonym's parse block.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL
h: REF list_blk,
b;
IF .len LEQ 0
THEN
RETURN 0;
h = nmu$memory_get(list_block_size);
IF .h NEQ 0
THEN
BEGIN
h[lst_stat] = .typ;
h[lst_data] = b = nmu$memory_get(CH$ALLOCATION(.len + 1));
IF .b NEQ 0
THEN
CH$COPY(.len, .ptr,
0,
.len + 1, CH$PTR(.b));
END;
RETURN .h;
END; !End of GET_DATA
END !End of module MXHOST
ELUDOM