prime tdl entry point
try_assign:
if tdl.train_number = -2
/* duplicate trains--must ask */
pnum = substr(page_no_char,tdl.pageno,1);
call ioa_$rsnnl("^/^/**^a(^ac) duplicate trains configured^/enter train # to use:",
message,mesg_len,pnum,tdl.iccdd);
tdl.optrd = 1;
tdl.rtnopt = try_
goto request_and_wait_for_tty_
tdl.tdlret =
tape_info_ptr = addr(rcp_area);
tape_info.version_num = 1;
/* structure version 1 */
tape_info.usage_time = 0;
/* T&D will use resource for an indefinite time */
tape_info.wait_time = 0;
/* T&D will not wait for the resource */
tape_info.system_flag = "0"b;
/* T&D is not a system process */
tape_info.tracks = 0;
tape_info.device_name = tdl.device_
if substr(tdl.device_name,1,3) = "dsk"
disk_info_ptr = addr(rcp_area);
rcp_name = "disk";
disk_info.volume_name = string("t&d scratch");
disk_info.write_flag = "1"b;
disk_info.version_num = 1;
/* structure version 1 */
disk_info.usage_time = 0;
/* T&D will use resource for an indefinite time */
disk_info.wait_time = 0;
/* T&D will not wait for the resource */
disk_info.system_flag = "0"b;
/* T&D is not a system process */
disk_info.device_name = string(tdl.device_name);
if substr(tdl.device_name,1,3) = "tap"
rcp_name = "tape";
tape_info.volume_name = string("scratch");
tape_info.write_flag = "1"b;
if substr(tdl.device_name,1,3) = "prt" then rcp_name = "printer";
if substr(tdl.device_name,1,3) = "pun" then rcp_name = "punch";
if substr(tdl.device_name,1,3) = "rdr" then rcp_name = "reader";
if substr(tdl.device_name,1,3) = "opc" then rcp_name = "console";
attach_loop:
if rcp_name = "disk" then
call rcp_priv_$attach(string
(rcp_name),disk_info_ptr,tdl.status_event,"T&D is attaching
"||tdl.device_name,
tdl.rcp_id,error);
call rcp_priv_$attach(string
(rcp_name),tape_info_ptr,tdl.status_event,"T&D is attaching
"||tdl.device_name,
tdl.rcp_id,error);
if error = 0 then goto attach_
call com_err_$convert_status_code_(error,shortinfo,longinfo);
call ioa_$rsnnl("^/ioi_assign error--couldnt find^/^a"
,term_reason,output_length,longinfo);
call set_polts_abort(term_reason);
goto main_dispatch_queue_
attach_ok:
if tdl.allocated ^=0 then goto main_dispatch_queue_
/* dont try if assigned already--CISL BUGGGGG */
if tdl.stop ^= 0
tdl.force = 1;
goto alloc_end_
tdl.lst,tdl.trycnt = -1;
attempt to assign the per. if not busy */
call assign(tdp,tip,tdl.asgn_flag);
tdl.io_dispatch = attach_
/* for code 1 and 2 */
if tdl.asgn_flag = 4|tdl.asgn_flag = 1|tdl.asgn_flag = 2 then if tdl.nxt = 0
pnum = substr(page_no_char,tdl.pageno,1);
if tdl.asgn_flag = 4 then call ioa_$rsnnl("^/^/**^a(^ac) device busy--allocation queued",
message,mesg_len,pnum,tdl.iccdd);
if tdl.asgn_flag = 1 then call ioa_$rsnnl("^/^/**^a(^ac) short wait for device--allocation queued",
message,mesg_len,pnum,tdl.iccdd);
if tdl.asgn_flag = 2 then call ioa_$rsnnl("^/^/**^a(^ac) long wait for device--allocation queued",
message,mesg_len,pnum,tdl.iccdd);
tdl.ttyret = busy_
tdl.nxt = -1;
goto request_and_wait_for_tty_
busy_said:
tdl.nxt = -1;
if tdl.stop ^= 0
tdl.force = 1;
goto alloc_end_
if tdl.asgn_flag = 0 then goto init_
if tdl.asgn_flag = 1|tdl.asgn_flag = 2|tdl.asgn_flag = 3 |tdl.asgn_flag = 7
tdl.asgn_flag = 7;
goto main_dispatch_queue_
/* short wait---long wait--or assign error
tdl.clock_dispatch = attach_
tdl.clock_going = 1;
/* set clock going */
call timer_manager_$alarm_wakeup("b,tdl.clock_event);
time is in micro seconds
1000000 = 1 sec
goto main_dispatch_queue_ /* go away untill called */
init_alloc:
tdl.allocated = 1;
goto select_next_test_or_seg_or_start_or_
/*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*/
isolate current tdl instruction
tdl.tdlret = eoline_do_
eoline_do_return:
if tst.linetab(tdl.line_number+2) ^= 0
inv_data = "end of line sequencing would proceed on a non-tdl line";
goto say_invalid_
tdl.line_number = tdl.line_number + 1;
if isol_flag = 1 then goto isol_
if isol_flag = 0
call look_up_
call bump_per_op_number_if_per_
tdl.next_field_number,tdl.per_op_number = 0;
do dovar3 = 1 to skip_field_
if isol_flag = 0
if isol_flag = 1 then goto isol_
call look_up_
call bump_per_op_number_if_per_
if tst.linetab(tdl.line_number+1) ^= 0
term_message = "
tdl implimentation error-non tdl line at ""nxlin""";
call set_polts_abort(term_message);
goto main_dispatch_queue_
/* go to common code */
tdl.tlscan = (tdl.line_number*56)+1;
tdl.next_field_number,tdl.per_op_number = 0;
if tdl.tmiflg = 0 then goto skip_
tdl.tdlret = skip_
/* set do return
if isol_flag = 2 then goto isol_
if isol_flag = 0
isolation error--->6 alpha,>12 numbers
inv_data = "> 6 alpha or >12 numbers";
goto say_invalid_
go to selected tdl routine
bump_per_op_number_if_per_op:
if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),3,1) ="1"b then
tdl.per_op_number = tdl.per_op_number + 1; /* bump per op on line */
end bump_per_op_number_if_per_
look_up_mnemonic:
do dovar1 = 1 to inst$tlen/2 by 2;
if tdl.talpha = inst$tdli(dovar1)
inv_data = "unknown mnemonic";
goto say_invalid_
end look_up_
call look_up_
format of instruction type field
type field = bits 24 thru 29
bit 24 = not defined
bit 25 = not defined
bit 26 = perif operation(wtb,aop,dup,cmp,sa)
bit 27 = perform "do" first
bit 28 = right justification required
bit 29 = octal conversion if 1, dec if 0
tdl.inst_index = dovar1;
if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),4,1) ^="1"b then goto no_
tdl.tdlret = do_
do_return:
dovar1 = tdl.inst_
perform required numeric conversion
Numeric conversion for a tdl instruction is under
the control of an instruction defining word associated
with each tdl instruction.
This word has the format of:
vfd 6/nd1,6/nd2,6/nd3,6/ovd4,6/type,6/con
type = the type field defined above
The count of the numeric characters isolated in the
instruction must be >= nd1+nd2+nd3 and must be
tdl.tnmwrd
inv_data = "insufficient fixed numerics";
goto say_invalid_
if inst$tdlr_num_conv_control((dovar1-1)*12+19)+
inst$tdlr_num_conv_control((dovar1-1)*12+20)+
inst$tdlr_num_conv_control((dovar1-1)*12+21)+
inst$tdlr_num_conv_control((dovar1-1)*12+22) < tdl.tnmwrd
inv_data = "more numerics than defined for instruction";
goto say_invalid_
fdec1,fdec2,fdec3,vdec4,octnum = 0;
if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),6,1)
="1"b then goto octal_
vdec4 = inst$tdlr_num_conv_control((dovar1-1)*12+19)+
inst$tdlr_num_conv_control((dovar1-1)*12+20)+
inst$tdlr_num_conv_control((dovar1-1)*12+21)+1;
vdec4 = fixed(substr(tdl.tnmbr,vdec4));
fdec1 = fixed(substr(tdl.tnmbr,1,inst$tdlr_num_conv_control((dovar1-1)*12+19)));
fdec2 = fixed(substr(tdl.tnmbr,inst$tdlr_num_conv_control((dovar1-1)*12+19)+1,
inst$tdlr_num_conv_control((dovar1-1)*12+20)));
fdec3 = fixed(substr(tdl.tnmbr,inst$tdlr_num_conv_control((dovar1-1)*12+19)+
inst$tdlr_num_conv_control((dovar1-1)*12+20)+1,
inst$tdlr_num_conv_control((dovar1-1)*12+21)));
goto num_conv_
octal_conversion:
if tdl.tnmwrd = 0 then goto num_conv_
if search(tdl.tnmbr,"89") ^=0
inv_data ="only octal numerics allowed";
goto say_invalid_
do dovar3 = 1 to 12;
if tdl.tnmwrd <dovar3 then goto left_
octnum = octnum*8 + binary(substr(tdl.tnmbr,dovar3,1));
goto justify_
left_justify:
if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),5,1) ="1"b then goto num_conv_
octnum = octnum*8;
justify_done:
num_conv_done:
tdl.tdlret =
set to go to nxfld
if pdata.simulation = 0 then goto no_
inst$tdlr_no((dovar1-1)*4+5)= mod(inst$tdlr_no((dovar1-1)*4+5)+1,65536);
/* bump usage count so we can check instruction usage
goto tdlr(inst$tdlr_no((dovar1-1)*4+6));
say_end_page:
tdl.cyccnt = tdl.cyccnt + 1;
alloc_end_page:
pnum = substr(page_no_char,tdl.pageno,1);
page_term = "normal";
if tdl.force ^=0 then page_term = "forced";
call ioa_$rsnnl("^/^/**^a(^ac) ^a term ^d: ^d status and ^d data errors"
,message,mesg_len,pnum,tdl.iccdd,page_term,tdl.cyccnt,tdl.toterr.sta,
tdl.toterr.dat);
if (tdl.tottrn.read ^=0)|(tdl.tottrn.write ^=0)
call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
message,mesg_len,(message),tdl.tottrn.read,tdl.tottrn.write);
tdl.ttyret = remove_
tdl.end = 1;
request_and_wait_for_tty_write:
tdl.iocnt = tdl.iocnt + 1; /* bump test pages i/o count
call buffer_tty_output(message,tdl.pageno);
goto main_dispatch_queue_
go back to common code */
isolate current tdl instruction
tdl.topfld = tdl.next_field_
/* will be this field number */
isol_flag = 0; /* preset for end of line */
dovar1 = 1; /* and count also */
if lines(tdl.tlscan) = " " then goto isol_er_
if lines(tdl.tlscan) = "," then goto isol_er_
tdl.tnmbr = "";
tdl.talpha = "";
tdl.next_field_number = tdl.next_field_number + 1;
do dovar1 = 1 to 19;
if lines(tdl.tlscan+dovar1-1) = " " then goto break_
if lines(tdl.tlscan+dovar1-1) = "," then goto break_
if lines(tdl.tlscan+dovar1-1)
"9" then goto tis_
if length(tdl.tnmbr) = 12 then goto length_
tdl.tnmbr = tdl.tnmbr||lines(tdl.tlscan+dovar1-1);
tis_alpha:
if length(tdl.talpha) = 6 then goto length_
tdl.talpha = tdl.talpha||lines(tdl.tlscan+dovar1-1);
tis_number:
length_error:
isol_flag = 1;
goto isol_er_
break_char:
tdl.tnmwrd = length(tdl.tnmbr);
isol_flag = 2;
isol_er_return:
tdl.tlscan = tdl.tlscan+dovar1;
lpprct = lpprct + 1;
if lpprct 0 then goto set_up_
tdl.tdatas = tdl.
tdl.tpmb.op_code = tdl.tpmbs.op_
tdl.tdcws.wc = fixed(tio.tdcw.wc);
tdl.tadwds = tio.
tdl.tdtyps = tdl.
tdl.tcwdls = tdl.
tdl.testas = tdl.
chgmode = 0;
set_up_io:
data change rules
in standards
ADxxx,DROT and ADROT when they come from standards will only be
used 1 time.
The data will be set up just before the io is issued
and if the same data type is in both standards and the call sequence
(both ADxxx,DROT or ADROT) then the standard data type will be zeroed.
data type request encountered modifying per-op or in range of dcw list
due to a "CW---" or LCW or stds.
if encountered alone has no effect
NOTE:For all data types except DRAN, the call sequence data type will
be zeroed when the data is actually set up to preclude doing it again.
tdl.terflg,tdl.tinint = 0;
if tdl.tcwdl ^=0 then goto skip_data_
if tdl.topcd.op_type = 0|tdl.tdtyp = 0 then goto skip_data_
if tdl.tdtyp 10 then goto io_data_type_
goto io_setup_data(tdl.tdtyp);
io_data_type_illegal:
term_message ="
tdl.tdtyp > 10 in set_up_io";
call set_polts_abort(term_message);
goto main_dispatch_queue_
/* go to common code */
io_setup_data(1):
if tdl.topcd.op_type =1 then call setup_random_ /* no setup if not write */
goto skip_data_
io_setup_data(2):
if tdl.topcd.op_type = 1 then tio.tdcw.add = rel(addr(tio.trarea)); /* skip if not write */
goto skip_data_
io_setup_data(3):
call setup_octal_
goto skip_data_
io_setup_data(4):
if tdl.tdtyps =4 then tdl.tdtyps = 0;
call setup_add_to_
goto skip_data_
io_setup_data(5):
call setup_data_from_
goto skip_data_
io_setup_data(6):
if tdl.tdtyps =6 then tdl.tdtyps = 0;
call setup_
goto skip_data_
io_setup_data(10):
if tdl.tdtyps =10 then tdl.tdtyps = 0;
call setup_
goto skip_data_
io_setup_data(8):
call setup_packed_hex_
goto skip_data_
io_setup_data(9):
call setup_unpacked_hex_
io_setup_data(7):
skip_data_setup:
if cmpflg ^=0
then goto io_setup_
if tdl.topcd.op_type ^= 3 then goto check_for_
its a read
if tdl.tcwdl ^=0 then goto check_for_
do dovar1 = 1 to tdl.tdtcal_wc+1;
tio.trarea(dovar1) = tdl.
tio.redpre = tdl.
check_for_ram:
if tdl.tmiflg ^= 0 then go to io_setup_
if manual interventio flag is on then treat as single io*/
if tdl.dual_io_device = 0 then goto io_setup_
if (tdl.do_dual_io = 1) & (tdl.dual_io_count = 0) then goto io_setup_
if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 0) then goto save_first_of_
if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 1) then goto io_setup_
inv_data = "inconsistant dual
io command setup";
goto say_invalid_
save_first_of_dual:
tio.tskpmb = tdl.tpmb.op_code||tdl.tpmb.dev||"0"b||
tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.
tio.tsdcwv = tio.
tdl.dual_io_count = 1;
chgmode = 0;
io_setup_cmp:
if tdl.tdtyp ^=7 then goto io_setup_trace_
if tdl.tpmb.iom_cmd ^= "0100"
inv_data = "wrong ioc command used with ""loc"" data type";
goto say_invalid_
tdl.tpmb.reccnt = substr(tdl.tdata,31,6);
io_setup_trace_dcws:
chgmode = 0;
continue,allow_branch_dcw,dcw_count,fmtflg = 0;
current_dcw_add = tdl. /* start with first dcw */
if (dual_io_device = 1) & (tdl.tpmb.op_code = "001111"b) then
fmtflg = 1;
get_next_dcw:
tdl.tldcw = current_dcw_add->dcw_
dcw_count = dcw_count +1;
dcw_list.dcws(dcw_count) = tdl.
current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */
if dcw_count > 10 then goto say_dcw_
if tdl.tldcw.char = "111"b then goto trace_
if tdl.tldcw.typ = "00"b then goto trace_stop_
if tdl.tldcw.typ = "01"b then goto trace_proceed_
if tdl.tldcw.typ = "10"b then goto trace_branch_
must be "11"b non data xfer and proceed
trace_proceed_dcw:
if fmtflg = 1
call set_hbs_
allow_branch_dcw = 1; /* permit branch now
goto get_next_
trace_branch_dcw:
if allow_branch_dcw = 0 then goto say_branch_
allow_branch_dcw = 0;
current_dcw_add = addrel(tip,fixed(tdl.tldcw.add));
goto get_next_
trace_stop_dcw:
if fmtflg = 1
call set_hbs_
if continue = 1
continue = 0;
goto get_next_
if cmpflg ^=0 then go to error_
if tdl.trace = 0 then goto issue_test_
tdl.ttyret = issue_test_
call output_trace(tdp,tip,dcw_count,addr(dcw_list.dcws));
goto main_dispatch_queue_
/* go to common code */
trace_idcw:
allow_branch_dcw = 0;
if substr(tdl.tldcw.typ,1,1) = "1"b then continue = 1;
goto get_next_
issue_test_io:
tdl.interrupts.term = "0"b;
tdl.interrupts.init = "0"b;
tdl.interrupts.spec = "0"b;
tdl.interrupts.falt = "0"b;
tdl.interrupts.timeout = "0"b;
tdl.gespec = 0;
lpprct = 0; /* reset----we are issuing io
tdl.test_io_cnt = tdl.test_io_cnt + 1;
/* count i/os */
tio.tpcw = tdl.tpmb.op_code||tdl.tpmb.dev||"0"b||
tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.
/* note that the tpmb iom_cmd is multiplied by two to get iom type cmd */
tio_off = fixed(rel(tdl.tfdcwp));
_per_flag ^=0
if tdl.tpxdio ^=0 then goto aye_o_
/* point to first idcw */
substr(tio.ttdcw,19,18) = "000000"b;
substr(tio.ttdcw,1,18) = rel(tdl.tfdcwp);
tio_off = fixed(rel(addr(tio.tpcw)));;
goto aye_o_
pcwa = tio.
check for dual io if yes the link firt to second*/
if (tdl.dual_io_device = 1) & (tdl.dual_io_count = 1)
tio_off = fixed(rel(addr(tio.tskpmb)));
tio.tskpmb = substr(tio.tskpmb,1,22)||"1"b||substr(tio.tskpmb,24,13);
tdl.dual_io_count = 0;
tdl.io_in_progress = 1;
tdl.io_dispatch = page_
if pdata.simulation = 1 then goto sim_
call ioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error);
tdl.do_dual_io = 0;
if error ^=0 then goto aye_o_
goto main_dispatch_queue_
sim_connect:
call sioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error);
if error = 0 then goto main_dispatch_queue_
aye_o_error:
call com_err_$convert_status_code_(error,shortinfo,longinfo);
call ioa_$rsnnl("^/io connect error on page ^a^/^a",
term_reason,output_length,tst.name,longinfo);
call set_polts_abort(term_reason);
goto main_dispatch_queue_
gespec_timeout:
/* the 30 sec timer for gespec waits has timed out */
tdl.io_in_progress = 0;
tdl.interrupts.timeout = "1"b;
page_reentry:
goto error_
say_dcw_loop:
inv_data = "use of tdcw (cwxby) has caused dcw string loop without iotd (cwxs)";
goto say_invalid_
say_branch_bad:
inv_data = "illegal use of tdcw (cwxby), two tdcws in a row";
goto say_invalid_
error_check:
if (tdl.tpxdio = 0)&(tdl.eep_tally = 0) then goto not_
tdl.tpxdio = 0;
/* ignore ss o/e bit 2ss bits res rec and ae below */
if (bool(string(status),""b,"0001"b)
(tdl.interrupts.timeout = "0"b)&(tdl.interrupts.falt = "0"b)
then goto tdl.
/* dont honor options while in eep */
if tdl.interrupts.falt = "1"b then
call ioa_$rsnnl("^/iom fault ^w",
inv_data,mesg_len,addr(tdl.status)->falt_peek);
if tdl.interrupts.timeout = "1"
if tdl.gespec = 0 then
inv_data = "
io timeout on connect";
if tdl.gespec ^= 0 then
inv_data = "
io timeout waiting for special";
tdl.interrupts.falt,
tdl.interrupts.timeout = "0"b;
tdl.gespec = 0;
if tdl.eep_in_progress ^=0 then goto report_eep_
call ioa_$rsnnl("^/^/**^a(^ac) extended status unreadable^/status was ^12w"||inv_data,
message,mesg_len,
substr(page_no_char,tdl.pageno,1),
tdl.iccdd,addr(tdl.status)->falt_peek);
post_eep_com:
inv_data = "";
tdl.iocnt = tdl.iocnt + 1;
tdl.ttyret = post_eep_
call buffer_tty_output(message,tdl.pageno);
goto main_dispatch_queue_
/* goto common code */
report_eep_error:
call ioa_$rsnnl("^/extended status unreadable^/status was ^12w"||inv_data,
message,mesg_len,
addr(tdl.status)->falt_peek);
message = tdl.eep_msg||
goto post_eep_
post_eep_err:
tdl.eep_tally = 0;
tdl.eep_in_progress = 0;
tdl.tflag(10) = 0;
/* reset eep flag 9 */
tdl.do_opt = 1;
tdl.optrtn = end_
goto process_
if (tdl.interrupts.falt = "1"b)|(tdl.interrupts.timeout = "1"b)
tdl.terflg = 1;
/* set error */
tdl.interrupts.term = "0"b;
tdl.interrupts.spec = "0"b;
tdl.interrupts.init = "1"b;
/* set to preclude data checks */
cmpflg,tdl.tdecnt = 0;
tdl.tesmb.add = bit(fixed(fixed(tdl.tldcw.add)+fixed(tdl.tldcw.wc) + tdl.absaddr
,length(tdl.tesmb.add)),length(tdl.tesmb.add));
if tdl.tpsflg = 0 then goto check_status_and_
if tdl.tpmb.op_code = "00"b then goto check_status_and_
request status not positioning */
if fixed(tdl.tpmb.op_code) >31 then goto not_read_or_
/* An op_code from 01 to 37 octal is assumed to be a read or write
this means that invalid or illegal commands should not be issued
when the positioning flag is on.
For a mpc tape, these commands are all invalids and:
wef_command:
if tdl.interrupts.init ^= "1"b then
/* all invalid commands are taken care of here by the initiate interrupt
and all command rejects for the valid read or writes */
tdl.tppos = tdl.tppos + 1;
/* read,write, or wef---bump by 1 */
goto check_status_and_
not_read_or_write:
if tdl.tpmb.op_code = "100101"b|tdl.tpmb.op_code = "100111"b then
goto use_explicit_
if tdl.tpmb.op_code = "100100"b then goto add_record_ /* fsr */
if tdl.tpmb.op_code = "100110"b then goto sub_record_ /* bsr */
if tdl.tpmb.op_code = "111000"b|
tdl.tpmb.op_code = "111010"b|
tdl.tpmb.op_code = "111101"b then goto set_ /* rew,rews, or load */
if tdl.tpmb.op_code = "101101"b then goto wef_ /* wef */
goto check_status_and_ /* invalid command or non_positioning */
set_initial:
tdl.tppos = 0;
goto check_status_and_
add_record_count:
if tdl.interrupts.init = "1"b then goto check_status_and_
tdl.tppos = tdl.tppos + fixed(tdl.tpmb.reccnt);
goto check_status_and_
sub_record_count:
if tdl.interrupts.init = "1"b then goto check_status_and_
tdl.tppos = tdl.tppos - fixed(tdl.tpmb.reccnt);
goto check_status_and_
use_explicit_position:
/* for fsf and bsf we cant tell how many records have been passed
so the command itself has to contain the target position.
For example:
fsf05 or bsf11
if tdl.interrupts.init ^= "1"b then
tdl.tppos = tdl.tppos_ /* get saved fsf,bsf, or bkf data */
goto check_status_and_
op_code map for tape positioning
rtb(lfd *) rtb(lfd *)
*= dev. # mb = 0
*** = illegal
** = uses record count
** = uses record count
survd* *= dev. # mb = 0, also illegal for polts
status and interrupts check
check_status_and_interrupts:
if tdl.status.iocstat ^= "000000"b then tdl.terflg = 1;
if tdl.interrupts.term ^= tdl.testat.expected_interrupts.term then goto interrupts_
if tdl.interrupts.init ^= tdl.testat.expected_interrupts.init then goto interrupts_
goto interrupts_ /* presume ok */
/* if tdl.interrupts.spec = tdl.testat.expected_interrupts.spec then goto interrupts_
ignore specials for now
interrupts_error:
tdl.terflg = 1;
interrupts_ok:
if tdl.status.major_status ^= tdl.testat.major_status then
tdl.terflg = 1;
if tdl.testat.ignore_ss ^="0"b then goto sub_status_
if tdl.status.sub_status ^= tdl.testat.sub_status then
tdl.terflg = 1;
residual record count check
sub_status_ok:
if tdl.interrupts.init ="0"b then goto no_init_int_
tdl.tinint = 1;
goto check_non_data_
no_init_int_occured:
if tdl.tnrflg =0 then goto check_non_data_
if tdl.status.rrc ^= tdl.trrec then
tdl.terflg = 1;
smb #1 check
check_non_data_io:
if tdl.topcd.op_type = 0 then goto error_check_ /* non-data */
if tdl.tpmb.iom_cmd ^= "0100"b then goto not_sing_char_ioc_
goto error_check_
not_sing_char_ioc_cmd:
if tdl.tinint ^= 0 then goto error_check_
if tdl.tnmflg ^= 0 then goto check_
if tdl.tnrflg = 0 then goto check_res_
goto check_res_
check_res_wc:
if tdl.dcwres.wrd = tdl.trwrd then goto check_res_
if (tdl.trwrd = ""b|
tdl.topcd.op_type = 3) = "0"b then goto check_
tdl.terflg = 1;
check_res_add:
if tdl.dcwres.wrd ^=""b then goto check_
if tdl.tesmb.add = tdl.dcwres.add then goto check_
tdl.terflg = 1;
check_read:
if tdl.topcd.op_type ^=3|
tdl.tncflg ^=0 then goto error_check_
current_dcw_add = tdl. /* start with first dcw */
tdl.tldcw = current_dcw_add->dcw_
/* pre_fol word check here */
if tdl.tdtyp ^=1 then goto dont_initialize_
dvran = addrel(tip,tdl.tldcw.add)->data_peek.
/* get first word of write area */
if fixed(tdl.tdata) ^= 0 then
dvran = tio. /* use address as data */
if tdl.tpsflg = 0 then goto no_pos_
/********************positioning check***********************/
During tape positioning checking(tdl.tpsflg ^=0), if DRAN or DRAN1 data
type is used, the random base for data comparision is sset to:
upper = comp (tdl.tppos+1)
lower = tdl.tppos+1
If there is a match of either the lower or upper half of this
word with the corresponding lower or upper half of the data in the
read area, the position is assumed to be good.
If both the above lower or upper match fails, the complement
of the lower half of the first word for the read area is compared
with the upper half of the same word.
If they do not compare
it is assumed that a positioning check is invalid because of
a data error that messed up the first word of the read area.
If the latter comparision indicates that we can assume no
read data error, then a positioning error is assumed.
tdl.tppos will be set to the value in the lower half of the
data in the first word of the read area to reset
the current tape position to where the first word of the read
area indicates the tape to be at present and a position error
message will be included in the error message.
dvran = bool(bit(fixed(tdl.tppos,18),18),"111111"b,"1100"b)||bit(fixed(tdl.tppos,18),18);
if (tdl.tldcw.typ = "00"b|tdl.tldcw.typ = "01"b) = "0"b then goto no_pos_
/* cant check position unless word is xfer */
if substr(addrel(tip,tdl.tldcw.add)->data_peek.data,1,18) = substr(dvran,1,18)|
substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18) = substr(dvran,19,18)
then goto position_
if substr(addrel(tip,tdl.tldcw.add)->data_peek.data,1,18) =
bool(substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18),"111111"b,"1100"b)
then goto position_
/* must be
data error */
pos = "---";
goto no_pos_
position_error:
pos = translate(substr(character(tdl.tppos),
length(character(tdl.tppos))-2),"0"," ");
tdl.tppos = fixed(substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18));
dvran = bool(bit(fixed(tdl.tppos,18),18),"111111"b,"1100"b)||bit(fixed(tdl.tppos,18),18);
/* set dvran to this position */
tdl.terflg = 1;
goto no_pos_
position_good:
pos = "ok ";
no_pos_check:
/* this is a read and tdl.tppos has been incremented 1 too many */
/* the starting word base is = comp (tdl.tppos+1) for the upper and
tdl.tppos+1 for the lower.
In this way the upper is
always the complement of the lower. the lower half starts at zero
and increments by 1 for each position change.
dont_initialize_random:
allow_branch_dcw,dcw_count = 0;
select_next_dcw:
tdl.tldcw = current_dcw_add->dcw_
dcw_count = dcw_count +1;
current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */
if dcw_count > 10 then goto say_dcw_
/* should be
a different error---a disaster*/
if tdl.tldcw.typ = "00"b then goto check_stop_
if tdl.tldcw.typ = "01"b then goto check_proceed_
if tdl.tldcw.typ = "10"b then goto check_branch_
must be "11"b non data xfer and proceed
goto check_ndt_and_
check_proceed_dcw:
call check_
check_ndt_and_proceed:
allow_branch_dcw = 1; /* permit branch now
goto select_next_
check_branch_dcw:
if allow_branch_dcw = 0 then goto say_branch_
/* should be a different error--a disaster*/
allow_branch_dcw = 0;
current_dcw_add = addrel(tip,fixed(tdl.tldcw.add));
goto select_next_
check_stop_dcw:
call check_
goto error_check_
check_data:
tdl.tdtcal_reladd = fixed(tdl.tldcw.add)
- fixed(rel(addr(tio.trarea(1))));
tdl.tdtcal_wc = fixed(tdl.tldcw.wc)-fixed(tdl.dcwres.wrd);
only check what was actually read
if tdl.tdtyp ^=1 then goto not_random_
do dovar2 = 1 to tdl.tdtcal_
tio.twarea(tdl.tdtcal_reladd+dovar2) =
call compute_
not_random_read:
do dovar1 = 1 to tdl.tdtcal_
if trarea(dovar1+tdl.tdtcal_reladd) = twarea(dovar1+tdl.tdtcal_reladd) then goto data_
if tdl.tchmsk ^= ""b&
tdl.tldcw.typ = "00"b&
dovar1= tdl.tdtcal_
if bool(trarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b)
= bool(twarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b) then goto data_
tdl.tdecnt = tdl.tdecnt+1; /* bump data error count */
data_good:
end check_
error_check_done:
/*********************************************************************/
check to see if any error output is to be done here */
if tdl.tntflg ^=0 then goto check_for_options_after_error_
if (tdl.status.pwr ^= "0"b|tdl.status.major_status = "0010"b)
="0"b then goto not_man_
if tdl.endng ^= 0 then goto not_man_
dont service manual intervention if in forced term test */
if tdl.status.pwr ^= "0"b then goto in_man_
if tdl.status.major_status ^= tdl.testat.major_status
then goto in_man_
not_man_intervention:
if tdl.tmiflg ^=0 then goto end_man_
if tdl.trflg = 0 then goto no_tran_
/* "tdd" modifier not used */
/* tdl.trflg is set by the modifier "tdd", and the location
of the peripheral operation on which it was used is saved
in tdl.tsfld(8) and tdl.tscnt(8).
If tdl.trycnt >=
0 then tdl.trflg is set to tdl. otherwise, tdl.trflg
is set to the "nn" in "tnn".
tdl.trflg is an immediate modifier and only applies for
one peripheral operation.
if tdl.terflg^=0|tdl.tdecnt ^=0 then goto transient_
/* no error on this peripheral operation
If no recovery tries have yet been made, tdl.trcnt will be =0.
If tdl.trcnt is non-zero, it will contain the
number of times that retry has been made so far.
This number is added to tdl.tottrn.read, tdl.pastrn.read,
and to cyctrn.read if a read operation, or to the
equivalent .write if not a read operation.
tdl.trcnt is then zeroed and tdl proceeds to the next field.
if tdl.topcd.op_type = 3
tdl.pastrn.read = tdl.pastrn.read + tdl.
tdl.cyctrn.read = tdl.cyctrn.read + tdl.
tdl.tottrn.read = tdl.tottrn.read + tdl.
tdl.pastrn.write = tdl.pastrn.write + tdl.
tdl.cyctrn.write = tdl.cyctrn.write + tdl.
tdl.tottrn.write = tdl.tottrn.write + tdl.
tdl.trcnt = 0;
goto check_for_options_after_error_
transient_error:
/* an error has occurred for a peripheral operation
with a "tdd" modifier.
tdl.trycnt contains the number of retries to make.
If it is zero, then none are made, tdl.trflg
is set to zero and the "tdd" is ignored.
Since we can only be in a transient
recovery routine if "tdd" is used and
if tdl.trycnt ^=0, this effectively
means "tdd" is a nop if tdl.trycnt = 0;
if tdl.trycnt = 0 then goto no_tran_
/* there are tdl.trycnt tries to be made.
Bump tdl.trcnt to account for them
and use it to determine if the last
has been reached.
tdl.trcnt = tdl.trcnt + 1;
if tdl.trcnt >= tdl.trflg the
if tdl.traner = 0 then goto enter_transient_
/* the transient message output is requested */
tdl.tdlret = enter_transient_
tdl.add_tran = 2;
/* special flag to add transient message */
goto complete_transient_
enter_transient_recovery:
if tdl.topcd.op_type ^=3 then goto enter_write_
if tst.linetab(tdl.tsubr+1) ^=0 then goto invalid_tran_
tdl.line_number = tdl.
/* enter the transient routine */
enter_write_recovery:
if tst.linetab(tdl.tsubw+1) ^=0 then goto invalid_tran_
tdl.line_number = tdl.
/* enter the transient routine */
invalid_tran_line:
inv_data = "transient error recovery subroutine is a non_tdl line";
goto say_invalid_
unrecoverable:
if tdl.topcd.op_type = 3
tdl.pastrn.read = tdl.pastrn.read + tdl.
tdl.cyctrn.read = tdl.cyctrn.read + tdl.
tdl.tottrn.read = tdl.tottrn.read + tdl.
tdl.pastrn.write = tdl.pastrn.write + tdl.
tdl.cyctrn.write = tdl.cyctrn.write + tdl.
tdl.tottrn.write = tdl.tottrn.write + tdl.
tdl.add_tran = 1; /* special flag for unrecoverable message */
goto complete_transient_
no_tran_request:
if tdl.terflg = 0&tdl.tdecnt = 0 then goto check_for_options_after_error_
tdl.toterr.sta = tdl.toterr.sta + tdl.
tdl.cycerr.sta = tdl.cycerr.sta + tdl.
tdl.paserr.sta = tdl.paserr.sta + tdl.
tdl.toterr.dat = tdl.toterr.dat + tdl.
tdl.cycerr.dat = tdl.cycerr.dat + tdl.
tdl.paserr.dat = tdl.paserr.dat + tdl.
tdl.taeflg = 1; /* set any error flag */
complete_transient_message:
if tdl.bypass ^=0 then goto check_for_options_after_error_
man_intervention_started:
tdl.ttyret = check_for_options_after_error_
call error_output(tdp,pos);
if tdl.teepopt ^=0&tdl.eep_line_no ^=0&tdl.tmiflg=0&tdl.endng = 0 then goto start_
/* message not yet issued */
/* dont start eep if in forced term test */
goto main_dispatch_queue_
/* goto common code */
start_eep:
tdl.eep_in_progress = 1;
tdl.eep_talpha = tdl.
tdl.eep_tnmbr = tdl.
tdl.eep_tnmwrd = tdl.
tdl.eep_next_field_number = tdl.next_field_
tdl.eep_per_op_number = tdl.per_op_
tdl.eep_line_number = tdl.line_
tdl.eep_tlscan = tdl.
tdl.eep_inst_index = tdl.inst_
tdl.eep_tdlret = tdl.
tdl.line_number = tdl.eep_line_
end_man_intervention:
tdl.tmiflg = 0;
in_man_intervention:
if tdl.tmiflg ^=0 then goto not_first_
tdl.toterr.sta = tdl.toterr.sta + tdl.
tdl.cycerr.sta = tdl.cycerr.sta + tdl.
tdl.paserr.sta = tdl.paserr.sta + tdl.
tdl.toterr.dat = tdl.toterr.dat + tdl.
tdl.cycerr.dat = tdl.cycerr.dat + tdl.
tdl.paserr.dat = tdl.paserr.dat + tdl.
tdl.taeflg = 1; /* set any error flag */
tdl.tmiflg = 1;
goto man_intervention_
not_first_intervention:
tdl.tmiflg = tdl.tmiflg +1;
if tdl.tmiflg >= 128 then goto reset_man_
man_intervention_loop:
tdl.tmnem = "res
check = 32;
goto per_op_
reset_man_intervention:
tdl.tmiflg = 1;
goto man_intervention_
check_for_options_after_error_check:
if tdl.tmiflg ^=0 then goto man_inter_
if tdl.opt = 0 then goto tdl.
tdl.optrtn = tdl.
goto process_
man_inter_options:
if tdl.opt = 0 then goto man_intervention_
tdl.optrtn = man_intervention_
goto process_
setup_random_data:
if fixed(tdl.tdata) ^= 0 then
dvran = tio. /* use address as data */
if tdl.tpsflg ^=0 then
dvran = bool(bit(fixed(tdl.tppos+1,18),18),"111111"b,"1100"b)||bit(fixed(tdl.tppos+1,18),18);
/* the starting word base is = comp (tdl.tppos+1) for the upper and
tdl.tppos+1 for the lower.
In this way the upper is
always the complement of the lower. the lower half starts at zero
and increments by 1 for each position change.
not_pos_rand:
do dovar1 = 1 to data_setup_
tio.twarea(data_setup_reladd+dovar1) =
call compute_
end setup_random_
setup_octal_data:
tdl.tdtyp = 0;
do dovar1 = 1 to data_setup_
tio.twarea(data_setup_reladd+dovar1) = tdl.
end setup_octal_
setup_add_to_data:
tdl.tdtyp = 0;
do dovar1 = 1 to data_setup_
tio.twarea(data_setup_reladd+dovar1)
= bit(fixed((fixed(tdl.tdata) + fixed(tio.twarea(data_setup_reladd+dovar1))),36));
end setup_add_to_
setup_data_from_line:
tdl.tdtyp = 0;
work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
tdl data lines consist of 9 words of data followed by
5 words of padding to fill out to a 14 word ascii multics line.
do dovar1 = 1 to tdl.tdtcal_wc by 9;
if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_
fix_bit = 0;
do dovar1 = 1 to tdl.tdtcal_
tio.twarea(data_setup_reladd+dovar1) = work_ptr->data_move.data(dovar1+fix_bit);
if mod(dovar1,9) = 0 then fix_bit = fix_bit+5;
end setup_data_from_
not_test_data_line:
inv_data = "dln data is not all from test data line";
goto say_invalid_
setup_drot:
tdl.tdtyp = 0;
work_ptr = addrel(addr(twarea(1)),data_setup_reladd);
substr(work_ptr->bit_look.data(1),1,(data_setup_wc*36))
= substr(work_ptr->bit_look.data(1),7,(data_setup_wc*36-6))||
substr(work_ptr->bit_look.data(1),1,6);
end setup_
setup_adrot:
tdl.tdtyp = 0;
work_ptr = addrel(addr(twarea(1)),data_setup_reladd);
substr(work_ptr->bit_look.data(1),1,(data_setup_wc*36))
= substr(work_ptr->bit_look.data(1),10,(data_setup_wc*36-9))||
substr(work_ptr->bit_look.data(1),1,9);
end setup_
setup_packed_hex_data:
tdl.tdtyp = 0;
work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
tdl data lines consist of 9 words of data followed by
5 words of padding to fill out to a 14 word ascii multics line.
only the characters 0-9 and a-f are permitted in the data line
0-f are translated to a 4 bit pattern "0000" to "1111"
corresponding to the order 0-9,a-f
the resulting 4 bit patterns are then concatenated adjacently
to produce the final pattern
it requires 9 data line characters to produce 1 word of output data
(6 bit characters---1 1/2 36 bit words )
do dovar1 = 1 to ceil((tdl.tdtcal_wc*9)/6) by 9;
if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_
fix_bit = 0;
do dovar1 = 1 to tdl.tdtcal_wc*9;
if hex_val(fixed(work_ptr->char6_peek(dovar1+fix_bit))+1) = 20 then goto invalid_hex_
if mod(dovar1,54) = 0 then fix_bit = fix_bit+30;
fix_bit = 0;
do dovar1 = 1 to tdl.tdtcal_
tio.twarea(data_setup_reladd+dovar1) =
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+1+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+2+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+3+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+4+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+5+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+6+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+7+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+8+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+9+fix_bit))+1),4),4);
if mod(dovar1,6) = 0 then fix_bit = fix_bit+30;
end setup_packed_hex_
setup_unpacked_hex_data:
tdl.tdtyp = 0;
work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
tdl data lines consist of 9 words of data followed by
5 words of padding to fill out to a 14 word ascii multics line.
only the characters 0-9 and a-f are permitted in the data line
0-f are translated to a 4 bit pattern "0000" to "1111"
corresponding to the order 0-9,a-f
the resulting 4 bit patterns are then concatenated in pairs with a fill bit as
"0"||"xxxx"||"yyyy" to produce a nine bit character and the
resulting 9 bit characters are contatenated adjacently
to produce the final pettern
it requires 8 data line characters to produce 1 word of output data
(6 bit characters---1 1/3 36 bit words )
do dovar1 = 1 to ceil((tdl.tdtcal_wc*8)/6) by 9;
if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_
fix_bit = 0;
do dovar1 = 1 to tdl.tdtcal_wc*8;
if hex_val(fixed(work_ptr->char6_peek(dovar1+fix_bit))+1) = 20 then goto invalid_hex_
if mod(dovar1,54) = 0 then fix_bit = fix_bit+30;
fix_bit = -30;
/* preset for first bump */
do dovar1 = 1 to tdl.tdtcal_
if mod(dovar1,27) = 1 then fix_bit = fix_bit+30;
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+1+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+2+fix_bit))+1),4),4);
if mod(dovar1,27) = 21 then fix_bit = fix_bit+30;
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+3+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+4+fix_bit))+1),4),4);
if mod(dovar1,27) = 14 then fix_bit = fix_bit+30;
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+5+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+6+fix_bit))+1),4),4);
if mod(dovar1,27) = 7 then fix_bit = fix_bit+30;
tio.twarea(data_setup_reladd+dovar1) =
byte1||byte2||byte3||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+7+fix_bit))+1),4),4)||
bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+8+fix_bit))+1),4),4);
end setup_unpacked_hex_
invalid_hex_line:
inv_data = "invalid hexidecimal character in uhdln or phdln";
goto say_invalid_
compute_random:
dvranw = "0"b||bit(fixed(fixed(dvran)*317,71),71);
dvran=substr(bit(fixed(fixed(substr(dvranw,37,36),36)+fixed(substr(dvranw,1,35),36),36),36),1,36);
end compute_
page_initialize:
call init_
if tdl.initreq ^=-1 then goto select_next_test_or_seg_or_start_or_
tdl.initreq = 0;
start_test:
tdl.lst = tdl.
tdl.loopct(tdl.line_number+1),
/* clear this lines loop counter
tdl.tpsflg,
clear positioning flag
tdl.do_dual_io,
tdl.second_io_of_dual,
tdl.eep_tally,
tdl.eep_in_progress,
tdl.tmiflg = 0;
tdl.tchmsk = ""b;
tdl.tpadwd = ""b;
goto the next line
init_page:
tdl.tdtyps,tdl.tcwdls = 0;
tdl.tdatas = ""b;
tdl.tpmbs.chan = tdl.
dvran = ""b; /* standard random dvran */
do dovar1 = 1 to 10;
tio.tdcww(dovar1).add = rel(addr(tio.twarea));
tio.tdcwr(dovar1).add = rel(addr(tio.trarea));
tio.tdcww(dovar1).char = "000"b;
tio.tdcwr(dovar1).char ="000"b;
tio.tdcww(dovar1).w_c = "0"b;
tio.tdcwr(dovar1).w_c = "0"b;
tio.tdcww(dovar1).typ ="00"b;
tio.tdcwr(dovar1).typ = "00"b;
tio.tdcww(dovar1).wc = bit(fixed(tst.max,12),12);
tio.tdcwr(dovar1).wc = bit(fixed(tst.max,12),12);
tdl.tdcws.wc = tst.
tio.tdcw.char ="000"b;
tio.tdcw.w_c = "0"b;
tio.tdcw.typ = "00"b;
tdl.terflg,
tdl.taeflg,
tdl.tcwdl,
tdl.tpsflg = 0;
do dovar1 = 1 to 101;
tdl.loopct(dovar1) = 0;
do dovar1 = 1 to 10;
tdl.tsfld(dovar1) = -1;
tdl.tscnt(dovar1) = 0;
set_hbs_bit:
fmtflg = 0;
substr(addrel(tip,tdl.tldcw.add)-> bits,34,1)= "1"b;
skip_hbs_set:
end set_hbs_
tdl.test_no_to_jump_to = tst. /* select term test */
tdl.doing_force = 1;
tdl.endng = 1;
tdl.force = 1;
goto force_
process_options:
call options(tdp,tpp,check);
if tdl.wait ^= 0 then goto wait_
if check ^=0 then goto tdl.
goto main_dispatch_queue_
wait_loop:
if tdl.wait = 0 then goto process_ /* wait broken by options request */
/* note that the place to return from after .wait is broken is tdl.optrtn */
tdl.clock_dispatch = wait_
tdl.clock_going = 1;
/* set clock going */
call timer_manager_$alarm_wakeup("b,tdl.clock_event);
time is in micro seconds
tdl.iocnt = tdl.iocnt +1; /* bump test pages i/o count */
call edit_options(tdp,current_options);
pnum = substr(page_no_char,tdl.pageno,1);
call ioa_$rsnnl("^/^/**^a(^ac) ^a waiting",message,mesg_len,pnum,tdl.iccdd,current_options);
call buffer_tty_output(message,tdl.pageno);
goto main_dispatch_queue_ /* go away untill called */
/* goto common code
say_invalid_instruction:
chgmode = 0;
/* make sure we dont inadvertently think we have an io
lineno = tdl.line_
fieldno = tdl.next_field_number - 1;
tdl.rtnopt = process_
tdl.optrtn =
pnum = substr(page_no_char,tdl.pageno,1);
call edit_options(tdp,current_options);
call ioa_$rsnnl("^/^/**^a(^ac) invalid tdl instruction, line ^d, field ^d, ^a^a^/^a^/^a enter options:"
,message,mesg_len,pnum,tdl.iccdd,lineno,fieldno,tdl.talpha,tdl.tnmbr,inv_data,current_options);
invalid_common:
inv_data = "";
tdl.optrd = 1;
goto request_and_wait_for_tty_
/*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
next test sequencing
Test pages contain two sets of information relating to
test sequencing.
The first of these sets are the
three values for "fst", "end" and "trm".
The second of these
is the contents of the test sequencing table.
For any given test page segment, the content of the test
sequencing table is, by definition, a sequence of line numbers
with the occurance of a line number in a given position in
the table defining the starting line number for the test
number associated with that position in the table.
The value of "tst.fst" defines the "virtual test number" of the
first test in any given test page segment.
This test number
is here called "virtual" because, for other than the first
test page segment, there will be a "real" test with that same
number that exists as the last test in the prior test page.
This "virtual" test does not have an entry in the test sequencing
table to define its line number.
The line number of this
"virtual" test is defined as line #0.
The test number associated with any entry in the test sequencing
table is equal to the ordinal position of the entry in the
table + the value of "tst.fst".
For a value of 5 for "tst.fst"
with 3 entries in the table, the three entries have ordinal
position of 1,2, and 3 and therefore define tests # 6,7 and 8
(there is no ordinal position 0, the first position is position 1).
pos. 1(test 1)
pos. 1(test 6)
pos. 1(test 9)
pos. 2(test 2)
pos. 2(test 7)
end=12 pos. 2(test 10)
pos. 3(test 3)
pos. 3(test 8)
trm=12 pos. 3(test 11)
pos. 4(test 4)
pos. 4(force term)
pos. 4(test 12
pos. 6(force term)
In the above, note that "trm" serves as a way to indicate
whether or not the current segment is the last of the test
If "trm" = "end", then the current segment is the
last segment. If "trm"="end"+1, then there is a following segment.
There are only two legal values for "trm", "trm" = "end" or
"trm" = "end"+1.
"trm" always refers to the term test for
the current segment.
That is, the last test defined in
the test sequencing table is the force term test.
"end" refers to the last selectable test in the current segment
by normal test sequencing.
In the example, the last test
normally run in seg.a is test 5.
An "nx" in test 5 will not
cause sequencing to pos.6 in seq.a but will cause seq.b to be
Similiarily, a "nx" in test 8 of seg.b will cause
segment seg.c to be called.
In seg.c, test sequencing will
proceed into test 12.
select_next_test_or_seg_or_start_or_end:
call test_seq_
if tdl.nxt ^= -1 then goto select_
tdl.nxt,tdl.lst = 0;
flag initialization done
if tdl.initreq ^= 0 then goto say_end_
tdl.initreq = -1;
output page start message
pnum = substr(page_no_char,tdl.pageno,1);
call ioa_$rsnnl("^/^/**^a(^ac) start ^a ^a ttldat ^a",message,mesg_len,pnum,tdl.iccdd,tst.name,tst.perip,tst.tpdate);
tdl.ttyret = page_
goto request_and_wait_for_tty_
say_end_cycle:
tdl.cyccnt = tdl.cyccnt + 1;
if tdl.halt ^=0 then goto do_say_end_
if tdl.bypass ^=0 then goto page_
do_say_end_cycle:
pnum = substr(page_no_char,tdl.pageno,1);
call ioa_$rsnnl("^/^/**^a(^ac) end cycle ^d: ^d status and ^d data errors"
,message,mesg_len,pnum,tdl.iccdd,tdl.cyccnt,tdl.cycerr.sta,
tdl.cycerr.dat);
tdl.ttyret = page_
tdl.cycerr.sta,
tdl.cycerr.dat = 0;
if (tdl.cyctrn.read ^=0)|(tdl.cyctrn.write ^=0)
call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
message,mesg_len,(message),tdl.cyctrn.read,tdl.cyctrn.write);
tdl.cyctrn.read = 0;
tdl.cyctrn.write = 0;
goto request_and_wait_for_tty_
say_end_pass:
pnum = substr(page_no_char,tdl.pageno,1);
call ioa_$rsnnl("^/^/**^a(^ac) end pass ^d: ^d status and ^d data errors"
,message,mesg_len,pnum,tdl.iccdd,tdl.pascnt,tdl.paserr.sta,
tdl.paserr.dat);
tdl.paserr.sta,
tdl.paserr.dat = 0;
if (tdl.pastrn.read ^=0)|(tdl.pastrn.write ^=0)
call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
message,mesg_len,(message),tdl.cyctrn.read,tdl.cyctrn.write);
tdl.pastrn.read = 0;
tdl.pastrn.write = 0;
tdl.ttyret = start_
goto request_and_wait_for_tty_
get_next_segment:
the_char = substr(tst.name,6,1); /* get sequence letter */
check = search(page_no_char,the_char); /* find it in page_no_char
check = check+1;
tdl.call_page = substr(tst.name,1,5)||substr(page_no_char,check,1);
call call_from_
new_segment_common:
tdl.nxt = -1;
tdl.initreq = 0;
tdl.line_number = 0; /* initialization test is defined at line 0 */
goto select_next_test_or_seg_or_start_or_
select_test:
if tdl.doing_force = 1 then goto find_first_in_
if tdl.opt = 0 then goto sequence_
tdl.optrtn = sequence_
goto process_
sequence_test:
call test_seq_
if tdl.nxt = 0 then goto dont_loop_on_test_0;
if loop ^=0 then goto loop_
dont_loop_on_test_0:
goto find_next_
find_first_in_sequence:
/* find first occurance of test to jump to in current test sequence
with jump bit off
do dovar1 = 1 to ((tst.end-tst.fst)*4+1) by 4;
if tst.testab(dovar1+1) = 1 then goto no_check_
/* dont use jump
if tdl.test_no_to_jump_to - tst.fst = tst.testab(dovar1+2) then goto jump_test_
no_check_jump:
goto say_jumping_to_test_not_in_current_
/* check to see if new location in test sequence is = tdl.nxt then goto not_back_
passck = 1;
/* reset test sequencing to new location */
not_back_jump:
tdl.nxt = (dovar1+3)/4;
goto loop_
call test_seq_
goto loop_
skip_test:
call test_seq_
did_skip = 1;
goto find_next_
force_test:
call test_seq_
if test_no_to_jump_to >=(tst.fst+1)&test_no_to_jump_to
tst.end then goto new_segment_
/* if above---found segment
if tst.trm = tst.end then goto say_jumping_to_test_not_in_current_ /* no such test */
the_char = substr(tst.name,6,1); /* next segment */
goto try_next_
find_next_test:
if tdl.nxt+1 > (tst.end-tst.fst) then goto get_next_
tdl.nxt = tdl.nxt + 1;
loop_test:
non_exec_count = non_exec_count + 1;
if non_exec_count = (tst.end-tst.fst) then goto say_no_executable_tests_in_
if tst.testab((tdl.nxt-1)*4+2) = 0 then goto not_sequenced_
tdl.test_no_to_jump_to = tst.testab((tdl.nxt-1)*4+3); /*select test # to jump to*/
goto find_first_in_
not_sequenced_jump:
if tdl.doing_force ^=0 then goto select_test_at_
/* for explicit test requests, the dont run unless explicit request bit
is ignored */
if tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+1) ^= 0 then goto find_next_
select_test_at_line:
if tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+1) >1 then goto find_next_
/* stop condition not 2 or 3, test not completely turned off */
tdl.line_number = tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+4); /* line # of test to tdl.line_number
if tdl.test_no_to_jump_to = (tst.testab((tdl.nxt-1)*4+3)+tst.fst) then tdl.doing_force = 0;
if tdl.endng ^=0 then goto start_
if passck = 0 then goto check_for_
if tdl.pass =0 then goto check_for_
tdl.pascnt = tdl.pascnt + 1;
if tdl.halt ^=0 then goto say_end_
if tdl.bypass = 0 then goto say_end_
check_for_inform:
rm = 0 then goto start_
if did_skip ^=0 then goto start_
endts polts name
pnum = substr(page_no_char,tdl.pageno,1);
last_test_no = tst. /* preset in case test #0 last */
if tdl.lst = 0 then goto test_zero_
last_test_no = tst.testab((tdl.lst-1)*4+3)+tst. /*compute last test #*/
test_zero_last:
next_test_no = (tst.testab((tdl.nxt-1)*4+3)+tst.fst); /* compute next test #*/
halt_message = "";
if tdl.halt = 0 then goto no_halt_at_inform_
tdl.optrtn = start_
tdl.rtnopt = process_
tdl.optrd = 1;
halt_message = "^/enter options:";
no_halt_at_inform_message:
call ioa_$rsnnl("^/^/**^a(^ac) end t^d next t^d "||substr(time (),1,2)||"."||substr(time (),3,3)
||halt_message,message,mesg_len,pnum,tdl.iccdd,last_test_no,next_test_no);
tdl.ttyret = start_
goto request_and_wait_for_tty_
test_seq_init:
tdl.lst = tdl.
non_exec_count,
tdl.eep_in_progress =0;
end test_seq_
say_invalid_test_sequencing:
tdl.doing_force = 0;
tdl.optrtn =
tdl.rtnopt = process_
pnum = substr(page_no_char,tdl.pageno,1);
call edit_options(tdp,current_options);
call ioa_$rsnnl("^/^/**^a(^ac) invalid test sequencing ^/^a^/^a enter options:"
,message,mesg_len,pnum,tdl.iccdd,inv_data,current_options);
goto invalid_
say_no_executable_tests_in_sequence:
inv_data = "no executable tests in this sequence";
goto say_invalid_test_
say_jumping_to_test_not_in_current_sequence:
inv_data ="trying to jump to a test not in current sequence";
goto say_invalid_test_
/*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
subroutines
if tio.tdcwr(tdl.tcwdl).char = "111"b|tio.tdcwr(tdl.tcwdl).typ = "10"b
then goto lcset_
tdl.tdtcal_reladd = fixed(tio.tdcwr(tdl.tcwdl).add)
- fixed(rel(addr(tio.trarea(1))));
tdl.tdtcal_wc = fixed(tio.tdcwr(tdl.tcwdl).wc);
tdl.tfdcwp = addrel(addr(tio.tdcwr(1)),(tdl.tcwdl-1)); /* assume read */
if tdl.topcd.op_type = 3
/* was a read */
tdl.tfdcwp = addrel(addr(tio.tdcww(1)),(tdl.tcwdl-1)); /* point to write dcw */
lcset_error:
inv_data = "cannot use tdcw or idcw as first dcw";
goto say_invalid_
data_setup_reladd = tdl.tdtcal_
data_setup_wc = tdl.tdtcal_
all data routines are expected to put the TDL numeric
part of the instruction into "octnum".
Since some
routines isolate the numeric part into "fdec1" or "vdec4"
(DLNnn), they are expected to put the number into "octnum"
before going to dtypst.
tdl.tdata = bit(fixed(octnum,36));
if tdl.tdtyp 10 then goto bad_data_
goto dtypst_data_setup(tdl.tdtyp);
dtypst_data_setup(2):
bad_data_type:
call ioa_$rsnnl("^/tdl.tdtyp ^d illegal in dtypst"
,term_message,mesg_len,tdl.tdtyp);
call set_polts_abort(term_message);
goto main_dispatch_queue_
/* go to common code */
dtypst_data_setup(1):
call setup_random_
dtypst_data_setup(7):
dtypst_data_setup(3):
call setup_octal_
dtypst_data_setup(4):
call setup_add_to_
dtypst_data_setup(5):
call setup_data_from_
dtypst_data_setup(6):
call setup_
dtypst_data_setup(8):
call setup_packed_hex_
dtypst_data_setup(9):
call setup_unpacked_hex_
dtypst_data_setup(10):
call setup_
if tdl.tcwdl ^=0
if chgmode <= 0
/* CHG or not prev per-op
if tdl.topcd.op_type ^= 0
call_from_page:
callname = tdl.call_
page to call
call tpinit(callname,tptr,error);
if error = 0 then goto good_
if error ^=1 then goto main_dispatch_queue_
system error--we are aborting
/* error = 1---no such page
call ioa_$rsnnl("^/error calling ^a^/no such test page",term_reason,output_length,
callname);
call set_polts_abort(term_reason);
goto main_dispatch_queue_
/* go to common code */
good_init:
/* free old test page */
tpp = /* new pointer */
tdl.page_ptr =
end call_from_
-----------------------------------------------------------
Historical Background
This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc.
as a contribution to computer science knowledge.
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system.
Multics development was initiated by Massachusetts Institute of Technology Project MAC (),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc.,
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .
-----------------------------------------------------------
Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
Copyright 2006 by Bull HN Information Systems Inc.
Copyright 2006 by Bull SAS
All Rights Reserved}