1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 03:15:54 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

446 lines
12 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
$SHOW(literals)
MACRO
crlf = %ASCIZ %CHAR(%O'15',%O'12') %, ![314]Cope with new MONSYM
crlf_pointer = CH$PTR(UPLIT(crlf)) %; ![314]
LITERAL
max_number_of_domains = 10, !Note: Increasing this field beyond 12
!requires changing the definition of
!the dom_gateway_flags...
max_local_user_length = 39,
max_domain_name_length = 39,
max_node_name_length = 39,
max_file_name_length = 4 * 39, ! this can be very long
max_string_length = 256;
$FIELD
work_request_fields =
SET
req_que_entry = [$SUB_BLOCK(q_entry_size)],
req_message_id = [$INTEGER],
req_domain_id = [$INTEGER],
req_destination_node = [$ADDRESS],
req_recipient_list = [$ADDRESS],
req_state = [$INTEGER],
req_time_stamp = [$INTEGER],
req_time_to_live = [$INTEGER],
req_state_specific_field = [$INTEGER]
TES;
LITERAL
work_request_size = $FIELD_SET_SIZE;
MACRO
work_request_block =
BLOCK [work_request_size] FIELD (work_request_fields) %;
MACRO
mx$get_work_request =
BEGIN
LOCAL
_req: REF work_request_block;
_req = nmu$memory_get(work_request_size);
time_current(0, _req[req_time_stamp]);
time_current($two_weeks, _req[req_time_to_live]);
._req
END %;
MACRO
mx$release_work_request(_adr) =
nmu$memory_release(_adr, work_request_size) %;
$FIELD
message_table_fields =
SET
msg_env_spec = [$ADDRESS], ! message envelope file spec
msg_fil_spec = [$ADDRESS], ! message file spec
msg_sender_string = [$ADDRESS], ! sender's name string
msg_work_req_list = [$ADDRESS], ! list of work requests
msg_err_list = [$ADDRESS], ! list of error strings
msg_work_req_count = [$SHORT_INTEGER], ! number of work requests
msg_msg_id = [$SHORT_INTEGER], ! message id
msg_state = [$SHORT_INTEGER], ! message state
msg_sender_domain = [$SHORT_INTEGER], ! sender's domain
msg_subject_string = [$ADDRESS], ! the subject string
msg_sender_pid = [$INTEGER], ! Sender's PID
msg_sender_uid = [$INTEGER], ! Sender's User Id
msg_sender_caps = [$INTEGER] ! Sender's capabilities
TES;
LITERAL
message_table_entry_size = $FIELD_SET_SIZE;
MACRO
message_table_entry =
BLOCK [message_table_entry_size] FIELD (message_table_fields) %;
MACRO
mx$get_message_table_entry =
BEGIN
LOCAL
_ent: REF message_table_entry;
_ent = nmu$memory_get(message_table_entry_size);
_ent[msg_work_req_count] = 0;
_ent[msg_msg_id] = nmu$table_insert(active_message_table, ._ent);
._ent
END %;
! Define a list block, used to link work requests to the message table entry,
! and to link destination string blocks to the work request.
$FIELD
list_block_fields =
SET
lst_next = [$ADDRESS], ! link to next list block
lst_data = [$ADDRESS], ! address of data block being linked
lst_xtra = [$ADDRESS], ! address of xtra data
lst_stat = [$short_integer] ! status bits used by DECNET servers.
TES;
LITERAL
list_block_size = $FIELD_SET_SIZE; ! size of the block
MACRO
list_blk = BLOCK [ list_block_size ] FIELD (list_block_fields) %;
MACRO
mx$get_list_blk =
nmu$memory_get(list_block_size) %;
$FIELD
rb_block_fields =
SET
rb_name_ptr = [$INTEGER],
rb_node_ptr = [$INTEGER],
rb_name_len = [$SHORT_INTEGER],
rb_node_len = [$SHORT_INTEGER],
rb_profile = [$ADDRESS]
TES;
LITERAL
rb_block_size = $FIELD_SET_SIZE;
MACRO
rb_block = BLOCK[rb_block_size] FIELD(rb_block_fields) %;
MACRO
mx$get_rb_block =
nmu$memory_get(rb_block_size) %;
FIELD
err_word_fields =
SET
err_cod = [0,0,9,0],
err_rec = [0,9,9,0]
TES;
LITERAL
err_word_size = 1;
MACRO
err_word = BLOCK[err_word_size] FIELD (err_word_fields) %;
MACRO
mx$get_err_word = nmu$memory_get(err_word_size) %;
LITERAL
mx$local = 0, ![314] Offset into NETTAB for the Local Domain
mx$decnet = 1; ![314] Offset into NETTAB for the Decnet Domain
$FIELD
domain_data_fields =
SET
dom_name = [$ADDRESS],
dom_validation = [$SHORT_INTEGER],
dom_spooler_task = [$ADDRESS],
dom_server_task = [$ADDRESS],
dom_init_file = [$ADDRESS],
dom_spooler_pid = [$INTEGER],
dom_server_pid = [$INTEGER],
$OVERLAY(dom_spooler_pid)
dcn_smtp_servers = [$INTEGER],
dcn_vm11_servers = [$INTEGER],
$CONTINUE
dom_spooler_queue = [$ADDRESS],
dom_node_table = [$ADDRESS],
dom_last_init_time = [$INTEGER],
dom_initialized_flag = [$BIT],
dom_suspended_flag = [$BIT],
dom_incoming_flag = [$BIT],
dom_outgoing_flag = [$BIT],
dom_log_incoming_flag = [$BIT],
dom_log_outgoing_flag = [$BIT],
dom_gateway_flags = [$BITS(3 * max_number_of_domains)]
TES;
LITERAL
domain_data_block_size = $FIELD_SET_SIZE;
MACRO
domain_data_block =
BLOCK [domain_data_block_size] FIELD (domain_data_fields) %;
! Define the message table entry states
$LITERAL
$msg_complete = $DISTINCT, ! message is ready for delivery
$msg_incomplete = $DISTINCT, ! message is pending further info
$msg_restart = $DISTINCT, ! finish delivery after error handling
$msg_canceled = $DISTINCT; ! stop delivery and handle errors
LITERAL
$msg_warning = $msg_restart;
$LITERAL
mp$decnet_hosts_format = $distinct,
mp$pmr = $distinct,
mp$synonym = $distinct;
$LITERAL
v_arpa = $DISTINCT,
v_decnet = $DISTINCT,
v_file = $DISTINCT,
v_pid = $DISTINCT;
LITERAL
min_valid = v_arpa,
max_valid = v_pid;
$LITERAL
$dcn_smtp = $DISTINCT,
$dcn_mail_11 = $DISTINCT;
LITERAL
$dcn_unknown = 0,
$dcn_max = $dcn_mail_11;
$LITERAL !Work request states
$send = $DISTINCT,
$done = $DISTINCT,
$defer = $DISTINCT,
$hold = $DISTINCT, !May be needed for "/AFTER:"
$reject = $DISTINCT;
LITERAL
min_request_type = $send,
max_request_type = $reject;
! Define the types of destinations
$LITERAL
mbx_list = $DISTINCT, ! mailing list
mbx_serv = $DISTINCT, ! mailbox service
mbx_user = $DISTINCT; ! local user
LITERAL
$local = 0,
$two_weeks = 60 * 60 * 24 * 14, !Number of seconds in two weeks...
$two_minutes = 60*2,
$five_minutes = 60*5;
! Macro: $mx$change_state
! This macro changes the state of a work request and requeues it to the
! work-queue.
!
! NTRY: The address of the work-request's queue entry.
!
! STATE: One of the following: <nothing>,$SEND,$DONE,$REJECT,$DEFER,$DONE
!
! A value for the state-specific field may be specified if necessary
MACRO
$mx$change_state( _req_, _state_) =
BEGIN
BIND
_req = _req_: work_request_block;
%IF NOT %NULL(%REMAINING)
%THEN
_req [req_state_specific_field] = %REMAINING;
%FI
%IF NOT %NULL(_state_)
%THEN
_req [req_state] = _state_;
%FI
nmu$squeue_insert(work_queue, _req);
END %;
MACRO
MX$FATAL(str) =
%IF %SWITCHES(TOPS20) %THEN
BEGIN
DECLARE_JSYS(psout, haltf);
$$psout(crlf_pointer); ![314]
$$psout(UPLIT(%ASCIZ %STRING('?',str)));
$$haltf();
END
%ELSE
! %WARN('MX$FATAL not implemented for this OS')
BEGIN
BUILTIN UUO;
TASK_INFO(str);
UUO(0,EXIT(1));
END
%FI %;
MACRO
$trace(arg)[] =
%IF %VARIANT EQL 1 %THEN $trace_always(arg,%remaining) %FI %;
MACRO
$trace_always(a)[] =
BEGIN
%IF NOT %DECLARED(log) %THEN EXTERNAL ROUTINE log: NOVALUE; %FI
%IF %NULL(%REMAINING) %THEN log( UPLIT(%ASCIZ a) )
%ELSE
BEGIN
LOCAL
$TPTR;
STACKLOCAL
$TBUF: VECTOR[CH$ALLOCATION(max_string_length)];
$tptr = CH$PTR($tbuf);
$nmu$text($tptr,max_string_length,a,%REMAINING);
log($tbuf)
END %FI
END %;
!Switch values used in MXHOST and MXDCNT and MXDATA
$LITERAL
$invalid = $distinct,
$strip = $distinct,
$minsw = $invalid,
$maxsw = $strip;
!Network macros used in MXHOST and MXDATA
MACRO
ASK_MONITOR(net, nd) =
%IF %IDENTICAL(net, ARPA)
%THEN
%IF %SWITCHES(TOPS20)
%THEN
BEGIN !Tops-20/ARPA conditional
DECLARE_JSYS(GTHST);
REGISTER
D = 4;
IF $$gthst($gthsn,nd) !Is host known?
THEN !-Yes
IF (.d AND hs_srv) NEQ 0 !-Is it a SERVER?
THEN
1 !--Yes, valid
ELSE
0 !--No, invalid
ELSE
0 !-No, not known. Invalid
END
%ELSE 0
%FI !End TOPS-10/20 ARPA conditional
%ELSE
%IF %IDENTICAL(net, DECNET)
%THEN
%IF %SWITCHES(TOPS20)
%THEN
BEGIN
STACKLOCAL
arg: VECTOR[2];
declare_jsys(node);
arg[0] = nd;
IF $$node($ndvfy, arg) !Do we know about it?
THEN
IF (.arg[1] AND nd_exm) NEQ 0
THEN
1 !-Yes
ELSE
0
ELSE
0
END
%ELSE
! %WARN('"ASK_MONITOR" not yet implemented for TOPS10')
BEGIN
BUILTIN UUO;
REGISTER t;
LOCAL
p;
STACKLOCAL
nodblk: VECTOR[3];
t = 0;
p = nd;
WHILE CH$RCHAR_A(p) NEQ 0 DO !count the characters
t = .t + 1;
CH$TRANSLATE(sx_tab,
.t,nd,
0,
6,CH$PTR(nodblk[$dnnam],0,6));
nodblk = ($dnndi ^ 18) + 3 + dn$flk;
t = nodblk;
IF UUO(1,dnet$(t))
THEN
$true
ELSE
(.t EQL 8) !true if node is out of area
END
%FI !End of TOPS10/20 DECNET conditional
%ELSE
%ERROR('Unimplimented "ASK_MONITOR" function - ', net)
%FI !End %if DECNET
%FI !End %if ARPA
%; !End of ASK_MONITOR macro
MACRO
expand_table(tb, percent) =
BEGIN
LOCAL
new_table: REF tbl,
new_table_size;
new_table_size = (.tb[TBL_MAXIMUM_ENTRIES] +
((.tb[TBL_MAXIMUM_ENTRIES] * percent) / 100)) + 1;
new_table = nmu$memory_get(.new_table_size);
IF .new_table EQL 0
THEN
0
ELSE
BEGIN
new_table[TBL_ACTUAL_ENTRIES] = .tb[TBL_ACTUAL_ENTRIES];
new_table[TBL_MAXIMUM_ENTRIES] = .new_table_size - 1;
INCR i FROM 1 TO .tb[TBL_MAXIMUM_ENTRIES] DO
(.new_table + .i) = .(.tb + .i);
nmu$memory_release(.tb, .tb[TBL_MAXIMUM_ENTRIES] + 1);
tb = .new_table;
1
END
END %;
!
! EQUATED SYMBOLS:
!
LITERAL
def_table_size = 200;