/* prime tdl entry point */ try_assign: if tdl.train_number = -2 then do; /* 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_assign; goto request_and_wait_for_tty_write; end; tdl.tdlret = nxlin; 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_name; if substr(tdl.device_name,1,3) = "dsk" then do; 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); end; if substr(tdl.device_name,1,3) = "tap" then do; rcp_name = "tape"; tape_info.volume_name = string("scratch"); tape_info.write_flag = "1"b; end; 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); else 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_ok; 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_service; attach_ok: if tdl.allocated ^=0 then goto main_dispatch_queue_service; /* dont try if assigned already--CISL BUGGGGG */ if tdl.stop ^= 0 then do; tdl.force = 1; goto alloc_end_page; 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_ok; /* for code 1 and 2 */ if tdl.asgn_flag = 4|tdl.asgn_flag = 1|tdl.asgn_flag = 2 then if tdl.nxt = 0 then do; 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_said; tdl.nxt = -1; goto request_and_wait_for_tty_write; end; busy_said: tdl.nxt = -1; if tdl.stop ^= 0 then do; tdl.force = 1; goto alloc_end_page; end; if tdl.asgn_flag = 0 then goto init_alloc; if tdl.asgn_flag = 1|tdl.asgn_flag = 2|tdl.asgn_flag = 3 |tdl.asgn_flag = 7 then do; tdl.asgn_flag = 7; goto main_dispatch_queue_service; end; /* short wait---long wait--or assign error */ tdl.clock_dispatch = attach_loop; tdl.clock_going = 1; /* set clock going */ call timer_manager_$alarm_wakeup(1000000,"10"b,tdl.clock_event); /* time is in micro seconds 1000000 = 1 sec */ goto main_dispatch_queue_service; /* go away untill called */ init_alloc: tdl.allocated = 1; goto select_next_test_or_seg_or_start_or_end; /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*/ /* isolate current tdl instruction */ eoline: tdl.tdlret = eoline_do_return; goto do; eoline_do_return: if tst.linetab(tdl.line_number+2) ^= 0 then do; inv_data = "end of line sequencing would proceed on a non-tdl line"; goto say_invalid_instruction; end; tdl.line_number = tdl.line_number + 1; goto nxlin; skipf: call isol; if isol_flag = 1 then goto isol_er; if isol_flag = 0 then goto eoline; call look_up_mnemonic; call bump_per_op_number_if_per_op; goto nxfld; fldct: tdl.next_field_number,tdl.per_op_number = 0; do dovar3 = 1 to skip_field_no; call isol; if isol_flag = 0 then goto eoline; if isol_flag = 1 then goto isol_er; call look_up_mnemonic; call bump_per_op_number_if_per_op; end; goto nxfld; nxlin: if tst.linetab(tdl.line_number+1) ^= 0 then do; term_message = " tdl implimentation error-non tdl line at ""nxlin"""; call set_polts_abort(term_message); goto main_dispatch_queue_service; /* go to common code */ end; tdl.tlscan = (tdl.line_number*56)+1; tdl.next_field_number,tdl.per_op_number = 0; nxfld: if tdl.tmiflg = 0 then goto skip_do; tdl.tdlret = skip_do; /* set do return */ goto do; skip_do: call isol; if isol_flag = 2 then goto isol_ok; if isol_flag = 0 then goto eoline; /* isolation error--->6 alpha,>12 numbers */ isol_er: inv_data = "> 6 alpha or >12 numbers"; goto say_invalid_instruction; /* go to selected tdl routine */ bump_per_op_number_if_per_op:proc; 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_op; look_up_mnemonic:proc; do dovar1 = 1 to inst$tlen/2 by 2; if tdl.talpha = inst$tdli(dovar1) then return; end; inv_data = "unknown mnemonic"; goto say_invalid_instruction; end look_up_mnemonic; isol_ok: call look_up_mnemonic; /* 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_do; tdl.tdlret = do_return; goto do; do_return: dovar1 = tdl.inst_index; /* 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 1. The count of the numeric characters isolated in the instruction must be >= nd1+nd2+nd3 and must be <= nd1+nd2+nd3+ovd4. That is, the first sum is the lower limit of how many numerics are legal, and the second sum is the upper limit of how many numerics are legal. This is true regardless of whether the type of conversion is octal or decimal. 1a. OCTAL CONVERSION: The constants nd1,nd2,nd3 and ovd4 are used only to define the lower and upper limits of the count of numeric characters that are to be considered legal. nd1 should be set to the lower limit, and ovd4 to the range (upper limit - lower limit). with nd2 = nd3 = 0 examples are: 2 octal digits is specified as 2,0 for nd1,ovd4 0 to 12 octal digits is specified as 0,12 for nd1,ovd4 2 to 6 octal digits is specified as 2,4 for nd1,ovd4 All octal conversion places the converted number into the declared binary variable "octnum". Justification may be either left or right into the target. This is under the control of the "type" field of the control word. If bit 28 is 0, left justification is assumed. Justification for octal numbers will always be within a 12 octal character field. 1b. DECIMAL CONVERSION: For decimal conversion, nd1,nd2,nd3,ovd4 are used for both the limits checks above and to allow separation of the numeric characters into up to four fields as distinct decimal numbers. A TDL instruction is considered to have only one numeric field during isolation of the characters comprising the field. That is, a TDL instruction such as "aannanan", where "a" is any alpha character and "n" is any numeric character is separated into "aaaa" as an alpha part and into "nnnn" as a numeric part. The "nnnn" part of the separated TDL instruction is then split, for decimal conversion, up into a distinct part for each instance of nd1,nd2,nd3, and ovd4 non-zero. If, for example, those controls were, respectively, 2,3,0,5 then 3 of them would be non-zero and there would be as a result 3 partitions of the "nnnnnnnn" number. The actual value of nd1,nd2 etc. will control how many characters of the "nnnnnnnn" number are to be used for each partition. In comment on the above, as time permits a routine will probably be developed to insure that the "nnnnn" numeric characters are distributed in groups (separated by alpha characters) that match the fixed specifiers. Too much trouble has occurred where a TDL programmer has written such as LPx.nnn which was interpreted as LPxx.nn by TDL. nd1 specifies that the first nd1 characters are to be converted to decimal and placed in "fdec1". nd2 specifies that the next nd2 characters after nd1 characters are similarly converted and placed in "fdec2". nd3 is as nd2 for the characters after nd2 and placed in "fdec3". Note that nd1,nd2 and nd3 specify an exact number characters to convert. These are the fixed decimal conversion characters. ovd4, for decimal conversion, is the variable decimal conversion specifier. That is, any number of characters from 0 to "ovd4" are converted. If there are any characters after the fixed conversion is done, then all remaining characters are converted. Note that ovd4 is only used in the limits check. If the limits check is passed then there can only be 0 to "ovd4" characters remaining after the first nd1+nd2+nd3 characters. All decimal conversion results in a right justified number. */ no_do: call bump_per_op_number_if_per_op; 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) >tdl.tnmwrd then do; inv_data = "insufficient fixed numerics"; goto say_invalid_instruction; end; 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 then do; inv_data = "more numerics than defined for instruction"; goto say_invalid_instruction; end; fdec1,fdec2,fdec3,vdec4,octnum = 0; if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),6,1) ="1"b then goto octal_conversion; 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_done; octal_conversion: if tdl.tnmwrd = 0 then goto num_conv_done; if search(tdl.tnmbr,"89") ^=0 then do; inv_data ="only octal numerics allowed"; goto say_invalid_instruction; end; do dovar3 = 1 to 12; if tdl.tnmwrd "9" then goto tis_alpha; if length(tdl.tnmbr) = 12 then goto length_error; tdl.tnmbr = tdl.tnmbr||lines(tdl.tlscan+dovar1-1); goto tis_number; tis_alpha: if length(tdl.talpha) = 6 then goto length_error; tdl.talpha = tdl.talpha||lines(tdl.tlscan+dovar1-1); tis_number: end; length_error: isol_flag = 1; goto isol_er_return; break_char: tdl.tnmwrd = length(tdl.tnmbr); isol_flag = 2; isol_er_return: tdl.tlscan = tdl.tlscan+dovar1; end isol; do: lpprct = lpprct + 1; if lpprct <275 then goto no_tdl_loop; inv_data = "tdl language lockup fault, no io for 275 major instructions"; goto say_invalid_instruction; no_tdl_loop: if chgmode = 0 then goto tdl.tdlret; if chgmode >0 then goto set_up_io; tdl.tdatas = tdl.tdata; tdl.tpmb.op_code = tdl.tpmbs.op_code; tdl.tdcws.wc = fixed(tio.tdcw.wc); tdl.tadwds = tio.tadwd; tdl.tdtyps = tdl.tdtyp; tdl.tcwdls = tdl.tcwdl; tdl.testas = tdl.testat; chgmode = 0; goto tdl.tdlret; set_up_io: /* data change rules Lxxx LCWx write read non_data write read non_data in standards Dxxxxxx at-io at-io none none none none ADxxxxxx at-io at-io none none none none DRAN at-io fol-io none none fol-io none DROT at-io at-io none none none none ADROT at-io at-io none none none none DLNxx at-io at-io none none none none PHDLNxx at-io at-io none none none none UHDLNxx at-io at-io none none none none DREAD radd none none none none none NOTE: 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. modifiers 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 Dxxxxxx at-io at-io at-mod at-mod at-mod at-mod ADxxxxxx at-io at-io at-mod at-mod at-mod at-mod DRAN at-io fol-io at-mod at-mod fol-io at-mod DROT at-io at-io at-mod at-mod at-mod at-mod ADROT at-io at-io at-mod at-mod at-mod at-mod DLNxx at-io at-io at-mod at-mod at-mod at-mod PHDLNxx at-io at-io at-mod at-mod at-mod at-mod UHDLNxx at-io at-io at-mod at-mod at-mod at-mod DREAD radd none radd lcwradd none radd 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_setup; call lset; if tdl.topcd.op_type = 0|tdl.tdtyp = 0 then goto skip_data_setup; if tdl.tdtyp <1|tdl.tdtyp >10 then goto io_data_type_illegal; 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_service; /* go to common code */ io_setup_data(1): if tdl.topcd.op_type =1 then call setup_random_data; /* no setup if not write */ goto skip_data_setup; 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_setup; io_setup_data(3): call setup_octal_data; goto skip_data_setup; io_setup_data(4): if tdl.tdtyps =4 then tdl.tdtyps = 0; call setup_add_to_data; goto skip_data_setup; io_setup_data(5): call setup_data_from_line; goto skip_data_setup; io_setup_data(6): if tdl.tdtyps =6 then tdl.tdtyps = 0; call setup_drot; goto skip_data_setup; io_setup_data(10): if tdl.tdtyps =10 then tdl.tdtyps = 0; call setup_adrot; goto skip_data_setup; io_setup_data(8): call setup_packed_hex_data; goto skip_data_setup; io_setup_data(9): call setup_unpacked_hex_data; io_setup_data(7): skip_data_setup: if cmpflg ^=0 then goto io_setup_cmp; if tdl.topcd.op_type ^= 3 then goto check_for_ram; /* its a read */ if tdl.tcwdl ^=0 then goto check_for_ram; call lset; do dovar1 = 1 to tdl.tdtcal_wc+1; tio.trarea(dovar1) = tdl.tpadwd; end; tio.redpre = tdl.tpadwd; check_for_ram: if tdl.tmiflg ^= 0 then go to io_setup_cmp; /* if manual interventio flag is on then treat as single io*/ if tdl.dual_io_device = 0 then goto io_setup_cmp; if (tdl.do_dual_io = 1) & (tdl.dual_io_count = 0) then goto io_setup_cmp; if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 0) then goto save_first_of_dual; if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 1) then goto io_setup_cmp; inv_data = "inconsistant dual io command setup"; goto say_invalid_instruction; /* */ save_first_of_dual: tio.tskpmb = tdl.tpmb.op_code||tdl.tpmb.dev||"0000001110000"b|| tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.reccnt; tio.tsdcwv = tio.tdcw; tdl.dual_io_count = 1; chgmode = 0; goto tdl.tdlret; /* */ io_setup_cmp: if tdl.tdtyp ^=7 then goto io_setup_trace_dcws; if tdl.tpmb.iom_cmd ^= "0100"b then do; inv_data = "wrong ioc command used with ""loc"" data type"; goto say_invalid_instruction; end; 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.tfdcwp; /* 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_peek; dcw_count = dcw_count +1; dcw_list.dcws(dcw_count) = tdl.tldcw; current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */ if dcw_count > 10 then goto say_dcw_loop; if tdl.tldcw.char = "111"b then goto trace_idcw; if tdl.tldcw.typ = "00"b then goto trace_stop_dcw; if tdl.tldcw.typ = "01"b then goto trace_proceed_dcw; if tdl.tldcw.typ = "10"b then goto trace_branch_dcw; /* must be "11"b non data xfer and proceed */ trace_proceed_dcw: if fmtflg = 1 then do; call set_hbs_bit; end; allow_branch_dcw = 1; /* permit branch now */ goto get_next_dcw; trace_branch_dcw: if allow_branch_dcw = 0 then goto say_branch_bad; allow_branch_dcw = 0; current_dcw_add = addrel(tip,fixed(tdl.tldcw.add)); goto get_next_dcw; trace_stop_dcw: if fmtflg = 1 then do; call set_hbs_bit; end; if continue = 1 then do; continue = 0; goto get_next_dcw; end; if cmpflg ^=0 then go to error_check; if tdl.trace = 0 then goto issue_test_io; tdl.ttyret = issue_test_io; call output_trace(tdp,tip,dcw_count,addr(dcw_list.dcws)); goto main_dispatch_queue_service; /* 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_dcw; 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||"0000001110000"b|| tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.reccnt; /* note that the tpmb iom_cmd is multiplied by two to get iom type cmd */ tio_off = fixed(rel(tdl.tfdcwp)); if tdl.com_per_flag ^=0 then do; pcwa = "000000000000000000111000000000000000"b ; if tdl.tpxdio ^=0 then goto aye_o_go; /* point to first idcw */ substr(tio.ttdcw,19,18) = "000010000000000000"b; substr(tio.ttdcw,1,18) = rel(tdl.tfdcwp); tio_off = fixed(rel(addr(tio.tpcw)));; goto aye_o_go; end; pcwa = tio.tpcw; aye_o_go: /* check for dual io if yes the link firt to second*/ if (tdl.dual_io_device = 1) & (tdl.dual_io_count = 1) then do; 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; end; /* */ tdl.io_in_progress = 1; tdl.io_dispatch = page_reentry; if pdata.simulation = 1 then goto sim_connect; call ioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error); tdl.do_dual_io = 0; if error ^=0 then goto aye_o_error; goto main_dispatch_queue_service; sim_connect: call sioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error); if error = 0 then goto main_dispatch_queue_service; 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_service; 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_check; say_dcw_loop: inv_data = "use of tdcw (cwxby) has caused dcw string loop without iotd (cwxs)"; goto say_invalid_instruction; say_branch_bad: inv_data = "illegal use of tdcw (cwxby), two tdcws in a row"; goto say_invalid_instruction; error_check: pos = ""; if (tdl.tpxdio = 0)&(tdl.eep_tally = 0) then goto not_xdio; tdl.tpxdio = 0; /* ignore ss o/e bit 2ss bits res rec and ae below */ if (bool(string(status),"111111000000010001111111000000000000"b,"0001"b) = "100000000000000000000000000000000000"b)& (tdl.interrupts.timeout = "0"b)&(tdl.interrupts.falt = "0"b) then goto tdl.tdlret; /* 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"b then do; if tdl.gespec = 0 then inv_data = " io timeout on connect"; if tdl.gespec ^= 0 then inv_data = " io timeout waiting for special"; end; tdl.interrupts.falt, tdl.interrupts.timeout = "0"b; tdl.gespec = 0; if tdl.eep_in_progress ^=0 then goto report_eep_error; 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_err; call buffer_tty_output(message,tdl.pageno); goto main_dispatch_queue_service; /* 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||message; goto post_eep_com; 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_page; goto process_options; not_xdio: if (tdl.interrupts.falt = "1"b)|(tdl.interrupts.timeout = "1"b) then do; 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 */ end; 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_interrupts; if tdl.tpmb.op_code = "00"b then goto check_status_and_interrupts; /* request status not positioning */ if fixed(tdl.tpmb.op_code) >31 then goto not_read_or_write; /* 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: lfd cso mmo wcrg wtime diag wrap */ 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_interrupts; not_read_or_write: if tdl.tpmb.op_code = "100101"b|tdl.tpmb.op_code = "100111"b then goto use_explicit_position; if tdl.tpmb.op_code = "100100"b then goto add_record_count; /* fsr */ if tdl.tpmb.op_code = "100110"b then goto sub_record_count; /* bsr */ if tdl.tpmb.op_code = "111000"b| tdl.tpmb.op_code = "111010"b| tdl.tpmb.op_code = "111101"b then goto set_initial; /* rew,rews, or load */ if tdl.tpmb.op_code = "101101"b then goto wef_command; /* wef */ goto check_status_and_interrupts; /* invalid command or non_positioning */ set_initial: tdl.tppos = 0; goto check_status_and_interrupts; add_record_count: if tdl.interrupts.init = "1"b then goto check_status_and_interrupts; tdl.tppos = tdl.tppos + fixed(tdl.tpmb.reccnt); goto check_status_and_interrupts; sub_record_count: if tdl.interrupts.init = "1"b then goto check_status_and_interrupts; tdl.tppos = tdl.tppos - fixed(tdl.tpmb.reccnt); goto check_status_and_interrupts; 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_save; /* get saved fsf,bsf, or bkf data */ goto check_status_and_interrupts; /* op_code map for tape positioning opcd. td11ca td12ca td13ca td14ca 00 req req req req 01 02 03 rtn rtn 04 rtd rtd rtd rtd 05 rtb rtb rtb(lfd *) rtb(lfd *) *= dev. # mb = 0 06 rrtd rrtd rrtd rrtd 07 rrtb rrtb rrtb rrtb 10 cso*** cso*** 11 mmo*** mmo*** *** = illegal 12 13 wtn wtn 14 wtd wtd wtd wtd 15 wtb wtb wtb wtb 16 wcrg*** wcrg*** 17 20 21 22 23 24 rebc 25 rase 26 rcrg rcrg 27 rasc 30 wtime*** wtime*** 31 diag*** diag*** 32 wrap*** wrap*** 33 34 webc 35 wase 36 37 wasc 40 res res res res 41 42 shd shd 43 sld sld 44 fsr** fsr** fsr** fsr** ** = uses record count 45 fsf fsf fsf fsf 46 bsr** bsr** bsr** bsr** ** = uses record count 47 bsf bsf bsf bsf 50 rqs rqs 51 rss rss 52 53 54 ers ers ers ers 55 wef wef wef wef 56 57 survd* survd* *= dev. # mb = 0, also illegal for polts 60 shd shd shd shd 61 sld sld sld sld 62 sfp sfp sfp sfp 63 sfpm sfpm 64 set2 set2 65 set16 set16 66 resv*** resv*** 67 relc*** relc*** 70 rwd rwd rwd rwd 71 72 rews rews rewu rewu 73 74 75 load load 76 77 */ /* 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_error; if tdl.interrupts.init ^= tdl.testat.expected_interrupts.init then goto interrupts_error; goto interrupts_ok; /* presume ok */ /* if tdl.interrupts.spec = tdl.testat.expected_interrupts.spec then goto interrupts_ok; 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_ok; 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_occured; tdl.tinint = 1; goto check_non_data_io; no_init_int_occured: if tdl.tnrflg =0 then goto check_non_data_io; 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_done; /* non-data */ if tdl.tpmb.iom_cmd ^= "0100"b then goto not_sing_char_ioc_cmd; goto error_check_done; not_sing_char_ioc_cmd: if tdl.tinint ^= 0 then goto error_check_done; if tdl.tnmflg ^= 0 then goto check_read; if tdl.tnrflg = 0 then goto check_res_wc; goto check_res_add; check_res_wc: if tdl.dcwres.wrd = tdl.trwrd then goto check_res_add; if (tdl.trwrd = "000000000000"b| tdl.topcd.op_type = 3) = "0"b then goto check_read; tdl.terflg = 1; check_res_add: if tdl.dcwres.wrd ^="000000000000"b then goto check_read; if tdl.tesmb.add = tdl.dcwres.add then goto check_read; tdl.terflg = 1; check_read: if tdl.topcd.op_type ^=3| tdl.tncflg ^=0 then goto error_check_done; current_dcw_add = tdl.tfdcwp; /* start with first dcw */ tdl.tldcw = current_dcw_add->dcw_peek; /* pre_fol word check here */ if tdl.tdtyp ^=1 then goto dont_initialize_random; dvran = addrel(tip,tdl.tldcw.add)->data_peek.data; /* get first word of write area */ if fixed(tdl.tdata) ^= 0 then dvran = tio.tadwd; /* use address as data */ if tdl.tpsflg = 0 then goto no_pos_check; /********************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),"111111111111111111"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_check; /* 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_good; if substr(addrel(tip,tdl.tldcw.add)->data_peek.data,1,18) = bool(substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18),"111111111111111111"b,"1100"b) then goto position_error; /* must be data error */ pos = "---"; goto no_pos_check; 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),"111111111111111111"b,"1100"b)||bit(fixed(tdl.tppos,18),18); /* set dvran to this position */ tdl.terflg = 1; goto no_pos_check; 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_peek; dcw_count = dcw_count +1; current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */ if dcw_count > 10 then goto say_dcw_loop; /* should be a different error---a disaster*/ if tdl.tldcw.typ = "00"b then goto check_stop_dcw; if tdl.tldcw.typ = "01"b then goto check_proceed_dcw; if tdl.tldcw.typ = "10"b then goto check_branch_dcw; /* must be "11"b non data xfer and proceed */ goto check_ndt_and_proceed; check_proceed_dcw: call check_data; check_ndt_and_proceed: allow_branch_dcw = 1; /* permit branch now */ goto select_next_dcw; check_branch_dcw: if allow_branch_dcw = 0 then goto say_branch_bad; /* should be a different error--a disaster*/ allow_branch_dcw = 0; current_dcw_add = addrel(tip,fixed(tdl.tldcw.add)); goto select_next_dcw; check_stop_dcw: call check_data; goto error_check_done; check_data:proc; 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_read; do dovar2 = 1 to tdl.tdtcal_wc; tio.twarea(tdl.tdtcal_reladd+dovar2) = dvran; call compute_random; end; not_random_read: do dovar1 = 1 to tdl.tdtcal_wc; if trarea(dovar1+tdl.tdtcal_reladd) = twarea(dovar1+tdl.tdtcal_reladd) then goto data_good; if tdl.tchmsk ^= "000000000000000000000000000000000000"b& tdl.tldcw.typ = "00"b& dovar1= tdl.tdtcal_wc then do; if bool(trarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b) = bool(twarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b) then goto data_good; end; tdl.tdecnt = tdl.tdecnt+1; /* bump data error count */ data_good: end; end check_data; 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_check; if (tdl.status.pwr ^= "0"b|tdl.status.major_status = "0010"b) ="0"b then goto not_man_intervention; if tdl.endng ^= 0 then goto not_man_intervention; /* dont service manual intervention if in forced term test */ if tdl.status.pwr ^= "0"b then goto in_man_intervention; if tdl.status.major_status ^= tdl.testat.major_status then goto in_man_intervention; not_man_intervention: if tdl.tmiflg ^=0 then goto end_man_intervention; if tdl.trflg = 0 then goto no_tran_request; /* "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.trycnt; 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_error; /* 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 then do; tdl.pastrn.read = tdl.pastrn.read + tdl.trcnt; tdl.cyctrn.read = tdl.cyctrn.read + tdl.trcnt; tdl.tottrn.read = tdl.tottrn.read + tdl.trcnt; end; else do; tdl.pastrn.write = tdl.pastrn.write + tdl.trcnt; tdl.cyctrn.write = tdl.cyctrn.write + tdl.trcnt; tdl.tottrn.write = tdl.tottrn.write + tdl.trcnt; end; tdl.trcnt = 0; goto check_for_options_after_error_check; 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_request; /* 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 then goto unrecoverable; if tdl.traner = 0 then goto enter_transient_recovery; /* the transient message output is requested */ tdl.tdlret = enter_transient_recovery; tdl.add_tran = 2; /* special flag to add transient message */ goto complete_transient_message; enter_transient_recovery: if tdl.topcd.op_type ^=3 then goto enter_write_recovery; if tst.linetab(tdl.tsubr+1) ^=0 then goto invalid_tran_line; tdl.line_number = tdl.tsubr; goto nxlin; /* enter the transient routine */ enter_write_recovery: if tst.linetab(tdl.tsubw+1) ^=0 then goto invalid_tran_line; tdl.line_number = tdl.tsubw; goto nxlin; /* enter the transient routine */ invalid_tran_line: inv_data = "transient error recovery subroutine is a non_tdl line"; goto say_invalid_instruction; unrecoverable: if tdl.topcd.op_type = 3 then do; tdl.pastrn.read = tdl.pastrn.read + tdl.trcnt; tdl.cyctrn.read = tdl.cyctrn.read + tdl.trcnt; tdl.tottrn.read = tdl.tottrn.read + tdl.trcnt; end; else do; tdl.pastrn.write = tdl.pastrn.write + tdl.trcnt; tdl.cyctrn.write = tdl.cyctrn.write + tdl.trcnt; tdl.tottrn.write = tdl.tottrn.write + tdl.trcnt; end; tdl.add_tran = 1; /* special flag for unrecoverable message */ goto complete_transient_message; no_tran_request: if tdl.terflg = 0&tdl.tdecnt = 0 then goto check_for_options_after_error_check; tdl.toterr.sta = tdl.toterr.sta + tdl.terflg; tdl.cycerr.sta = tdl.cycerr.sta + tdl.terflg; tdl.paserr.sta = tdl.paserr.sta + tdl.terflg; tdl.toterr.dat = tdl.toterr.dat + tdl.tdecnt; tdl.cycerr.dat = tdl.cycerr.dat + tdl.tdecnt; tdl.paserr.dat = tdl.paserr.dat + tdl.tdecnt; tdl.taeflg = 1; /* set any error flag */ complete_transient_message: if tdl.bypass ^=0 then goto check_for_options_after_error_check; man_intervention_started: tdl.ttyret = check_for_options_after_error_check; call error_output(tdp,pos); if tdl.teepopt ^=0&tdl.eep_line_no ^=0&tdl.tmiflg=0&tdl.endng = 0 then goto start_eep; /* message not yet issued */ /* dont start eep if in forced term test */ goto main_dispatch_queue_service; /* goto common code */ start_eep: tdl.eep_in_progress = 1; tdl.eep_talpha = tdl.talpha; tdl.eep_tnmbr = tdl.tnmbr; tdl.eep_tnmwrd = tdl.tnmwrd; tdl.eep_next_field_number = tdl.next_field_number; tdl.eep_per_op_number = tdl.per_op_number; tdl.eep_line_number = tdl.line_number; tdl.eep_tlscan = tdl.tlscan; tdl.eep_inst_index = tdl.inst_index; tdl.eep_tdlret = tdl.tdlret; tdl.line_number = tdl.eep_line_no; goto nxlin; end_man_intervention: tdl.tmiflg = 0; goto restart; in_man_intervention: if tdl.tmiflg ^=0 then goto not_first_intervention; tdl.toterr.sta = tdl.toterr.sta + tdl.terflg; tdl.cycerr.sta = tdl.cycerr.sta + tdl.terflg; tdl.paserr.sta = tdl.paserr.sta + tdl.terflg; tdl.toterr.dat = tdl.toterr.dat + tdl.tdecnt; tdl.cycerr.dat = tdl.cycerr.dat + tdl.tdecnt; tdl.paserr.dat = tdl.paserr.dat + tdl.tdecnt; tdl.taeflg = 1; /* set any error flag */ tdl.tmiflg = 1; goto man_intervention_started; not_first_intervention: tdl.tmiflg = tdl.tmiflg +1; if tdl.tmiflg >= 128 then goto reset_man_intervention; man_intervention_loop: tdl.tmnem = "res "; check = 32; goto per_op_common; reset_man_intervention: tdl.tmiflg = 1; goto man_intervention_started; check_for_options_after_error_check: if tdl.tmiflg ^=0 then goto man_inter_options; if tdl.opt = 0 then goto tdl.tdlret; tdl.optrtn = tdl.tdlret; goto process_options; man_inter_options: if tdl.opt = 0 then goto man_intervention_loop; tdl.optrtn = man_intervention_loop; goto process_options; setup_random_data:proc; if fixed(tdl.tdata) ^= 0 then dvran = tio.tadwd; /* use address as data */ if tdl.tpsflg ^=0 then dvran = bool(bit(fixed(tdl.tppos+1,18),18),"111111111111111111"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_wc; tio.twarea(data_setup_reladd+dovar1) = dvran; call compute_random; end; end setup_random_data; setup_octal_data:proc; tdl.tdtyp = 0; do dovar1 = 1 to data_setup_wc; tio.twarea(data_setup_reladd+dovar1) = tdl.tdata; end; end setup_octal_data; setup_add_to_data:proc; tdl.tdtyp = 0; do dovar1 = 1 to data_setup_wc; tio.twarea(data_setup_reladd+dovar1) = bit(fixed((fixed(tdl.tdata) + fixed(tio.twarea(data_setup_reladd+dovar1))),36)); end; end setup_add_to_data; setup_data_from_line:proc; tdl.tdtyp = 0; work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14)); /* note: 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_line; end; fix_bit = 0; do dovar1 = 1 to tdl.tdtcal_wc; 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; end setup_data_from_line; not_test_data_line: inv_data = "dln data is not all from test data line"; goto say_invalid_instruction; setup_drot:proc; 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_drot; setup_adrot:proc; 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_adrot; setup_packed_hex_data:proc; tdl.tdtyp = 0; work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14)); /* note: 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_line; end; 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_line; if mod(dovar1,54) = 0 then fix_bit = fix_bit+30; end; fix_bit = 0; do dovar1 = 1 to tdl.tdtcal_wc; 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; end setup_packed_hex_data; setup_unpacked_hex_data:proc; tdl.tdtyp = 0; work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14)); /* note: 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_line; end; 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_line; if mod(dovar1,54) = 0 then fix_bit = fix_bit+30; end; fix_bit = -30; /* preset for first bump */ do dovar1 = 1 to tdl.tdtcal_wc; if mod(dovar1,27) = 1 then fix_bit = fix_bit+30; byte1 = "0"b|| 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; byte2 = "0"b|| 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; byte3 = "0"b|| 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|| "0"b|| 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; end setup_unpacked_hex_data; invalid_hex_line: inv_data = "invalid hexidecimal character in uhdln or phdln"; goto say_invalid_instruction; compute_random:proc; 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_random; page_initialize: call init_page; if tdl.initreq ^=-1 then goto select_next_test_or_seg_or_start_or_end; tdl.initreq = 0; start_test: tdl.lst = tdl.nxt; 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 = "000000000000000000000000000000000000"b; tdl.tpadwd = "101010101010101010101010101010101010"b; goto nxlin; /* goto the next line */ init_page:proc; tdl.tdtyps,tdl.tcwdls = 0; tdl.tdatas = "000000000000000000000000000000000000"b; tdl.tpmbs.chan = tdl.tpaddp; dvran = "001010011100101110110101100011010001"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); end; tdl.tdcws.wc = tst.max; tio.tdcw.char ="000"b; tio.tdcw.w_c = "0"b; tio.tdcw.typ = "00"b; chgmode, tdl.terflg, tdl.taeflg, tdl.tcwdl, tdl.tpsflg = 0; do dovar1 = 1 to 101; tdl.loopct(dovar1) = 0; end; do dovar1 = 1 to 10; tdl.tsfld(dovar1) = -1; tdl.tscnt(dovar1) = 0; end; end init_page; set_hbs_bit:proc; fmtflg = 0; substr(addrel(tip,tdl.tldcw.add)-> bits,34,1)= "1"b; skip_hbs_set: end set_hbs_bit; end_page: tdl.test_no_to_jump_to = tst.trm; /* select term test */ tdl.doing_force = 1; tdl.endng = 1; tdl.force = 1; goto force_test; process_options: call options(tdp,tpp,check); if tdl.wait ^= 0 then goto wait_loop; if check ^=0 then goto tdl.optrtn; goto main_dispatch_queue_service; wait_loop: if tdl.wait = 0 then goto process_options; /* wait broken by options request */ /* note that the place to return from after .wait is broken is tdl.optrtn */ tdl.clock_dispatch = wait_loop; tdl.clock_going = 1; /* set clock going */ call timer_manager_$alarm_wakeup(60000000,"10"b,tdl.clock_event); /* time is in micro seconds 60000000 = 1 min */ 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_service; /* 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_number; fieldno = tdl.next_field_number - 1; tdl.rtnopt = process_options; tdl.optrtn = restart; 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_write; /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 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). Example: seg.a seg.b seg.c table table table fst=0 pos. 1(test 1) fst=5 pos. 1(test 6) fst=8 pos. 1(test 9) end=5 pos. 2(test 2) end=8 pos. 2(test 7) end=12 pos. 2(test 10) trm=6 pos. 3(test 3) trm=9 pos. 3(test 8) trm=12 pos. 3(test 11) pos. 4(test 4) pos. 4(force term) pos. 4(test 12 pos 5(test 5) force and pos. 6(force term) normal 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 segments. 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 called. 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_init; if tdl.nxt ^= -1 then goto select_test; tdl.nxt,tdl.lst = 0; /* flag initialization done */ if tdl.initreq ^= 0 then goto say_end_cycle; 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_initialize; goto request_and_wait_for_tty_write; say_end_cycle: tdl.cyccnt = tdl.cyccnt + 1; if tdl.halt ^=0 then goto do_say_end_cycle; if tdl.bypass ^=0 then goto page_initialize; 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_initialize; tdl.cycerr.sta, tdl.cycerr.dat = 0; if (tdl.cyctrn.read ^=0)|(tdl.cyctrn.write ^=0) then do; 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; end; goto request_and_wait_for_tty_write; 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) then do; 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; end; tdl.ttyret = start_test; goto request_and_wait_for_tty_write; 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_page; 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_end; select_test: if tdl.doing_force = 1 then goto find_first_in_sequence; if tdl.opt = 0 then goto sequence_test; tdl.optrtn = sequence_test; goto process_options; sequence_test: call test_seq_init; if tdl.nxt = 0 then goto dont_loop_on_test_0; if loop ^=0 then goto loop_test; dont_loop_on_test_0: goto find_next_test; 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_jump; /* dont use jump */ if tdl.test_no_to_jump_to - tst.fst = tst.testab(dovar1+2) then goto jump_test_exists; no_check_jump: end; goto say_jumping_to_test_not_in_current_sequence; /* check to see if new location in test sequence is <= current sequence location. end pass condition if yes */ jump_test_exists: if (dovar1+3)/4 >= tdl.nxt then goto not_back_jump; passck = 1; /* reset test sequencing to new location */ not_back_jump: tdl.nxt = (dovar1+3)/4; goto loop_test; restart: call test_seq_init; goto loop_test; skip_test: call test_seq_init; did_skip = 1; goto find_next_test; force_test: call test_seq_init; if test_no_to_jump_to >=(tst.fst+1)&test_no_to_jump_to <= tst.end then goto find_first_in_sequence; if tdl.endng ^=0 then goto find_first_in_sequence; /* must be .test e */ the_char = "9"; /* index to first segment */ try_next_segment: 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_page; if test_no_to_jump_to ^> tst.end then goto new_segment_common; /* if above---found segment */ if tst.trm = tst.end then goto say_jumping_to_test_not_in_current_sequence; /* no such test */ the_char = substr(tst.name,6,1); /* next segment */ goto try_next_segment; find_next_test: if tdl.nxt+1 > (tst.end-tst.fst) then goto get_next_segment; 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_sequence; if tst.testab((tdl.nxt-1)*4+2) = 0 then goto not_sequenced_jump; tdl.test_no_to_jump_to = tst.testab((tdl.nxt-1)*4+3); /*select test # to jump to*/ goto find_first_in_sequence; not_sequenced_jump: if tdl.doing_force ^=0 then goto select_test_at_line; /* 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_test; select_test_at_line: if tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+1) >1 then goto find_next_test; /* 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_test; if passck = 0 then goto check_for_inform; if tdl.pass =0 then goto check_for_inform; tdl.pascnt = tdl.pascnt + 1; if tdl.halt ^=0 then goto say_end_pass; if tdl.bypass = 0 then goto say_end_pass; check_for_inform: if tdl.inform = 0 then goto start_test; if did_skip ^=0 then goto start_test; /* endts polts name */ pnum = substr(page_no_char,tdl.pageno,1); last_test_no = tst.fst; /* preset in case test #0 last */ if tdl.lst = 0 then goto test_zero_last; last_test_no = tst.testab((tdl.lst-1)*4+3)+tst.fst; /*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_message; tdl.optrtn = start_test; tdl.rtnopt = process_options; 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_test; goto request_and_wait_for_tty_write; test_seq_init:proc; tdl.lst = tdl.nxt; did_skip, passck, non_exec_count, tdl.eep_in_progress =0; end test_seq_init; say_invalid_test_sequencing: tdl.doing_force = 0; tdl.optrtn = restart; tdl.rtnopt = process_options; 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_common; say_no_executable_tests_in_sequence: inv_data = "no executable tests in this sequence"; goto say_invalid_test_sequencing; say_jumping_to_test_not_in_current_sequence: inv_data ="trying to jump to a test not in current sequence"; goto say_invalid_test_sequencing; /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ subroutines */ lcset: if tio.tdcwr(tdl.tcwdl).char = "111"b|tio.tdcwr(tdl.tcwdl).typ = "10"b then goto lcset_error; 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 then goto nxfld; /* was a read */ tdl.tfdcwp = addrel(addr(tio.tdcww(1)),(tdl.tcwdl-1)); /* point to write dcw */ goto nxfld; lcset_error: inv_data = "cannot use tdcw or idcw as first dcw"; goto say_invalid_instruction; lset:proc; data_setup_reladd = tdl.tdtcal_reladd; data_setup_wc = tdl.tdtcal_wc; end lset; dtypst: /* 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)); call chgorl; call lset; if tdl.tdtyp <1|tdl.tdtyp >10 then goto bad_data_type; 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_service; /* go to common code */ dtypst_data_setup(1): call setup_random_data; dtypst_data_setup(7): goto nxfld; dtypst_data_setup(3): call setup_octal_data; goto nxfld; dtypst_data_setup(4): call setup_add_to_data; goto nxfld; dtypst_data_setup(5): call setup_data_from_line; goto nxfld; dtypst_data_setup(6): call setup_drot; goto nxfld; dtypst_data_setup(8): call setup_packed_hex_data; goto nxfld; dtypst_data_setup(9): call setup_unpacked_hex_data; goto nxfld; dtypst_data_setup(10): call setup_adrot; goto nxfld; chgorl:proc; if tdl.tcwdl ^=0 then return; if chgmode <= 0 then goto nxfld; /* CHG or not prev per-op */ if tdl.topcd.op_type ^= 0 then goto nxfld; /* nd */ end chgorl; call_from_page:proc; callname = tdl.call_page; /* page to call */ call tpinit(callname,tptr,error); if error = 0 then goto good_init; if error ^=1 then goto main_dispatch_queue_service; /* 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_service; /* go to common code */ good_init: free tst; /* free old test page */ tpp = tptr; /* new pointer */ tdl.page_ptr = tpp; end call_from_page; */ ----------------------------------------------------------- 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 (1963-1970), 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 */