|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 125184 (0x1e900)
Types: TextFile
Names: »tprimo«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tprimo«
! *** tprimo ***
;
;
; niels møller jørgensen, june 1978.
; revision 2, feb. 1979.
; revision 2.1, nov. 1979. knud christensen
!
printermodule
begin
!fp.no;
!branch 2,10;
!sections 44;
procedure waitmess
(.w3.; ! abs ref curr corout (return) !
w2); ! abs ref message buffer (return) !
procedure sendwait
(.w3.; ! abs ref curr corout (return) !
w0 ; ! result (return) !
w1 ; ! abs ref message (call) !
w2); ! abs ref process name (call) !
procedure link
(.w3.; ! abs ref curr corout (return) !
w1 ; ! abs ref queue element (call) !
w2); ! abs ref queue head (call) !
procedure move
(.w3.; ! abs ref curr corout (return) !
w0 ; ! number of halfwords to move (call) !
w1 ; ! abs ref first halfword to move (call) !
w2); ! abs ref destination (call) !
procedure opmess
(.w3.;
w1); ! abs ref message (call) !
procedure get_branches
(.w3.; ! abs ref curr corout (return) !
w0); ! coroutine number !
procedure copyanswer
(.w3.;
w0; ! first of data area (call) !
! result from copy core (return) !
w1; ! last of data area (call) !
! no of bytes copied (return) !
w2); ! message buffer (call) !
procedure compare
(.w3.; ! abs ref curr corout (return) !
w0 ; ! no of bytes to compare (call) !
! =0 the bytes are equal !
w1 ; ! abs ref 1. string !
w2); ! abs ref 2. string !
procedure outtime
(.w3.; ! return (call) !
w2); ! abs ref string (call) !
! all registers unchanged !
procedure testout
(.w3.; ! return (call) !
w0 ; ! record length (call) !
w1 ; ! abs ref start of test record (call) !
w2); ! record kind (call) !
procedure create_tc
(.w3.;
ref ct_tc,
ct_devname; ! device name from entry !
word ct_hostno,ct_hostid;
ref ct_procref); ! abs ref ext. process descr. !
procedure remove_tc
(.w3.;
ref rt_tc);
procedure find_tc
(.w3.;
ref ft_devname;
word ft_hostno,ft_hostid;
word ft_kind; ! kind of device !
w1); ! result (return) !
! >0: abs ref tc found !
! =0: tc not found, no free tc !
! <0: tc not found, -abs ref free tc !
procedure looktransport
(.w3.; ! abs ref curr corout (return) !
w1 ; ! name of transport (call) !
w2); ! abs ref core address !
! -1 if name illegal !
! 0 if unknown (return) !
procedure puttransport
(.w3.;
w1); ! name of transport !
procedure ioworkarea
(.w3.;
w1); ! message address (call) !
procedure linkupremote
(.w3.;
word lur_kind;
word lur_hostno, lur_hostid; ref lur_deviname;
w0 ; ! return value from host proc (return) !
w2); ! ref proc descr adr (return) !
procedure init
(.w3.); ! abs ref curr corout (return) !
procedure freetransport
(.w3.;
w1; ! name of transport (return) !
w2); ! abs ref core address !
! 0 if no free transport (return) !
procedure deftr_semantic
(.w3.; ! abs ref curr corout (return) !
w0 ; ! result , internal value (return) !
w1 ; ! abs ref transport coroutine (return) !
w2); ! abs ref transport desc. in core (call) !
procedure appl_interface
(.w3.);
procedure nextchar
(.w3.;
word stp; ! abs ref word next to last input word !
w0 ; ! next char (return) !
w1 ; ! partial word (call,return) !
w2); ! abs ref next input word (call,return) !
procedure nextparam
(.w3.;
ref paramref, ! ref to param area 4 words !
stopbuf; ! abs ref word next to last inp.word !
w0; ! paramtype (return !
! -1 = syntax error !
! 0 = no param !
! 1= text !
! 2= @text !
! 3= positiv integer !
w1; ! partial word (call,return) !
w2); ! abs ref next inp.word (call,return) !
procedure lookupremote
(.w3.;
ref lur_function, ! 2=lookup process, 3= lookup !
lur_procnameref, lur_devname;
w0; ! return value from host proc (return) !
w1; ! kind !
w2); ! abs ref area to put host address: !
! dhlinkno<12+hostno, hostid !
procedure terminalid
(.w3.; ! abs ref curr corout (return) !
w0; ! device host link no (call) !
w2); ! abs ref area to put device name (call) !
procedure find_consoldevice
(.w3.; ! abs ref curr corout (return) !
w0; ! 1= local 2= remote (call) !
w1; ! abs ref console name (call) !
! return: !
! >0 abs ref transp. corout !
! =0 not found !
! <0 removed but signed up by operator !
w2); ! abs ref device name (call) !
procedure operator
(.w3.); ! return (pseudo call) !
procedure get_block
(.w3.; ! abs ref curr corout (return) !
w0; ! max no of hwords in block (call) !
! no of hword in block (return) !
w1; ! abs ref buffer first !
w2); ! status (return) !
procedure put_block
(.w3.; ! abs ref curr corout (return ) !
w0; ! no of hwords in block (call) !
! no of hwords actually put (return) !
w1; ! abs ref buffer (call) !
w2); ! status (return) !
procedure closebs
(.w3.); ! abs ref curr corout (return) !
procedure hold
(.w3.); ! abs ref curr corout (return) !
procedure oproutput
(.w3.; ! abs ref curr corout (return) !
w0 ; ! call !
! = 1 pending output !
! = 2 error output !
! return: undefined !
w1 ; ! call: text code !
! return: undefined !
w2); ! call: status !
! return: console status !
procedure updatetransport
(.w3.); ! abs ref curr corout (return) !
procedure check_devicestatus
(.w3.; ! abs ref curr corout (return) !
w0; ! answer result from monitor (call) !
w1; ! abs ref answer (call) !
w2); ! modified status (algol manner) (return) !
procedure prlistid
(.w3.; ! abs ref curr corout (return) !
w0); ! no of halfwords in block (return) !
procedure prlistdate
(.w3.; ! abs ref curr corout(return) !
w0); ! no of halfwords in block (return) !
procedure pr
(.w3.); ! return (pseudo call) !
procedure pc
(.w3.); ! pseudo call !
procedure rd
(.w3.); ! pseudo call !
procedure tw
(.w3.); ! pseudo call !
label central_wait,wait_next,coru_found,activate,initialize,
interrupt,unin;
record controlmess
(ref cm_next,cm_prev,cm_receiver,cm_sender;
byte cm_op,cm_mode);
record coroutine
(ref c_next,c_prev,c_mbuf;
word c_w0,c_w1,c_w2;
ref c_ic;
word c_nr);
record transpcorout
(array(1:!length(coroutine)) tc_fill of byte;
ref tc_nexttc; ! static link to next transport coroutine !
byte tc_created, ! = 0 if the coroutine is idle !
tc_kind; ! kind of slow device !
ref tc_nexttr,tc_prevtr; ! queue head of transport queue !
ref tc_buf;
word tc_bufsize;
word tc_hostno,tc_hostid;
text(11) tc_devname; ! device name ( defined in entry ) !
text(14) tc_name; ! name of external process !
text(14) tc_console; ! process name of opr. console !
text(11) tc_devcons; ! device name of operator if remote !
word tc_ointervent; ! = 0 no intervention from operator or appl. !
! <>0 <free param> shift +<command> !
word tc_aintervent; ! = 0 no intervention from appl. !
! <> 0 intervention from appl. !
byte tc_state,tc_cause;
word tc_status;
byte tc_mode;
word tc_bsl,tc_bsu;
text(14) tc_bsname;
text(11) tc_qgroup,tc_qname;
word tc_transno,tc_bsptr;
ref tc_saveic);
record prcorout
(array (1:!length(transpcorout)) pr_fill of byte;
word pr_inpstate;
byte pr_workffs,pr_worknls;
word pr_partial,pr_workptr,pr_workstartptr);
record pccorout
(array(1:!length(transpcorout)) pc_fill of byte;
word pc_inpstate);
record rdcorout
(array(1:!length(transpcorout)) rd_fill of byte;
word rd_inpstate);
record twcorout
(array(1:!length(transpcorout)) tw_fill of byte;
word tw_inpstate);
record oprcorout
(array(1:!length(coroutine)) opr_fill of byte;
ref opr_buf;
word opr_savew1;
text(14) opr_console);
record tr_descr
(text(11) tr_name,tr_user,tr_sname,tr_rname,tr_bsarea;
byte tr_mode, tr_kind;
word tr_basel,tr_baseu;
word tr_bsstartptr; ! start position in bs area !
text(11) tr_qgroup, tr_qname;
ref tr_corou; ! abs ref core adr of transport coroutine !
word tr_state, tr_cause, tr_status, tr_charposition;
ref tr_waitmess;
word tr_removetime); ! 8388607 transport not terminated !
! 8388606 transp. not terminated, release descr. when finished !
! <8388606 transport terminated, the value indi- !
! cates when the descr is free again !
! unit=clock shift -20 = shortclock shift -1 !
record bufhead
(byte buf_op,buf_mode;
ref buf_first,buf_last;
word buf_data1);
record queuerec ! structure of element in transport coroutine queue !
(ref tq_next,tq_prev;
word tq_transno);
record opcom
(byte opop,opmode;
text(5) optext1;
word logstatus;
text(11) optext2);
incode
word event_res;
ref current:=0,
event:=0,
activqfst,activqlast,
answerqfst,answerqlast,
waitqfst,waitqlast,
holdqfst,holdqlast,
tqfreefst,tqfreelast; ! head of idle transport queue elements !
ref apl_fst;
ref opr_fst, opr_top;
ref tcpool_fst, tcpool_top;
word trans_first,trans_top; ! position of transport descriptions on bs !
word trans_old:= -1; ! position on description area of last last free transp. !
byte testmop:=5,testmode:=0;
ref testmfst,testmlast;
word testsegm:=0,maxtestsegm;
double starttime;
byte bs_op,bs_mode;
ref bs_first,bs_last;
word bs_segno;
word waitbufs;
double trsaveperiod; ! period to save transp.descr after termination of !
! transport operation !
byte prheadtrail, ! = 0 no header and trailer page on printer lists !
! <>0 header and trailer page on printer lists !
oprtdetails; ! <>0 output details to operator !
word prlpage; ! max number of lines pr printer page !
word ans_status,ans_bytes,ans_chars,ans4,ans5,ans6,ans7,ans8;
byte faultop:=4,faultmode:=1;
text(20) faulttxt:="***fault";
byte spcomop:=2,spcommode:=8'1001;
text(8) spcomtext:="status";
text(14) spoolname;
byte tstcomop:= 2, tstcommode:= 8'1000;
text(8) tstcomtext:="status";
text(14) testname;
ref firstfree,procconsole;
word oprt_bufl:= 76;
ref curropr, freeopr; ! work variables used by central logic !
begin
interrupt:
firstfree:= w1;
procconsole:= w2;
w3:=address(interrupt);
w0:= 0;
monitor(0); ! set interrupt address !
goto initialize;
w1+0; w1+0; ! fill up interrupt area !
testout(.w3.,w0:=16,w1:=address(interrupt),w2:=15);
opmess(.w3.,w1:=address(faultop));
initialize:
!get 2;
init(.w3.); ! call init for allocating and initializing buffers, !
! descriptors, semaphores etc. !
goto activate;
central_wait:
w2:=0; ! base of event queue !
wait_next:
w3:= 0;
current:= w3;
monitor(24); ! wait next event !
event:=w2;
event_res:= w0;
testout(.w3.,w0:=24,w1:=w2,w2:=6);
w1:= 66;
comment testout(.w3.,w0:=34,w1:=(w1).word,w2:=8);
w2:=event;
if w0 := event_res = 1 then
begin ! an answer has arrived in event queue !
w1:=address(ans_status);
monitor(18); ! wait answer (take the answer home) !
w1:=answerqfst;
while w3:=address(answerqfst) <> w1 do
begin ! scan answer queue to find corresponding sender !
if w2 = (w1).c_mbuf then
begin ! activate waiting coroutine !
(w1).c_w0:=w0;
goto coru_found;
end;
w1:=(w1).c_next;
end;
goto central_wait;
end ! answer !
else
begin ! message has arrived in event queue !
if w0:= (w2).cm_op = 7 then
begin ! control message !
w1:= apl_fst;
if w0:=(w1).c_mbuf>=0 then goto wait_next;
(w1).c_w2:= w2;
(w1).c_mbuf:= w2;
monitor(26); ! get event !
goto coru_found;
end
else
if w0=0 then
begin ! att message !
w0:= 0; freeopr:= w0;
if w2:=(w2).cm_sender<=0 then goto unin;
w2+2;
w1:= opr_top;
while w1-!length(oprcorout)>=opr_fst do
begin
curropr:= w1;
if w0:=(w1).c_mbuf<0 then
freeopr:= w1
else
begin ! reject if a session is allready going on !
compare(.w3.,w0:=8,w1:=address((w1).opr_console),w2);
if w0=0 ! match ! then goto unin;
end;
w1:= curropr;
end;
if w3:=freeopr=0 then goto unin;
move(.w3.,w0:=8,w1:=w2,w2:=address((w3).opr_console));
w1:= freeopr;
w2:= event;
(w1).c_w2:= w2;
(w1).c_mbuf:= w2;
monitor(26); ! get event !
goto coru_found;
end
else
begin ! operation illegal !
unin:
ans_status:= w0:= 0;
ans_bytes:= w0;
ans_chars:= w0;
w0:= 3;
w1:= address(ans_status);
w2:=event;
monitor(22); ! send answer !
testout(.w3.,w0:=2,w1,w2:=60);
goto central_wait;
end;
end; ! message !
coru_found:
link(.w3.,w1,w2:=address(activqfst));
activate:
w1:=address(activqfst);
if w3:=(w1).c_next=w1 then goto central_wait;
current:= w3;
get_branches(.w3.,w0:=(w3).c_nr);
testout(.w3.,w0:=!length(prcorout),w1:=current,w2:=11);
w0:= (w3).c_w0;
w1:= (w3).c_w1;
w2:= (w3).c_w2;
call w0 current.c_ic;
end; ! main program !
body of waitmess
begin
incode
ref return;
begin
return:=w3;
w3:=b.current;
(w3).c_w0:=w0;
(w3).c_w1:=w1;
(w3).c_ic:=w0:=return;
w0:=-1; (w3).c_mbuf:= w0;
link(.w3.,w1:=w3,w2:=address(b.waitqfst));
testout(.w3.,w0:=!length(coroutine),w1,w2:=62);
goto b.activate;
end;
end; ! waitmess !
body of sendwait
begin
incode
ref return;
begin
return:=w3;
w3:=b.current;
(w3).c_w1:=w1;
(w3).c_w2:=w2;
w3:=w2;
monitor(16); ! send message !
w1:=b.current;
(w1).c_mbuf:=w2;
(w1).c_ic:=w0:=return;
link(.w3.,w1,w2:=address(b.answerqfst));
testout(.w3.,w0:=6,w1:=(w3).c_w1,w2:=63);
goto b.activate;
end;
end; ! sendwait !
body of link
begin
incode
double savef1;
word savew2;
ref return;
begin
savef1:=f1;
savew2:=w2;
return:=w3;
! remove queue element from actual queue !
w3:=(w1).c_prev;
(w3).c_next:=w0:=(w1).c_next;
w3:=(w1).c_next;
(w3).c_prev:=w0:=(w1).c_prev;
! link up element as the last element in the queue !
(w1).c_prev:=w3:=(w2).c_prev;
(w1).c_next:=w2;
(w2).c_prev:=w1;
(w3).c_next:=w1;
f1:=savef1;
w2:=savew2;
w3:=b.current;
call w0 return;
end;
end; ! link !
body of move
begin
incode
double savef1;
word savew2;
ref return;
begin
savef1:=f1;
savew2:=w2;
return:=w3;
w3:=w1+w0;
while w1 < w3 do
begin ! move from w1 to w2, one word at a time !
(w2).word:=w0:=(w1).word;
w1+2;
w2+2;
end;
f1:=savef1;
w2:=savew2;
w3:=b.current;
call w0 return;
end;
end; ! move !
body of opmess
begin
incode
double savef1,savef3;
text(14) parent;
begin
savef1:=f1;
savef3:=f3;
w1:=66;
w1:=(w1).word+50;
move(.w3.,w0:=8,w1:=(w1).word+2,w2:=address(parent));
w3:=w2;
f1:=savef1;
monitor(16); ! send message to parent !
w1:=address(b.ans_status);
monitor(18); ! wait answer !
f1:=savef1;
f3:=savef3;
end;
end; ! opmess !
body of get_branches
comment get overlay code necessary to execute coroutine;
begin
label discerror;
incode
double savef1;
word savew2; ref return;
word lastcorutype:= -1, currcorutype;
byte op:= 2, mode:= 8'1001;
text(6) t_status:= "status";
word status;
text(11) t_progname;
begin
savef1:= f1; savew2:= w2; return:= w3;
w3:= 0; f0//100;
currcorutype:= w0;
if w0<>lastcorutype then
begin
if w0>=2 then ! dev corout !
if w0:=lastcorutype<2 then
begin ! transport coroutine procedures !
!get 5;
if w0<>1 then goto discerror;
end;
case w1:= currcorutype+1 of
begin
!get 3; ! apl interface !
!get 4; ! opr interface !
!get 6; ! printer !
!get 7; ! punch !
!get 8; ! reader !
!get 8; ! cardr. , uses reader corout !
!get 9; ! tty !
end;
!test 11;
if w0<>1 then goto discerror;
lastcorutype:= w0:= currcorutype;
end;
if w2:=b.current>0 then
if w0:=(w2).c_ic=0 then
begin
case w1:= currcorutype+1 of
begin
appl_interface(.w3.);
operator(.w3.);
pr(.w3.);
pc(.w3.);
rd(.w3.);
rd(.w3.);
tw(.w3.);
end;
(w2).c_ic:= w3;
!test 12;
end;
f1:= savef1;
w2:= savew2;
w3:= b.current;
call w0 return;
discerror:
status:= w0;
move(.w3.,w0:=8,w1:=w3,w2:=address(t_progname));
w1:= address(op);
opmess(.w3.,w1);
end;
end; ! get branches !
body of copyanswer
comment answer operation:
copy data area into sender
send answer ;
begin
incode
word resw0, savew0,savew2;
ref return;
! general copy params !
word gc_func:= 13; ! from me to sender !
ref gc_first, gc_last;
word gc_rel:= 0;
begin
savew0:= w0; savew2:= w2; return:= w3;
gc_first:= w0; gc_last:= w1;
w1:= address(gc_func);
monitor(84); ! general copy !
resw0:= w0;
if w0=2 then
begin ! stopped !
b.ans_status:= w0:= 8'00000400;
w0:= 1;
end
else
if w0=3 then
begin ! unintel, param error !
end
else
begin
b.ans_status:= w0:= 0;
b.ans_bytes:= w1;
w0:= w1;
b.ans_chars:= w1 ashift -1 + w0;
testout(.w3.,w0,w1:=savew0,w2:=66);
w0:= 1;
end;
w1:= address(b.ans_status);
w2:= savew2;
monitor(22); ! send answer !
testout(.w3.,w0:=6,w1,w2:=61);
w0:= resw0; w1:= b.ans_bytes;
w2:= savew2; w3:= b.current;
call w0 return;
end;
end; ! copy answer !
body of outtime
begin
record timetext(word hourtxt,minutetxt);
incode
word daysize:=1687500,hoursize:=70313,minutesize:=1172;
ref return,bufref;
double savef1;
begin
savef1:=f1;
bufref:=w2;
return:=w3;
f3:=(w3:=108).double lshift -9 // daysize; ! w3:=dayno !
f1 lshift -100; ! 0 !
f2 // hoursize; ! w2:=hour !
f1 // minutesize; ! w1:=minute !
w0:=0;
f1 // 10;
bufref.minutetxt:=w1 + 48 lshift 8 + w0 + 48 lshift 8 + 32;
w1:=0;
f2 // 10;
bufref.hourtxt:=w2 + 48 lshift 8 + w1 + 48 lshift 8 + 46;
f1:=savef1;
w2:=bufref;
w3:=return;
end;
end;
body of testout
begin
label close;
record dump
(word reg0,reg1,reg2,reg3,exreg,instr,cause,sbreg);
record testhead
(byte reclength,reckind;
word time,testref);
incode
word bufrel:=0;
ref return;
double savef1;
word savew2;
begin
if w0>500 then w0:= 500; ! cut down size of test record !
savef1:=f1;
savew2:=w2;
return:=w3;
if w3:=b.testmfst < b.testmlast then
begin ! if testbuffer exists then generate testoutput !
if w0+bufrel+(!length(testhead)+2) > 510 then
begin ! no room for next record so change buffer !
w3+bufrel;
(w3).word:=w0:=-1;
w1:=address(b.testmop);
w3:=address(b.testname);
monitor(16); ! send message !
w1:=b.testmfst;
monitor(18); ! wait answer !
if w2:=1 lshift w0 or (w1).word <> 2 then
begin
b.testmlast:=w1:=b.testmfst;
w1:=address(b.tstcomop);
(w1).logstatus:=w2;
opmess(.w3.,w1);
end;
if w1:=b.testsegm+1 = b.maxtestsegm then w1:=1;
b.testsegm:=w1;
bufrel:=w0:=0;
end;
f1:=savef1;
w2:=savew2;
w3:=b.testmfst+bufrel;
(w3).reclength:=w0+!length(testhead);
(w3).reckind:=w2;
bufrel:=w1:=bufrel+w0;
w1:= b.current;
if w1<>0 then w1:= (w1).c_nr;
(w3).testref:=w1;
w1:=108;
f1:=(w1).double-b.starttime lshift -7;
(w3).time:=w1;
f1:=savef1;
move(.w3.,w0,w1,w2:=w3+!length(testhead));
end;
w2:=savew2;
if w2=15 then
begin ! internal interrupt !
w3:=(w1).instr-2;
if w0:=(w3).word lshift -12 = (51*64) ! key store ! then
begin ! reestablish registers and continue !
w0:=(w1).instr;
return:=w0;
w0:=(w1).reg0;
w2:=(w1).reg2;
w3:=(w1).reg3;
w1:=(w1).reg1;
call w0 return;
end else
begin ! output last segment and halt !
close:
(w3:=b.testmfst+bufrel).word:=w0:=-2;
w3:=address(b.testname);
w1:=address(b.testmop);
monitor(16); ! send message !
w1:= address(b.ans_status);
monitor(18); ! wait answer !
monitor(10); ! release process !
end;
end else if w2 = 64 then goto close else;
f1:=savef1;
w2:=savew2;
w3:=b.current;
call w0 return;
end;
end; ! testout !
body of compare
begin
incode
word savew1, savew2;
ref return;
begin
savew1:= w1; savew2:= w2; return:= w3;
w3:= w1+w0;
w0:= 0;
while w1<w3 do
begin
w0:= (w1).word;
w0-(w2).word;
w1+2;
w2+2;
if w0<>0 then w1:= w3;
end;
w1:= savew1;
w2:= savew2;
w3:= b.current;
call w0 return;
end;
end; ! compare !
body of create_tc
begin
incode
double savef1;
word savew2;
ref return;
begin
savef1:= f1;
savew2:= w2;
return:= w3;
w1:= (w3).ct_tc;
w0:= 0;
(w1).c_ic:= w0;
(w1).tc_created:= w0:= 1;
(w1).tc_hostno:= w0:= (w3).ct_hostno;
(w1).tc_hostid:= w0:= (w3).ct_hostid;
w2:= address((w1).tc_devname);
move(.w3.,w0:=8,w1:=return.ct_devname,w2);
w1:= return.ct_tc; w2:= address((w1).tc_name);
w1:= return.ct_procref; w1+2;
move(.w3.,w0,w1,w2);
w1:= return.ct_tc;
w2:= address((w1).tc_console);
if w0:=(w2).word=0 then ! no operator !
begin
w3:= address((w1).tc_qgroup);
(w3).word:= w0;
if w0:=(w1).tc_kind=8 ! tty ! then
begin
move(.w3.,w0:=8,w1:=address((w1).tc_name),w2);
end
else
if w0:=(w1).tc_hostno=0 ! local ! then
begin
w1:= b.procconsole; w1+2;
move(.w3.,w0:=8,w1,w2);
end else;
end;
link(.w3.,w1:=return.ct_tc,w2:=address(b.activqfst));
testout(.w3.,w0:=!length(transpcorout),w1,w2:=53);
f1:= savef1;
w2:= savew2;
w3:= return;
end;
end; ! create_ct !
body of remove_tc
begin
incode
double savef1;
word savew2;
ref return;
begin
savef1:= f1;
savew2:= w2;
return:= w3;
w1:= (w3).rt_tc;
w0:= 0;
(w1).c_mbuf:= w0;
(w1).tc_created:= w0;
w3:= address((w1).tc_name);
monitor(10); ! release !
if w2:= (w1).tc_hostno<>0 then
begin ! remote !
monitor(64); ! remove process !
!test 30;
end;
if w0:=(w1).tc_kind=8 ! tty ! then
begin ! remove operator !
w2:= address((w1).tc_console);
(w2).word:= w0:= 0;
w2:= address((w1).tc_devcons);
(w2).word:= w0;
end;
link(.w3.,w1,w2:=address(b.waitqfst));
testout(.w3.,w0:=!length(prcorout),w1,w2:=54);
f1:=savef1;
w2:= savew2;
w3:= return;
end;
end; ! remove_tc !
body of find_tc
begin
label found;
incode
word savew0, savew2, freetc;
ref return;
begin
savew0:= w0;
savew2:= w2;
return:= w3;
freetc:= w0:= 0;
w1:= b.tcpool_fst;
while w1<b.tcpool_top do
begin
if w0:=(w1).tc_kind=return.ft_kind then
begin
if w0:=(w1).tc_hostno=return.ft_hostno then
if w0:=(w1).tc_hostid=return.ft_hostid then
begin
compare(.w3.,w0:=8,w1+!position(tc_devname),w2:=return.ft_devname);
w1-!position(tc_devname);
if w0=0 then goto found;
end;
if w0:=freetc=0 then
if w0:=(w1).tc_created=0 ! not created ! then
begin
w2:= address((w1).tc_console);
if w0:=(w2).word=0 then freetc:= w1; ! no operator logged in !
end;
end;
w1:= (w1).tc_nexttc;
end;
w1:= freetc;
found:
if w0:=(w1).tc_created=0 then -(w1);
w0:= savew0;
w2:= savew2;
w3:= return; ! w3 not equal to current corout++++++ !
!test 70;
end;
end; ! find_tc !
body of looktransport
begin
incode
word savew0, savew1;
ref return;
begin
savew0:= w0; savew1:= w1; return:= w3;
! check legality of transport name !
w2:= 1;
if w1<b.trans_first then w2:= -1;
if w1>=b.trans_top then w2:= -1;
w1 extract 9;
while w1>0 do w1-!length(tr_descr);
if w1<>0 then w2:= -1;
if w2>0 then
begin
b.bs_op:= w0:= 3;
b.bs_segno:= w1:= savew1 ashift -9;
ioworkarea(.w3.,w1:=address(b.bs_op));
w2:= savew1 extract 9; w2+b.bs_first;
w1:= 108;
f1:= (w1).double lshift -20;
if w0:=(w2).tr_waitmess=0 then
if w0:=(w2).tr_removetime<w1 then ! entry free !
w2:= 0;
end;
w0:= savew0;
w1:= savew1;
w3:= b.current;
!test 305;
call w0 return;
end;
end; ! looktransport !
body of puttransport
begin
incode
ref return;
word savew0, savew1, savew2;
begin
savew0:= w0; savew1:= w1; savew2:= w2; return:= w3;
b.bs_op:= w0:= 5;
b.bs_segno:= w1 ashift -9;
w1:= savew1 extract 9; w1+b.bs_first;
testout(.w3.,w0:=!length(tr_descr),w1,w2:=68);
ioworkarea(.w3.,w1:=address(b.bs_op));
w0:= savew0;
w1:= savew1;
w2:= savew2;
w3:= b.current;
call w0 return;
end;
end; ! puttransport !
body of ioworkarea
comment
transport a segment to or from the spool area
;
begin
incode
word status, bytes, chars, a4, a5, a6, a7, a8;
double savef1;
ref savew2, return;
begin
savef1:= f1;
savew2:= w2;
return:= w3;
testout(.w3.,w0:=8,w1,w2:=52);
w3:= address (b.spoolname);
monitor(16);
w1:= address(status);
monitor(18);
if w2:=1 lshift w0 or (w1).word <> 2 then
begin
w1:=address(b.spcomop);
(w1).logstatus:=w2;
testout(.w3.,w0:=16,w1,w2:=64);
opmess(.w3.,w1);
end;
f1:= savef1; w2:= savew2;
w3:= b.current;
call w0 return;
end;
end; ! ioworkarea !
body of linkupremote
begin
incode
word savew1, return;
text(14) host:= "host";
! operation message !
word om_op:= 2'000000000001000000001100;
ref om_first, om_last;
byte om_unu1, om_hostno;
word om_hostid;
byte om_homereg:= 0, om_netid:= 0;
! operation output !
word oo_modekind,
oo_timeoutsbuffers:= 0,
oo_bufsize:= 0;
text(11) oo_deviname;
word oo_unu1;
word oo_net1:= 0, oo_net2:= 0, oo_unu2;
! operation answer !
word oa_return,oa_bytes,oa_chars,oa_net1,oa_net2,oa_net3,oa_d1,oa_d2;
! operation input !
word oi_kind,oi_bufs,oi_bufsize;
text(11) oi_deviname;
word oi_net1,oi_net2,oi_net3;
ref oi_procdescr;
begin
savew1:= w1; return:= w3;
om_hostno:= w0:= (w3).lur_hostno;
om_hostid:= w0:= (w3).lur_hostid;
oo_modekind:= w0:= (w3).lur_kind;
move(.w3.,w0:=8,w1:=(w3).lur_deviname,w2:=address(oo_deviname));
! move output to input area !
move(.w3.,w0:=22,w1:=address(oo_modekind),w2:=address(oi_kind));
om_first:= w2;
w2+20;
om_last:= w2;
testout(.w3.,w0:=22,w1,w2:=66);
w1:= address(om_op);
testout(.w3.,w0:=12,w1,w2:=2);
w3:= address(host);
monitor(16); ! send message !
w1:= address(oa_return);
monitor(18); ! wait answer !
if w0<>1 then oa_return:= w0:= 1; ! a little bit dirty !
testout(.w3.,w0:=12,w1,w2:=67);
testout(.w3.,w0:=22,w1:=address(oi_kind),w2:=66);
w0:= oa_return;
w2:= oi_procdescr;
w1:= savew1;
w3:= return;
end;
end; ! link up remote !
!branch 1,2;
body of init
begin
label allocate,initbufs;
incode
ref return;
byte opversion:=16,modeversion:= 8'0140;
text(14) textversion:=
! *** primo *** ! "release: 2.1"
;
word
! date of version ! verdate:= 791126,
comment ===trimstart;
! date of options ! options := 0,
! number of printer coroutines ! prcount := 3,
! size of printer buffer (halfwords) ! prbufsize := 128,
! leading and trailing page on printer lists ! prltpage := 1,
! max lines pr printer page ! prlinepage := 100,
! number of punch coroutines ! pccount := 1,
! size of punch buffer (halfwords) ! pcbufsize := 128,
! number of reader coroutines ! rdcount := 1,
! size of reader buffer (halfwords) ! rdbufsize := 128,
! number of cardreader coroutines ! cdcount := 1,
! size of cardreader buffer (halfwords) ! cdbufsize := 108,
! number of tty coroutines (halfwords) ! twcount := 1,
! size of tty buffer ! twbufsize := 64,
! no of operator coroutines ! oprcount := 2,
! no of transport description segmnts ! trsegm := 100,
! size of testoutput area ! testsegmnts := 42,
! transport description save period ! trsaveminut := 60,
! no of waiting transports ( total ) ! waittrans := 50,
! no of pending wait operations ! waitops := 5,
! output details to operator ( when <> 0) ! oprdetails := 1,
comment ===trimfinis;
spoolpointer:=0;
text(11) testarea:= "primotest", spoolarea:= "primospool",
pseudoname:= "primosys";
array(1:10) tail of word := 0 0 0 0 0 0 0 0 0 0;
ref queuefst,queuetop;
ref tcbufref, oprbufref;
byte op1:=16,mode1:=8'40;
word alarm;
text(14) resource:= "";
word stdvalue,margin,bufclaim,stop:=0;
text(14)size := "size",
area := "area",
buf := "buf";
byte funcop:= 16, funcmode:= 0;
text(21) functext:="***function 1,2,3,4,5";
byte inittrop:= 2, inittrmode:= 1;
text(20)inittr:=" ***init troubles";
byte op2:=16,mode2:=0;
text(20) started:="started";
word pos_nine:= 9, neg_nine:= -9;
begin
return:=w3;
goto allocate;
initbufs:
w0:= 0;
w2:= b.tcpool_top;
for w2-2 step 2 downto b.bs_first do (w2).word:= w0;
w1:= queuefst;
w2:= address(b.tqfreefst);
while w1<queuetop do
begin
(w1).tq_next:= w1;
(w1).tq_prev:= w1;
link(.w3.,w1,w2);
w1+!length(queuerec);
end;
! init appl. interface corout !
w1:= b.apl_fst;
(w1).c_next:= w1;
(w1).c_prev:= w1;
(w1).c_nr:= w0:= 1;
link(.w3.,w1,w2:=address(b.activqfst));
! init opr. interface !
w1:= b.opr_fst;
if w0:=oprcount>0 then
for w0:=1 step 1 upto oprcount do
begin
(w1).c_next:= w1;
(w1).c_prev:= w1;
(w1).c_nr:= w3:= w0+100;
(w1).opr_buf:= w2:= oprbufref;
w2+b.oprt_bufl+(!length(bufhead)-2);
oprbufref:= w2;
link(.w3.,w1,w2:=address(b.activqfst));
w1+!length(oprcorout);
end;
w1:= b.tcpool_fst;
if w3:=prcount>0 then
for w3:=1 step 1 upto prcount do
begin
(w1).c_next:=w1;
(w1).c_prev:=w1;
(w1).c_nr:=w2:=w3+200;
(w1).tc_kind:= w0:= 14;
(w1).tc_nexttr:= w0:= address((w1).tc_nexttr);
(w1).tc_prevtr:= w0;
(w1).tc_buf:=w2:=tcbufref;
w2+prbufsize+(!length(bufhead)-2);
tcbufref:= w2;
(w1).tc_bufsize:= w0:= prbufsize;
w0:= w1+!length(prcorout);
(w1).tc_nexttc:= w0;
w1:= w0;
end;
if w3:=pccount>0 then
for w3:= 1 step 1 upto pccount do
begin
(w1).c_next:=w1;
(w1).c_prev:=w1;
(w1).c_nr:=w2:=w3+300;
(w1).tc_kind:= w0:= 12;
(w1).tc_nexttr:= w0:= address((w1).tc_nexttr);
(w1).tc_prevtr:= w0;
(w1).tc_buf:=w2:=tcbufref;
w2+pcbufsize+(!length(bufhead)-2);
tcbufref:= w2;
(w1).tc_bufsize:= w0:= pcbufsize;
w0:= w1+!length(pccorout);
(w1).tc_nexttc:= w0;
w1:= w0;
end;
if w3:=rdcount>0 then
for w3:=1 step 1 upto rdcount do
begin
(w1).c_next:=w1;
(w1).c_prev:=w1;
(w1).c_nr:=w2:=w3+400;
(w1).tc_kind:= w0:= 10;
(w1).tc_nexttr:= w0:= address((w1).tc_nexttr);
(w1).tc_prevtr:= w0;
(w1).tc_buf:=w2:=tcbufref;
w2+rdbufsize+(!length(bufhead)-2);
tcbufref:= w2;
(w1).tc_bufsize:= w0:= rdbufsize;
w0:= w1+!length(rdcorout);
(w1).tc_nexttc:= w0;
w1:= w0;
end;
if w3:=cdcount>0 then
for w3:= 1 step 1 upto cdcount do
begin ! use reader corout !
(w1).c_next:= w1;
(w1).c_prev:= w1;
(w1).c_nr:= w2:= w3+500;
(w1).tc_kind:= w0:= 16;
(w1).tc_nexttr:= w0:= address((w1).tc_nexttr);
(w1).tc_prevtr:= w0;
(w1).tc_buf:= w2:= tcbufref;
w2+cdbufsize+(!length(bufhead)-2);
tcbufref:= w2;
(w1).tc_bufsize:= w0:= cdbufsize;
w0:= w1+!length(rdcorout);
(w1).tc_nexttc:= w0;
w1:= w0;
end;
if w3:=twcount>0 then
for w3:= 1 step 1 upto twcount do
begin
(w1).c_next:= w1;
(w1).c_prev:= w1;
(w1).c_nr:= w2:= w3+600;
(w1).tc_kind:= w0:= 8;
(w1).tc_nexttr:= w0:= address((w1).tc_nexttr);
(w1).tc_prevtr:= w0;
(w1).tc_buf:= w2:= tcbufref;
w2+twbufsize+(!length(bufhead)-2);
tcbufref:= w2;
(w1).tc_bufsize:= w0:= twbufsize;
w0:= w1+!length(twcorout);
(w1).tc_nexttc:= w0;
w1:= w0;
end;
testout(.w3.,w0:=50,w1:=address(verdate),w2:=69);
w1:= 66;
testout(.w3.,w0:= 150,w1:=(w1).word-4,w2:=8);
b.bs_op:= w0:= 5; ! clear work area !
w1:= address(b.bs_op);
w2:= b.trans_top ashift neg_nine;
for w2-1 step 1 downto 0 do
begin
b.bs_segno:= w2;
ioworkarea(.w3.,w1);
end;
call w0 return;
allocate:
opmess(.w3.,w1:=address(opversion));
w3:= 66;
w3:= (w3).word+29; ! test function mask !
if w0:=(w3).byte onemask 8'3700 then
else
begin
stop:= w0:= 1;
opmess(.w3.,w1:=address(funcop));
end;
w1:= 108;
b.starttime:= f1:= (w1).double;
b.activqfst:=w0:=address(b.activqfst);
b.activqlast:=w0;
b.answerqfst:=w0:=address(b.answerqfst);
b.answerqlast:=w0;
b.waitqfst:=w0:=address(b.waitqfst);
b.waitqlast:=w0;
b.holdqfst:= w0:= address(b.holdqfst);
b.holdqlast:= w0;
b.tqfreefst:= w0:= address(b.tqfreefst);
b.tqfreelast:= w0;
b.bs_first:= w1:= b.firstfree;
w1+510;
b.bs_last := w1;
w1+2;
oprbufref:= w1; ! buffer for operator !
w0:=(!length(bufhead)-2)+b.oprt_bufl;
w1+w0;
tcbufref:=w1;
w0:=(!length(bufhead)-2)+prbufsize;
w0*prcount;
w1+w0;
w0:=(!length(bufhead)-2)+pcbufsize;
w0*pccount;
w1+w0;
w0:=(!length(bufhead)-2)+rdbufsize;
w0*rdcount;
w1+w0;
w0:=(!length(bufhead)-2)+cdbufsize;
w0*cdcount;
w1+w0;
w0:=(!length(bufhead)-2)+twbufsize;
w0*twcount;
w1+w0;
queuefst:= w1;
w0:= !length(queuerec);
w0*waittrans;
w1+w0;
queuetop:= w1;
b.apl_fst:= w1;
w1+!length(coroutine);
b.opr_fst:= w1;
w0:= !length(oprcorout)*oprcount;
w1+w0;
b.opr_top:= w1;
b.tcpool_fst:= w1;
w0:= !length(prcorout)*prcount;
w1+w0;
w0:=!length(pccorout)*pccount;
w1+w0;
w0:=!length(rdcorout)*rdcount;
w1+w0;
w0:=!length(rdcorout)*cdcount;
w1+w0;
w0:=!length(twcorout)*twcount;
w1+w0;
b.tcpool_top:= w1;
w3:=66;
w3:=(w3).word+22;
f3:=(w3).double;
w3-2;
b.testmlast:=w3;
if w0:=testsegmnts > 0 then w3-510;
b.testmfst:=w3;
margin:=w3-w1;
if w3 <> 0 then
begin
w0:=b.testmlast+2;
stdvalue:=w0-w2-margin;
move(.w3.,w0:=8,w1:=address(size),w2:=address(resource));
if w3:=margin < 0 then
begin
alarm:=w2:=2763306; ! "***" !
stop:=w2;
end else alarm:=w2:=2105376; ! " " !
opmess(.w3.,w1:=address(op1));
end;
w3:=66;
w3:=(w3).word+26;
bufclaim:=w1:=(w3).byte;
w3+1;
w1:=(w3).byte;
! area process claim +3 primospool primotest primosys (pseudo) !
margin:= w1-(w2:= prcount+pccount+rdcount+cdcount+twcount+3);
if w1 <> 0 then
begin
stdvalue:=w2 + 1 ! one for program area process ! ;
move(.w3.,w0:=8,w1:=address(area),w2:=address(resource));
if w3:=margin < 0 then
begin
alarm:=w2:=2763306; ! "***" !
stop:=w2;
end else alarm:=w2:=2105376; ! " " !
opmess(.w3.,w1:=address(op1));
end;
margin:=
w1:= bufclaim-(w2:= 1+prcount+pccount+rdcount+cdcount+twcount+
oprcount + 1 ! testoutput ! +waitops);
if w1 <> 0 then
begin
stdvalue:=w2;
move(.w3.,w0:=8,w1:=address(buf),w2:=address(resource));
if w3:=margin < 0 then
begin
alarm:=w2:=2763306; ! "***" !
stop:=w2;
end else alarm:=w2:=2105376; ! " " !
opmess(.w3.,w1:=address(op1));
end;
w3:=address(spoolarea);
monitor(48); ! remove entry !
f2:= b.starttime; f2 lshift -19;
(tail(w1:=6)).word:= w2;
b.trans_first:= w2:= 0;
w2:= trsegm;
b.trans_top:= w2 ashift 9;
w2 ashift -9;
(tail(w1:=1)).word:=w2;
monitor(40); ! create spool area !
w1:=3;
monitor(50); ! permanent entry !
monitor(52); ! create area process !
monitor(8); ! reserve area process !
if w0 <> 0 then
begin
stdvalue:=w2;
move(.w3.,w0:=8,w1:=address(spoolarea),w2:=address(resource));
alarm:=w2:=2763306;
stop:=w2;
opmess(.w3.,w1:=address(op1));
end;
move(.w3.,w0:=8,w1:=address(spoolarea),w2:=address(b.spoolname));
w3:=address(testarea);
monitor(48); ! remove entry !
(tail(w1:=1)).word:=w2:=testsegmnts;
b.maxtestsegm:=w2;
if w2 > 0 then
begin
monitor(40); ! create testoutput area !
w1:=3;
monitor(50); ! permanent entry !
monitor(52); ! create area process !
monitor(8); ! reserve area process !
if w0 <> 0 then
begin
stdvalue:=w2;
move(.w3.,w0:=8,w1:=address(testarea),w2:=address(resource));
alarm:=w2:=2763306;
stop:=w2;
opmess(.w3.,w1:=address(op1));
end;
move(.w3.,w0:=8,w1:=address(testarea),w2:=address(b.testname));
end;
if w0:=stop <> 0 then
begin ! the resources are not available for start up !
opmess(.w3.,w1:=address(inittrop));
end;
opmess(.w3.,w1:=address(op2));
b.prheadtrail:= w0:= prltpage;
b.oprtdetails:= w0:= oprdetails;
b.prlpage:= w0:= prlinepage;
w0:= 0;
w1:= trsaveminut*(60*1000*10);
b.trsaveperiod:= f1;
b.waitbufs:= w0:= waitops;
w3:=address(pseudoname);
monitor(80);
goto initbufs;
end;
end; ! init !
!branch 1,3;
body of freetransport
comment find a free transport description if possible, and
make the description available in core;
begin
label exit;
incode
ref return;
begin
return:= w3;
if w1:= b.trans_old<0 then
begin
b.trans_old:= w1:= b.trans_first;
end;
w2:= 0;
while w2=0 do
begin
w3:= w1+(!length(tr_descr)+!length(tr_descr)-2) ashift -9 ashift 9;
if w3>w1 then
begin ! change segment !
if w3=b.trans_top then w1:=b.trans_first else w1:= w3;
end
else w1+!length(tr_descr);
looktransport(.w3.,w1,w2);
if w2>0 then w2:= 0
else
begin
w2:= w1 extract 9; w2+b.bs_first;
end;
if w1=b.trans_old then goto exit;
end;
exit:
b.trans_old:= w1;
w3:= b.current;
!test 311;
call w0 return;
end;
end; ! freetransport !
body of deftr_semantic
comment execute define transport operation.
called from application interface coroutine to avoid breaking
address limit ;
begin
label l_resources, l_ent, l_dev, l_devslow, exit;
incode
word savew2;
ref return;
ref transref, procref, tc_ref;
word hostno, hostid;
text(11) docname;
! file descriptor !
word ent_mk;
text(11) ent_docname;
word ent_6,ent_7,ent_8,ent_9,ent_10;
word sender_receiver,bs_dev; ! help vars used to look up sender/receiver entries !
word zero:= 0;
begin
return:= w3;
transref:= w2;
w2:= b.event;
w3:= (w2).cm_sender;
if w3<=0 then -(w3);
! get sender cat base and check that it is contained in my std base !
w3+68;
w2:= 66; w2:= (w2).word+76;
transref.tr_basel:= w0:= (w3).word;
if w0<(w2).word then goto l_resources;
w3+2; w2+2;
transref.tr_baseu:= w1:= (w3).word;
if w1>(w2).word then goto l_resources;
w3:= address(zero);
monitor(72); ! set cat base !
!test 91;
! test sender and receiver entry !
sender_receiver:= w0:= 0;
bs_dev:= w0; ! bs area not found yet !
while w0:=sender_receiver+1<=2 do
begin
sender_receiver:= w0;
w1:= address(ent_mk);
if w0=1 then w3:= address((w3:=transref).tr_sname)
else w3:= address((w3:=transref).tr_rname);
monitor(42); ! look up entry !
!test 92;
if w0<>0 then goto l_ent;
if w0:= ent_mk<0 then
begin ! file descriptor !
if w0 extract 12=4 then
begin ! bs descriptor !
transref.tr_bsstartptr:= w0:= ent_8 ashift 9;
move(.w3.,w0:=8,w1:=address(ent_docname),
w2:=address((w2:=transref).tr_bsarea));
w1:= address(ent_mk);
w3:= address(ent_docname);
monitor(42); ! look up entry !
!test 94;
if w0<>0 then goto l_dev;
if w0:= ent_mk<0 then goto l_dev;
bs_dev:= w0:= sender_receiver;
end
else
begin
if w2:=sender_receiver=1 then
begin
!test 95;
if w0=8 then ! typewriter !
else
if w0=10 then ! reader !
else
if w0=16 then ! cardr !
else
goto l_ent;
end
else
begin
!test 96;
if w0=12 then ! punch !
else
if w0=14 then ! printer !
else
goto l_ent;
end;
transref.tr_kind:= w0:= ent_mk;
transref.tr_mode:= w0 lshift 1 lshift -13;
hostno:= w0:= ent_7;
hostid:= w0:= ent_8;
move(.w3.,w0:=8,w1:=address(ent_docname),w2:=address(docname));
end;
end ! file descriptor !
else
begin
!test 97;
bs_dev:= w0:= sender_receiver;
move(.w3.,w0:=8,w1:=w3,
w2:=address((w2:=transref).tr_bsarea));
end;
end;
if w0:= bs_dev=0 then goto l_ent; ! bs_area not found !
w1:= address(b.tqfreefst);
if w0:=(w1).tq_next=w1 then goto l_resources; ! no free queue element !
find_tc(.w3.,w0:=address(docname),w0:=hostno,w0:=hostid,w0:=transref.tr_kind,
w1);
!test 98;
tc_ref:= w1;
if w1=0 then
begin ! no free coroutine !
goto l_resources;
end
else
if w1>0 then
begin ! exist allready !
end
else
begin ! dont exist !
if w0:=hostno=0 then
begin ! local device !
w3:= address(docname);
monitor(4); ! get process description !
!test 99;
if w0=0 then goto l_devslow;
procref:= w0;
monitor(8);
end
else
begin ! remote device !
linkupremote(.w3.,w0:=transref.tr_kind,w0:=hostno,w0:=hostid,
w0:=address(docname),w0,w2);
if w0<>4096 then
if w0<>4103 then ! link not created !
goto l_devslow;
procref:= w2;
end;
-(w1); tc_ref:= w1;
create_tc(.w3.,w1,w0:=address(docname),w0:=hostno,w0:=hostid,w0:=procref);
w2:= procref;
comment if w0:=(w2+36).byte<>transref.tr_kind then goto l_devslow;
end;
w0:= 0;
exit:
w1:= tc_ref;
w2:= transref;
w3:= b.current;
call w0 return;
l_resources : w0:= 2; goto exit;
l_ent : if w0:=sender_receiver=1 then w0:= 3 else w0:= 5; goto exit;
l_dev : if w0:= sender_receiver=1 then w0:= 4 else w0:= 6; goto exit;
l_devslow : if w0:=bs_dev=1 then w0:= 6 else w0:= 4; goto exit;
end;
end; ! deftr_semantic !
body of appl_interface
comment application interface coroutine;
begin
label wait_m,
rdt_resources,rdt_syntax,rdt_sent,rdt_sdev,rdt_rent,rdt_rdev,
rgt, rgt_syntax, rgt_unknown, rgt_resources, tr_finished,
rrt, rrt_syntax, rrt_unknown,
rkt, rkt_syntax, rkt_unknown,repkill,
stopped,unint,reject;
record def_transport
(word dth_op,dth_trname;
text(11) dt_trname;
word dth_user;
text(11) dt_user;
word dth_sub,dth_sender,dth_sname;
text(11) dt_sname;
word dth_receiver,dth_rname;
text(11) dt_rname;
word dth_queues,dth_qgroup;
text(11) dt_qgroup;
word dth_qname;
text(11) dt_qname);
record getst_transport
(word gth_op,gth_no;
word gt_no);
record relea_transport
(word rth_op,rth_no;
word rt_no);
record kill_transport
(word kth_op,kth_no;
word kt_no);
incode
! answer define transport !
byte adt_1:= 3, adt_2:= 0,
adt_3:= 1, adt_4:= 4'010010;
text(11) adt_trname;
byte adt_5:= 2, adt_6:= 4'010010;
text(11) adt_user;
byte adt_7:= 3, adt_8:= 4'010001;
word adt_no;
byte adt_9:= 4, adt_10:= 4'010000,
adt_11:=1, adt_12:= 4'020001;
word adt_rcode;
byte adt_13, adt_14:= 4'020002; ! device troubles params !
word adt_cause, adt_status:= 0;
! answer get state !
byte agt_1, agt_2:= 0,
agt_3:= 4, agt_4:= 4'010000,
agt_5:= 1, agt_6:= 4'020001;
word agt_rcode;
byte agt_7:= 1, agt_8:= 4'010010;
text(11) agt_trname;
byte agt_9:= 3, agt_10:= 4'010001;
word agt_no;
byte agt_11:= 1000, agt_12:= 4'010000,
agt_13:= 3, agt_14:= 4'020000,
agt_15:= 4, agt_16:= 4'030001;
word agt_state;
byte agt_19:= 7, agt_20:= 4'030002;
word agt_ptr1, agt_ptr2;
byte agt_17:= 6, agt_18:= 4'030002;
word agt_cause, agt_status;
! answer release descr !
byte art_1:= 9, art_2:= 0,
art_3:= 4, art_4:= 4'010000,
art_5:= 1, art_6:= 4'020001;
word art_rcode;
! answer kill transport !
byte akt_1:= 11, akt_2:= 0,
akt_3:= 4, akt_4:= 4'010000,
akt_5:= 1, akt_6:= 4'020001;
word akt_rcode;
! work area for control operation data !
array(1:(!length(def_transport)+2)) cont_data of byte;
! data area for control operation data, longer than longest data area !
! general copy params !
word gc_func:= 4; ! copy from sender to me !
ref gc_first, gc_last;
word gc_rel:= 0;
word bytesmoved;
ref transref, tc_ref;
word transno; ! used by kill !
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
wait_m:
waitmess(.w3.,w2);
cont_data(w1:=1);
w3:= w1+!length(def_transport);
gc_first:= w1;
gc_last:= w3;
w1:= address(gc_func);
monitor(84); ! general copy core !
if w0=2 then goto stopped;
if w0=3 then goto unint;
if w1<=0 then goto unint; ! no data !
bytesmoved:= w1;
cont_data(w1:=1);
testout(.w3.,w0:=bytesmoved,w1,w2:=66);
if w0:=(w1).word=4'2000000 then
begin ! define transport !
if w0:=bytesmoved<>!position(dth_queues) then
if w0<>!length(def_transport) then
goto unint; ! length of data illegal !
freetransport(.w3.,w1,w2);
if w2=0 then goto rdt_resources;
adt_no:= w1;
transref:= w2;
w1:= w2+!length(tr_descr)-2;
w0:= 0;
for w1 step 2 downto transref do (w1).word:= w0;
cont_data(w1:=1);
if w0:=(w1).dth_trname<>4'1010010 then goto rdt_syntax;
!test 52;
move(.w3.,w0:=8,w1:=address((w1).dt_trname),w2:=address(adt_trname));
move(.w3.,w0,w1,w2:=address((w2:=transref).tr_name));
cont_data(w1:=1);
if w0:=(w1).dth_user<>4'2010010 then goto rdt_syntax;
move(.w3.,w0:=8,w1:=address((w1).dt_user),w2:=address(adt_user));
move(.w3.,w0,w1,w2:=address((w2:=transref).tr_user));
cont_data(w1:=1);
if w0:=(w1).dth_sub<>(1000*4096+4'010000) then goto rdt_syntax;
if w0:=(w1).dth_sender<>4'1020000 then goto rdt_syntax;
if w0:=(w1).dth_sname<>4'2030010 then goto rdt_syntax;
move(.w3.,w0:=8,w1:=address((w1).dt_sname),w2:=address((w2:=transref).tr_sname));
cont_data(w1:=1);
if w0:=(w1).dth_receiver<>4'2020000 then goto rdt_syntax;
if w0:=(w1).dth_rname<>4'2030010 then goto rdt_syntax;
!test 58;
move(.w3.,w0:=8,w1:=address((w1).dt_rname),w2:=address((w2:=transref).tr_rname));
if w1:=bytesmoved=!length(def_transport) then
begin ! queue fields present !
cont_data(w1:=1);
if w0:=(w1).dth_queues<>4'3030000 then goto rdt_syntax;
if w0:=(w1).dth_qgroup<>4'1100010 then goto rdt_syntax;
move(.w3.,w0:=8,w1:=address((w1).dt_qgroup),w2:=address((w2:=transref).tr_qgroup));
cont_data(w1:=1);
if w0:=(w1).dth_qname<>4'3100010 then goto rdt_syntax;
!test 60;
move(.w3.,w0:=8,w1:=address((w1).dt_qname),w2:=address((w2:=transref).tr_qname));
end;
deftr_semantic(.w3.,w0,w1,w2:=transref);
!test 61;
tc_ref:= w1;
case w1:= w0 of ! w1=0 transport defined, no action !
begin
rdt_syntax : w1:= 1;
rdt_resources : w1:= 3;
rdt_sent : begin
adt_13:= w1:= 3; adt_cause:= w1:= 1; w1:= 5;
end;
rdt_sdev : begin
adt_13:= w1:= 3; adt_cause:= w1:= 2; w1:= 5;
end;
rdt_rent : begin
adt_13:= w1:= 4; adt_cause:= w1:= 1; w1:= 6;
end;
rdt_rdev : begin
adt_13:= w1:= 4; adt_cause:= w1:= 2; w1:= 6;
end;
end;
adt_rcode:= w1;
if w1>=5 ! device troubles ! then w1:= address(adt_status)
else w1:= address(adt_rcode);
copyanswer(.w3.,w0:=address(adt_1),w1,w2:=b.event);
if w0=0 then ! data copied to sender !
if w0:=adt_rcode=0 then
begin ! operation accepted, initialize transport !
w2:= transref;
(w2).tr_corou:= w0:= tc_ref;
(w2).tr_state:= w0:= 0;
(w2).tr_removetime:= w0:= 8'37777777;
puttransport(.w3.,w1:=adt_no);
link(.w3.,w1:=b.tqfreefst,w2:=address(tc_ref.tc_nexttr));
(w1).tq_transno:= w0:= adt_no;
end;
end ! define transport !
else
if w0=4'10000000 then
begin ! get state of subtransport !
if w0:=bytesmoved<>!length(getst_transport) then
goto unint; ! length of data illegal !
agt_1:= w0:= 5; ! ans get state !
cont_data(w1:=1);
if w0:=(w1).gth_no<>4'3010001 then goto rgt_syntax;
looktransport(.w3.,w1:=(w1).gt_no,w2);
agt_no:= w1;
if w2<=0 then goto rgt_unknown;
transref:= w2;
if w0:=(w2).tr_state=0 then
begin ! not finished !
w1:= (w2).tr_corou;
if w0:=(w1).tc_transno<>agt_no then agt_state:= w0:= 2 ! waiting !
else
begin ! executing or hold state !
agt_state:= w0:= 3; ! executing !
w2:= b.holdqfst;
while w3:=address(b.holdqfst)<>w2 do
begin
if w1=w2 then agt_state:= w0:= 4; ! hold !
w2:= (w2).c_next;
end;
end;
end
else
begin ! finished !
tr_finished:
agt_state:= w0:= (w2).tr_state;
agt_cause:= w0:= (w2).tr_cause;
agt_status:= w0:= (w2).tr_status;
agt_ptr1:= w0:= 0;
agt_ptr2:= w0:= (w2).tr_charposition;
end;
w0:= 0;
rgt:
! reply get transport !
agt_rcode:= w0;
move(.w3.,w0:=8,w1:=address((w1:=transref).tr_name),
w2:=address(agt_trname));
if w1:=agt_state=5 then w1:= address(agt_ptr2)
else
if w1=6 then w1:= address(agt_status)
else w1:= address(agt_state);
copyanswer(.w3.,w0:=address(agt_1),w1,w2:=b.event);
if w0<>w0 then
begin ! operation not accepted !
rgt_syntax : w0:= 1; goto rgt;
rgt_unknown : w0:= 2; goto rgt;
rgt_resources: w0:= 3; goto rgt;
end;
end ! get state of transport !
else
if w0=4'12000000 then
begin ! wait and get state of subtransport !
if w0:=bytesmoved<>!length(getst_transport) then
goto unint; ! length of data illegal !
agt_1:= w0:= 7; ! answer waitget transport !
cont_data(w1:=1);
if w0:=(w1).gth_no<>4'3010001 then goto rgt_syntax;
looktransport(.w3.,w1:=(w1).gt_no,w2);
agt_no:= w1;
if w2<=0 then goto rgt_unknown;
transref:= w2;
if w0:=(w2).tr_state=0 then
begin ! not finished !
if w0:=(w2).tr_waitmess>0 then goto reject;
if w0:=b.waitbufs<=0 then goto rgt_resources;
b.waitbufs:= w0-1;
transref.tr_waitmess:= w2:= b.event;
puttransport(.w3.,w1:=agt_no);
end
else
begin ! finished !
goto tr_finished;
end;
end ! wait and get state of transport !
else
if w0=4'20000000 then
begin ! release description !
if w0:=bytesmoved<>!length(relea_transport) then
goto unint; ! length of data illegal !
cont_data(w1:=1);
if w0:=(w1).rth_no<>4'3010001 then goto rrt_syntax;
looktransport(.w3.,w1:=(w1).rt_no,w2);
if w2<=0 then goto rrt_unknown;
if w0:=(w2).tr_removetime>=8'37777776 then w0:= 8'37777776
else w0:= 0;
(w2).tr_removetime:= w0;
w0:= 0;
rrt: ! reply release transport !
art_rcode:= w0;
copyanswer(.w3.,w0:=address(art_1),w1:=address(art_rcode),w2:=b.event);
cont_data(w1:=1);
if w0=0 then ! data copied to sender !
if w0:=art_rcode=0 then ! operation accepted !
puttransport(.w3.,w1:=(w1).rt_no);
if w0<>w0 then
begin ! operation not accepted !
rrt_syntax : w0:= 1; goto rrt;
rrt_unknown : w0:= 2; goto rrt;
end;
end ! release description !
else
if w0=4'22000000 then
begin ! kill !
if w0:=bytesmoved<>!length(kill_transport) then
goto unint; ! length of data illegal !
cont_data(w1:=1);
if w0:=(w1).kth_no<>4'3010001 then goto rkt_syntax;
looktransport(.w3.,w1:=(w1).kt_no,w2);
if w2<=0 then goto rkt_unknown;
transref:= w2;
transno:= w1;
w0:= 0;
if w0<>w0 then
begin ! operation not accepted !
rkt_syntax : w0:= 1; goto rkt;
rkt_unknown : w0:= 2;
end;
rkt: ! reply kill transport !
akt_rcode:= w0;
copyanswer(.w3.,w0:=address(akt_1),w1:=address(akt_rcode),w2:=b.event);
if w0 or akt_rcode=0 then
begin ! data copied to sender and operation accepted !
w2:= transref;
if w0:=(w2).tr_state=0 then
begin ! not finished !
w1:= (w2).tr_corou;
if w0:=(w1).tc_transno<>transno then
begin ! waiting !
w1:= address((w1).tc_nexttr);
repkill:
w1:= (w1).tq_next;
if w0:=(w1).tq_transno<>transno then goto repkill;
link(.w3.,w1,w2:=address(b.tqfreefst));
w2:= transref;
if w0:=(w2).tr_removetime=8'37777776 ! released ! then w0:= 0
else
begin
w1:= 108;
f1:= (w1).double+b.trsaveperiod lshift -20;
end;
(w2).tr_removetime:= w1;
(w2).tr_state:= w0:= 8; ! killed by appl !
w0:= (w2).tr_waitmess;
w1:= 0; (w2).tr_waitmess:= w1;
puttransport(.w3.,w1:=transno);
if w0>0 then
begin
b.event:= w0; ! very dirty !
agt_1:= w0:= 7;
goto tr_finished;
end;
end
else
begin ! set coroutine flag !
(w1).tc_aintervent:= w0:= 1;
end;
end; ! not finished !
end; ! data copied to sender !
end ! kill !
else
begin
reject:
w0:= 2;
if w0<>w0 then
begin
unint:
w0:= 3;
end;
b.ans_status:= w1:= 0;
if w1<>w1 then
begin
stopped:
w0:= 1;
b.ans_status:= w1:= 8'400;
end;
b.ans_bytes:= w1:= 0;
b.ans_chars:= w1;
w1:= address(b.ans_status);
w2:=b.event;
monitor(22); ! send answer !
testout(.w3.,w0:=2,w1,w2:=61);
end;
w0:= 0;
(w3).c_mbuf:= w0;
goto wait_m;
end;
end; ! appl_interface !
!branch 1,4;
body of nextchar
begin
incode
ref return;
begin
return:= w3;
if w1=0 then
if w2=(w3).stp then w1:= 10 ashift 16
else
begin
w1:= (w2).word;
w2+2;
end;
w0:= 0;
f1 lshift 8;
w3:= return;
end;
end; ! nextchar !
body of nextparam
begin
label l_text, outloop1, exit;
incode
ref return;
word paramtype, char;
ref parampointer, stoppointer;
begin
return:= w3;
parampointer:= w0:= (w3).paramref;
w0+8; stoppointer:= w0;
for w3:= stoppointer-2 step 2 downto parampointer do (w3).word:= w0:= 0;
w0:= 32;
while w0=32 do nextchar(.w3.,w3:=return.stopbuf,w0,w1,w2);
if w0=64 ! asterix ! then
begin
paramtype:= w3:= 2;
nextchar(.w3.,w3:=return.stopbuf,w0,w1,w2);
if w0<97 then
begin
paramtype:= w0:= -1; goto exit;
end;
goto l_text;
end
else
if w0>=97 then
begin ! text !
paramtype:= w3:= 1;
l_text:
while w0<>32 do
begin
if w0=10 then goto outloop1;
char:= w0;
if w3:=parampointer=stoppointer then ! string too long !
begin
paramtype:= w0:= -1; goto exit;
end;
(w3).word:= w0:= (w3).word lshift 8 + char;
if w0>4'33333333 then
begin
w3+2; parampointer:= w3;
end;
nextchar(.w3.,w3:=return.stopbuf,w0,w1,w2);
end;
outloop1:
if w3:=parampointer<stoppointer then
begin
w0:= (w3).word;
if w0<>0 then while w0<=4'33333333 do w0 lshift 8;
(w3).word:= w0;
end;
end
else
if w0=10 then
paramtype:= w0:= 0
else
if w0< 48 then
paramtype:= w0:= -1
else
if w0>= 58 then
paramtype:= w0:= -1
else
begin ! digit !
paramtype:= w3:= 3;
word(parampointer):= w3:= 0;
while w0<>32 do
begin
if w0=10 then goto exit;
char:= w0;
if w0<48 then w0:= 200;
if w0>=58 then ! not digit !
begin
paramtype:= w0:= -1; goto exit;
end;
w0:= word(parampointer); w0*10;
w0+char-48;
word(parampointer):= w0;
if w3<>0 then ! too big !
begin
paramtype:= w0:= -1; goto exit;
end;
nextchar(.w3.,w3:=return.stopbuf,w0,w1,w2);
end;
end;
exit:
w0:= paramtype;
w3:= return;
end;
end; ! nextparam !
body of lookupremote
begin
incode
word savew1, savew2;
ref return;
text(14) host:= "host";
! operation message !
word om_op;
ref om_first, om_last;
ref om_procref;
! operation output !
word oo_modekind:=14,
oo_timeoutsbuffers:= 0,
oo_bufsize:= 0;
text(11) oo_deviname;
word oo_unu1;
word oo_net1:= 0, oo_net2:= 0, oo_unu2;
! operation answer !
word oa_return,oa_bytes,oa_chars,oa_net1,oa_net2,oa_net3,oa_d1,oa_d2;
! operation input !
word oi_kind,oi_bufs,oi_bufsize;
text(11) oi_deviname;
word oi_net1,oi_net2,oi_net3;
ref oi_procdescr;
begin
savew1:= w1; savew2:= w2; return:= w3;
if w0:=(w3).lur_function=2 then w0:= 2'000000000001000000000101
else w0:= 2'000000000001000000000111;
om_op:= w0;
w3:= (w3).lur_procnameref;
monitor(4); ! get process description !
om_procref:= w0;
move(.w3.,w0:=8,w1:=return.lur_devname,w2:=address(oo_deviname));
! move output to input area !
move(.w3.,w0:=22,w1:=address(oo_modekind),w2:=address(oi_kind));
om_first:= w2;
w2+20;
om_last:= w2;
testout(.w3.,w0:=22,w1,w2:=66);
w1:= address(om_op);
testout(.w3.,w0:=12,w1,w2:=2);
w3:= address(host);
monitor(16); ! send message !
w1:= address(oa_return);
monitor(18); ! wait answer !
if w0<>1 then oa_return:= w0:= 1; ! a little bit dirty !
testout(.w3.,w0:=12,w1,w2:=67);
testout(.w3.,w0:=22,w1:=address(oi_kind),w2:=66);
w0:= oa_return;
w1:= oi_kind;
w2:= savew2;
(w2).word:= w3:= oa_net1;
w2+2;
(w2).word:= w3:= oa_net2;
w2:= savew2;
w3:= return;
end;
end; ! look up remote !
body of terminalid
comment convert devicehost linkno to the corresponding devicename.
+++++++ This procedure exists only because the host procedure
+++++++ lookup link is not implemented yet. the procedure is very dirty
+++++++ because it uses an implementational detail in the device
+++++++ host ;
begin
incode
double savef1;
word savew2;
ref return;
text(11) terminal:= "terminal";
begin
savef1:= f1; savew2:= w2; return:= w3;
w0+1; ! devicename = "terminal" concat text(devicehost linkno + 1) !
w3:= 0;
f0//10;
w2:= address(terminal);
w2+4;
if w0=0 then
begin
(w2).word:= w1:= (w2).word lshift -8 lshift 8 + 48 + w3;
w2+2;
(w2).word:= w1:= 0;
end
else
begin
(w2).word:= w1:= (w2).word lshift -8 lshift 8 + 48 + w0;
w2+2;
(w2).word:= w1:= w3+48;
end;
move(.w3.,w0:=8,w1:=address(terminal),w2:=savew2);
f1:= savef1; w3:= b.current;
call w0 return;
end;
end;
body of find_consoldevice
comment find a transport coroutine with the console name and device name
given as parameters;
begin
label found;
incode
word savew0, savew1, savew2;
ref return;
byte dhlinkno, hostno;
word hostid;
text(11) workname;
begin
savew0:= w0; savew1:= w1; savew2:= w2;
return:= w3;
if w0=2 then ! remote !
begin ! get devicename of operator terminal !
lookupremote(.w3.,w3:=2,w1,w2,w0,w1,w2:=address(dhlinkno));
w2:= address(workname);
if w0 extract 12=0 ! device lookup up ! then
terminalid(.w3.,w0:=dhlinkno,w2)
else
(w2).word:= w0:= -1;
end;
w1:= b.tcpool_fst;
while w1<b.tcpool_top do
begin
compare(.w3.,w0:=8,w1+!position(tc_devname),w2:=savew2);
w1-!position(tc_devname);
if w0=0 then
begin
if w0:=savew0=1 ! local device ! then
begin
if w0:=(w1).tc_hostno=0 then
begin
compare(.w3.,w0:=8,w1+!position(tc_console),w2:=savew1);
w1-!position(tc_console);
if w0=0 then goto found;
end;
end
else
begin
if w0:=(w1).tc_hostno<>0 then
begin
compare(.w3.,w0:=8,w1+!position(tc_devcons),w2:=address(workname));
w1-!position(tc_devcons);
if w0=0 then goto found;
end;
end;
end;
w1:= (w1).tc_nexttc;
end;
w1:= 0;
found:
if w0:=(w1).tc_created=0 then -(w1);
w0:= savew0; w2:= savew2;
w3:= b.current;
call w0 return;
end;
end;
body of operator
comment operator coroutine;
begin
label outloop1,outloop2,outtext;
incode
text(2) oproutput:= "=";
word stopbuf, char, partial;
ref bufpointer;
word paramno, comno;
ref devcorout;
byte kind, dummy;
byte dhlinkno, hostno;
word hostid;
word param1type;
text(11) devname;
word freeparam; text(8) freedummy; ! may be changed by nextparam !
text(11) command,
start := "start",
restart := "restart",
stop := "stop",
kill := "kill",
request := "request",
signup := "signup",
signoff := "signoff",
emptytext:= "";
comment command syntax table.
command syntax:
<command> (<process> (<freeparam>))
<command> ::= <text>
<process> ::= <text> ! @<text>
<freeparam> ::= <pos. integer>
the table contains for every command an entry containing:
<action> lshift 6+<process param legal> shift 4+<free param legal> lshift 2
<action> the action to perform
<param legal> = 2'00 param illegal
2'01 param optional
2'10 param compulsary;
byte csyntax, ! current syntax entry !
csyntax1 := 4'2210, ! start !
csyntax2 := 4'2200, ! restart !
csyntax3 := 4'2200, ! stop !
csyntax4 := 4'2200, ! kill !
csyntax5 := 4'3000, ! request !
csyntax6 :=4'10220, ! signup !
csyntax7 :=4'11200, ! signoff !
csyntaxlast:= 4'1000; ! empty !
! reply texts !
text(26) t_ready := "ready",
t_syntax := "***syntax",
t_comm := "***command unknown",
t_plusparam := "***command +param",
t_minusparam:= "***command -param",
t_unknown := "***device unknown",
t_stateill := "***state illegal",
t_notallow := "***not allowed",
t_nores := "***no resources";
! reply output format !
text( 6) time;
text(11) ownname;
text( 2) colon:= ":";
text(26) vartext;
text( 1) lasttext:= "'10'";
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
while w1=w1 do
begin
waitmess(.w3.,w2);
w0:= 1;
w1:= address(b.ans_status);
monitor(22); ! send answer !
w1:= (w3).opr_buf; w2:= address((w1).buf_data1);
move(.w3.,w0:=2,w1:=address(oproutput),w2);
w1:= (w3).opr_buf;
(w1).buf_op:= w0:= 5;
(w1).buf_first:= w0:= address((w1).buf_data1);
(w1).buf_last:= w0:= w0;
testout(.w3.,w0-(w1).buf_first+2,w1:=(w1).buf_first,w2:=0);
w1:= (w3).opr_buf;
sendwait(.w3.,w0,w1,w2:=address((w3).opr_console));
(w1).buf_op:= w0:= 3;
w0:= (w1).buf_first;
w0+b.oprt_bufl-2;
(w1).buf_last:= w0;
sendwait(.w3.,w0,w1,w2);
! input received interpret command !
if w0<>1 then w0:= 0 else w0:= b.ans_bytes;
w1:= (w1).buf_first;
testout(.w3.,w0,w1,w2:=0);
bufpointer:= w1;
w1+w0; stopbuf:= w1;
partial:= w0:= 0;
nextparam(.w3.,w3:=address(command),w3:=stopbuf,w0,w1:=partial,
w2:=bufpointer);
partial:= w1; bufpointer:= w2;
if w0>1 then w0:= -1;
if w0<0 then
begin
w1:= address(t_syntax); goto outtext;
end;
! find number of command !
w1:= address(emptytext);
w1+8;
w2:= address(command);
w0:= 1;
while w0<>0 do
begin
w1-8;
compare(.w3.,w0:=8,w1,w2);
end;
if w1=w2 then
begin ! command unknown !
w1:= address(t_comm); goto outtext;
end;
comno:= w1-w2 ashift -3;
!test 202;
w2:= address(csyntax);
w2+w1;
csyntax:= w1:= (w2).byte;
nextparam(.w3.,w3:=address(devname),w3:=stopbuf,w0,w1:=partial,
w2:=bufpointer);
partial:= w1; bufpointer:= w2;
param1type:= w0;
if w0=3 ! number ! then w0:= -1;
if w0=-1 then
begin
w1:= address(t_syntax); goto outtext;
end;
if w2:= csyntax lshift -4 extract 2=0 then
begin
if w0<>0 then
begin
w1:= address(t_plusparam); goto outtext;
end;
end
else
if w2=2'10 then
begin
if w0=0 then
begin
w1:= address(t_minusparam); goto outtext;
end;
end else;
nextparam(.w3.,w3:=address(freeparam),w3:=stopbuf,w0,w1:=partial,
w2:=bufpointer);
w3:= b.current;
!test 203;
if w0<>3 ! number ! then
if w0<>0 then
begin
w1:= address(t_syntax); goto outtext;
end;
if w2:=csyntax lshift -2 extract 2=0 then
begin
if w0<>0 then
begin
w1:= address(t_plusparam); goto outtext;
end;
end
else
if w2=2'10 then
begin
if w0=0 then
begin
w1:= address(t_minusparam); goto outtext;
end;
end else;
! execute command !
w2:= csyntax lshift -6;
!test 204;
case w2 of
begin
begin ! no action !
end;
begin ! put command into corou. descr. !
find_consoldevice(.w3.,w0:=param1type,w1:=address((w3).opr_console),
w2:=address(devname));
devcorout:= w1;
if w1<=0 then
begin
if w1=0 then w1:=address(t_unknown) else w1:=address(t_stateill);
goto outtext;
end;
if w0:=comno=1 ! start ! then
begin
if w2:=freeparam>2000 then
begin
w1:= address(t_notallow); goto outtext;
end;
end
else
if w2=2 ! restart ! then
begin
if w0:=(w1).tc_kind<>14 ! printer ! then
if w0<>12 ! punch ! then
begin
w1:= address(t_notallow);
goto outtext;
end;
end else;
w0:= 1;
w1:= b.holdqfst;
while w2:=address(b.holdqfst)<>w1 do
begin ! scan hold queue !
(w3).opr_savew1:= w1;
compare(.w3.,w0:=8,w1:=address((w1).tc_devname),
w2:=address(devname));
w1:= (w3).opr_savew1;
if w0=0 then
begin ! device corout found !
w1:= address(b.holdqfst);
end
else
w1:= (w1).c_next;
end;
w1:= devcorout;
if w0<>0 then
begin ! device corout not in hold state !
if w0:= comno<> 3 ! stop ! then
begin
w1:= address(t_stateill); goto outtext;
end;
end
else
begin ! device corout in hold state !
if w0:=comno=3 then
begin
w1:= address(t_stateill); goto outtext;
end;
link(.w3.,w1,w2:=address(b.activqfst));
end;
(w1).tc_ointervent:= w0:= freeparam lshift 12+comno;
end;
begin ! request !
w1:= b.holdqfst;
while w2:=address(b.holdqfst)<>w1 do
begin ! scan hold queue !
(w3).opr_savew1:= w1;
compare(.w3.,w0:=8,w1:=address((w1).tc_console),w2:=address((w3).opr_console));
if w0=0 ! match ! then
begin ! coroutine in hold state with operator terminal !
! as console found !
w1:= (w3).opr_savew1;
w1:= (w1).tc_buf;
w0:= (w1).buf_last;
w2:= (w1).buf_first;
w0-w2+2;
if w0>b.oprt_bufl then key(char):= w1; ! halt !
testout(.w3.,w0,w1,w2:=0);
sendwait(.w3.,w0,w1,w2:=address((w3).opr_console));
end;
w1:= (w3).opr_savew1;
w1:= (w1).c_next;
end;
end; ! request !
begin ! signup !
if w0:=param1type<>2 then
begin
w1:= address(t_notallow); goto outtext;
end;
w3:= address((w3).opr_console);
lookupremote(.w3.,w0:=3,w3,w3:=address(devname),w0,w1,w2:=address(dhlinkno));
!test 231;
kind:= w1;
if w1:=freeparam<>0 then kind:= w1;
if w0<>0 ! no link ! then
if w0<>4096 ! remote link exist ! then
begin
if w0 extract 12<>0 then w1:= address(t_unknown)
else w1:= address(t_stateill);
goto outtext;
end;
find_tc(.w3.,w3:=address(devname),w3:=hostno,w3:=hostid,
w3:= kind,
w1);
!test 232;
if w1=0 then
begin
w1:= address(t_nores); goto outtext;
end;
if w1>0 then
begin
w1:= address(t_stateill); goto outtext;
end;
-(w1);
devcorout:= w1;
(w1).tc_hostno:= w0:= hostno;
(w1).tc_hostid:= w0:= hostid;
move(.w3.,w0:=8,w1:=address(devname),
w2:=address((w2:=devcorout).tc_devname));
move(.w3.,w0,w1:=address((w3).opr_console),
w2:=address((w2:=devcorout).tc_console));
lookupremote(.w3.,w0:=2 ! lookup process !, w0:= address((w3).opr_console),
w0 ! devname dummy ! , w0,w1,w2:=address(dhlinkno));
w3:= b.current;
terminalid(.w3.,w0:=dhlinkno,w2:=address((w2:=devcorout).tc_devcons));
testout(.w3.,w0:=!length(transpcorout),w1:=devcorout,w2:=68);
end;
begin ! signoff !
find_consoledevice(.w3.,w0:=param1type,w1:=address((w3).opr_console),
w2:=address(devname));
!test 250;
if w1=0 then
begin
w1:= address(t_unknown); goto outtext;
end;
if w1>0 then
begin
w1:= address(t_stateill); goto outtext;
end;
-(w1);
w1:= address((w1).tc_console);
(w2).word:= w0:= 0;
w2:= address((w1).tc_devcons);
(w2).word:= w0;
end;
end; ! case !
w1:= address(t_ready);
outtext:
! w1 abs ref reply text !
move(.w3.,w0:=18,w1,w2:=address(vartext));
outtime(.w3.,w2:=address(time));
w1:= 66; w1:= (w1).word+2;
move(.w3.,w0:=8,w1,w2:=address(ownname));
w0:= address(lasttext);
w2:=address(time);
w0-w2;
w1:=(w3).opr_buf;
(w1).buf_op:= w2:= 5;
(w1).buf_last:= w2:= (w1).buf_first+w0;
w0+2;
w2:= (w1).buf_first;
move(.w3.,w0,w1:=address(time),w2);
testout(.w3.,w0,w1,w2:=0);
sendwait(.w3.,w0,w1:=(w3).opr_buf,w2:=address((w3).opr_console1));
w0:= 0;
(w3).c_mbuf:= w0 ! clear operation !
end; ! loop !
end;
end; ! operator !
!branch 1,5;
body of get_block
comment
get the next block to be output on device from the area connected
to current coroutine
;
begin
label rep, exit;
incode
word zero:= 0;
word bl; ! length of current block !
word savew0, savew1;
ref return;
word status, bytes, chars, a4, a5, a6, a7, a8;
begin
savew0:= w0; savew1:= w1; return:= w3;
w3:= b.current;
w0:= (w3).tc_bsl;
w1:= (w3).tc_bsu;
w3:= address(zero);
monitor(72); ! set cat.base !
!test 901;
bl:= w0:= 0;
w3:= b.current;
b.bs_segno:= w0:= (w3).tc_bsptr ashift -9 - 1;
while w0:= bl<savew0 do
begin ! get data from bs and move to device buffer !
b.bs_op:= w0:= 3;
b.bs_segno:= w0:= b.bs_segno +1;
rep:
w1:= address(b.bs_op);
testout(.w3.,w0:=8,w1,w2:=52);
w3:= address((w3:=b.current).tc_bsname);
monitor(16); ! send message !
w1:= address(status);
monitor(18); ! wait answer !
w2:= 1 lshift w0;
if w0=1 then w2+status else bytes:= w0:= 0;
status:= w2;
if w2 and 2'100100<>0 then
begin ! create and reserve area process !
monitor(52); ! create !
!test 904;
if w0=0 then
monitor(8); ! reserve !
!test 905;
if w0<>0 then goto exit;
goto rep;
end;
w3:= b.current;
if w2:= status=2 then
begin ! move to transp. corout. buffer !
if w0:=bytes=0 then goto rep;
w1:= (w3).tc_bsptr+bl extract 9;
w0-w1; ! not used in bs buffer !
w2:= savew0-bl; ! free bytes in buffer !
if w0>w2 then w0:= w2;
w2:= savew1+bl;
move(.w3.,w0,w1+b.bs_first,w2);
bl:= w0+bl;
end
else goto exit;
end;
exit:
w0:= bl;
w1:= savew1;
w2:= status;
w3:= b.current;
!test 910;
call w0 return;
end;
end; ! get_block !
body of put_block
comment put the block pointed out by the parameters into the area
connected to current coroutine.
the block is put from the current bsposition and onwards.
the rest of the segment is filled with zeroes;
begin
label rep2, exit;
incode
word zero:= 0;
word savew0, savew1;
ref return;
word status, bytes, chars, a4, a5, a6, a7, a8;
begin
savew0:= w0; savew1:= w1; return:= w3;
w3:= b.current;
w1:= (w3).tc_bsptr-2; ! end of last record !
if w0:=savew0+w1 ashift -9 ashift 9>w1 then
begin ! not room on current segment, clear buffer !
!test 911;
(w3).tc_bsptr:= w0;
w0:= 0;
for w1:= b.bs_first step 2 upto b.bs_last do (w1).word:= w0;
w0:= (w3).tc_bsl; w1:= (w3).tc_bsu;
w3:= address(zero);
monitor(72); ! set cat. base !
!test 912;
end
else
begin ! get segment !
get_block(.w3.,w0:=2,w1:=address(status),w2);
if w2<>2 then goto exit;
end;
! copy block to bs buffer !
w2:= (w3:=b.current).tc_bsptr extract 9;
move(.w3.,w0:=savew0,w1:=savew1,w2+b.bs_first);
!test 916;
! put segment !
b.bs_op:= w0:= 5;
b.bs_segno:= w0:= (w3).tc_bsptr ashift -9;
rep2:
w1:= address(b.bs_op);
testout(.w3.,w0:=8,w1,w2:=52);
w3:= address((w3:=b.current).tc_bsname);
monitor(16); ! send message !
w1:= address(status);
monitor(18); ! wait answer !
w2:= 1 lshift w0;
if w0=1 then w2+status else bytes:= w0:= 0;
if w0:= w2 and 2'100100<>0 then
begin ! create and reserve area process !
monitor(52); ! create !
!test 914;
if w0=0 then
monitor(8); ! reserve !
!test 915;
if w0<>0 then goto exit;
goto rep2;
end;
if w2=2 then
if w0:=bytes=0 then goto rep2;
exit:
w1:= savew1;
if w2<>2 then w0:= 0 else w0:= savew0;
w3:= b.current;
!test 920;
call w0 return;
end;
end;
body of closebs
comment
terminate the use of the area connected to current printer coroutine
;
begin
incode
ref return;
word zero:= 0;
double savef1;
begin
savef1:= f1;
return:= w3;
w3:= b.current;
w0:= (w3).tc_bsl;
w1:= (w3).tc_bsu;
w3:= address(zero);
monitor(72); ! set cat.base !
w3:= address((w3:=b.current).tc_bsname);
monitor(64); ! remove process !
f1:= savef1;
w3:= b.current;
call w0 return;
end;
end; ! closebs !
body of hold
comment link current coroutine into the hold-queue;
begin
incode
ref return;
begin
return:= w3;
w3:= b.current;
(w3).c_w0:= w0;
(w3).c_w1:= w1;
(w3).c_w2:= w2;
(w3).c_ic:= w0:= return;
link(.w3.,w1:=w3,w2:=address(b.holdqfst));
testout(.w3.,w0:=!length(coroutine),w1,w2:=4);
goto b.activate;
end;
end; ! hold !
body of oproutput
begin
label rep_sw, exit;
record outformat ! output format !
(text( 6) time;
text(11) ownname;
word colon;
word outtype;
word asterix;
text(11) processname;
text(1) vartext); ! start of variable message !
incode
text( 9) t1:= " prepare ";
text(11) t1trname;
text( 1) t11:= " ";
text(11) t1truser;
text( 1) t12:= " ";
text(11) t1trqgroup;
text( 1) t13:= ".";
text(11) t1trqname;
text(15) t2 := " intervention",
t21 := " parity error",
t22 := " timer",
t23 := " data overrun",
t24 := " block length",
t25 := " end document",
t26 := " load point",
t27 := " tapemark, att",
t28 := " write enable",
t29 := " mode error",
t210:= " read error",
t211:= " card reject",
t212:= " bit 12",
t213:= " bit 13",
t214:= " bit 14",
t215:= " stopped",
t216:= " word defect",
t217:= " position err.",
t218:= " do'39'nt exist",
t219:= " disconnected",
t220:= " unintelligent",
t221:= " rejected",
t222:= " normal";
text(21) t3:= " stopped by operator";
text(14) t4:= " end transport"; word t4state;
text(10) t5:= " transmit";
word textsize;
ref transref; ! abs ref descr of transport !
ref bufref; ! abs ref first of data in buffer !
text(14) clock:="clock";
word timeunit:= 0, timevalue:= 20;
word savew2;
begin
savew2:= w2;
w2:= b.current;
(w2).tc_saveic:= w3;
w3:= b.current;
w2:= address((w3).tc_console);
if w2:=(w2).word=0 then ! no operator exist !
begin
w2:= 32; ! does not exist ! goto exit;
end;
w2:= (w3).tc_buf;
w2:= address((w2).buf_data1);
bufref:= w2;
if w0=1 then w0:= 0
else
if w0=2 then w0:= 2763306 ! *** !
else;
(w2).outtype:= w0;
if w0:=(w3).tc_hostno<>0 ! remote ! then w0:= 64; ! asterix !
(w2).asterix:= w0;
case w1 of ! select variable text !
begin
begin
looktransport(.w3.,w1:=(w3).tc_transno,w2);
transref:= w2;
move(.w3.,w0:=8,w1:=address((w2).tr_name),w2:=address(t1trname));
move(.w3.,w0,w1:=address((w1:=transref).tr_user),w2:=address(t1truser));
move(.w3.,w0,w1:=address((w1:=transref).tr_qgroup),w2:=address(t1trqgroup));
move(.w3.,w0,w1:=address((w1:=transref).tr_qname),w2:=address(t1trqname));
w1:= address(t1);
if w0:=(w2).word=0 then w0:= 24 else w0:= 44;
end;
begin ! status error !
w0:= -10; w1:= 0; w2:= savew2;
while w1=0 do
begin
f2 lshift 1; w0+10;
end;
w1:= address(t2);
w1+w0;
w0:= 10;
end; ! status error !
begin ! operator stop !
w1:= address(t3);
w0:= 14;
end;
begin ! end transport !
t4state:= w0:= savew2+ 4'02000300; ! state + " 0" !
w1:= address(t4);
w0:= 12;
end;
begin ! transmit !
w1:= address(t5); w0:= 8;
end;
end; ! case !
! w1 abs ref start of variable text, w0 length of variable text !
textsize:= w0;
move(.w3.,w0,w1,w2:=address((w2:=bufref).vartext));
(w2+w0).word:= w1:= 10; ! terminate text with nl !
outtime(.w3.,w2:=address((w2:=bufref).time));
w1:= 66; w1:= (w1).word+2;
move(.w3.,w0:=8,w1,w2:=address((w2:=bufref).ownname));
bufref.colon:= w1:= 58; ! ":" !
move(.w3.,w0,w1:=address((w3).tc_devname),w2:=address((w2:=bufref).processname));
w1:= (w3).tc_buf;
(w1).buf_op:= w2:= 5;
(w1).buf_mode:= w2:= 0;
(w1).buf_first:= w2:= bufref;
w0:= !length(outformat)+textsize; ! including one word for nl !
w2+w0-2;
(w1).buf_last:= w2;
testout(.w3.,w0,w1:=(w1).buf_first,w2:=0);
rep_sw:
sendwait(.w3.,w0,w1:=(w3).tc_buf,w2:=address((w3).tc_console));
w2:= 1 ashift w0;
if w2=2 then w2+b.ans_status
else
begin
b.ans_bytes:= w0:= 0;
if w0:= w2 and 2'110000 <> 0 then ! does not exist, disconnected !
begin
if w0:=(w3).tc_hostno<>0 then
begin
sendwait(.w3.,w0,w1:=address(timeunit),w2:=address(clock)); ! delay !
linkupremote(.w3.,w0:=8,w0:=(w3).tc_hostno,w0:=(w3).tc_hostid,
w0:=address((w3).tc_devcons),w0,w2);
w3:= b.current;
if w0=4096 ! created ! then
begin
w1:= w2; w1+2;
move(.w3.,w0:=8,w1,w2:=address((w3).tc_console));
goto rep_sw;
end
else w2:= 32;
end;
end;
end;
if w0:=8'00200002 onemask w2 then ! no status bits except att and normal !
if w0:=(w1).buf_first+b.ans_bytes<=(w1).buf_last then goto rep_sw;
exit:
!test 1010;
call w0 (w3).tc_saveic;
end;
end; ! oproutput !
body of updatetransport
comment update description of transport;
begin
incode
ref transref;
! answer wait and get state of transport !
byte awt_1:= 7, awt_2:= 0,
awt_3:= 4, awt_4:= 4'010000,
awt_5:= 1, awt_6:= 4'020001;
word awt_rcode:= 0;
byte awt_7:= 1, awt_8:= 4'010010;
text(11) awt_trname;
byte awt_9:= 1, awt_10:= 4'010001;
word awt_no;
byte awt_11:= 1000, awt_12:= 4'010000,
awt_13:= 3, awt_14:= 4'020000,
awt_15:= 4, awt_16:= 4'030001;
word awt_state;
byte awt_19:= 7, awt_20:= 4'030002;
word awt_ptr1, awt_ptr2;
byte awt_17:=6, awt_18:= 4'030002;
word awt_cause, awt_status;
double savef1;
word savew2;
ref return;
begin
savef1:= f1;
savew2:= w2;
return:= w3;
w3:= b.current;
awt_no:= w1:= (w3).tc_transno;
looktransport(.w3.,w1,w2);
transref:= w2;
awt_state:= w0:= (w3).tc_state;
(w2).tr_state:= w0;
awt_cause:= w0:= (w3).tc_cause;
(w2).tr_cause:= w0;
awt_status:= w0:= (w3).tc_status;
(w2).tr_status:= w0;
awt_ptr1:= w0:= 0;
w1:= (w3).tc_bsptr;
awt_ptr2:= w0:= w1+(w1 ashift -1); ! convert halfword position to char pos. !
(w2).tr_charposition:= w0;
if w0:=(w2).tr_waitmess>0 then
begin ! pending wait operation !
move(.w3.,w0:=8,w1:=address((w2).tr_name),w2:=address(awt_trname));
if w1:=awt_state=5 ! completed ! then w1:= address(awt_ptr2)
else
if w1=6 ! aborted ! then w1:= address(awt_status)
else w1:= address(awt_state);
copyanswer(.w3.,w0:=address(awt_1),w1,w2:=transref.tr_waitmess);
b.waitbufs:= w0:= b.waitbufs+1;
w2:= transref;
w0:= 0;
(w2).tr_waitmess:= w0;
end;
if w1:=(w2).tr_removetime=8'37777776 then w1:= 0
else
begin
w1:= 108;
f1:= (w1).double+b.trsaveperiod lshift -20;
end;
(w2).tr_removetime:= w1;
puttransport(.w3.,w1:=awt_no);
f1:= savef1;
w2:= savew2;
w3:= b.current;
call w0 return;
end;
end; ! updatetransport !
body of check_devicestatus
comment check device status for current coroutine, and clear noise
in hwords transferred.
try to repair rejected and does not exist;
begin
incode
double savef1;
word helpw2;
ref return;
begin
savef1:= f1;
return:= w3;
w3:= b.current;
w2:= 1 ashift w0;
if w2=2 then w2+(w1).word
else
begin
w1+2; (w1).word:= w0:= 0; ! hwords:= 0 !
if w2=4 then
begin ! rejected !
w3:= address((w3).tc_name);
monitor(8); ! reserve !
if w0=0 then w2:= 2;
end
else
if w0:= w2 and 2'110000 <> 0 then
begin ! does not exist !
if w0:= (w3).tc_hostno<>0 ! remote ! then
begin
helpw2:= w2;
linkupremote(.w3.,w0:=(w3).tc_kind,w0:=(w3).tc_hostno,
w0:=(w3).tc_hostid,w0:=address((w3).tc_devname),w0,w2);
w3:= b.current;
if w0=4096 ! created ! then
begin
w1:= w2; w1+2;
move(.w3.,w0:=8,w1,w2:=address((w3).tc_name));
w2:= 2;
end
else w2:= helpw2;
end;
end else;
end;
f1:= savef1;
w3:= b.current;
call w0 return;
end;
end;
!branch 2,6;
body of prlistid
begin
incode
ref return;
double savef2;
ref transref;
text(12) t_cont:= "contents of:";
text(13) t_trans:= "'10'transport :";
text(13) t_user := "'10'user :";
text(2) nlff:= "'10''12'";
begin
savef2:= f2; return:= w3;
w3:= b.current;
looktransport(.w3.,w1:=(w3).tc_transno,w2);
transref:= w2;
w2:= (w3).tc_buf; w2:= address((w2).buf_data1);
move(.w3.,w0:=8,w1:=address(t_cont),w2);
w2+w0;
move(.w3.,w0:=8,w1:=address((w1:=transref).tr_sname),w2);
w2+w0;
move(.w3.,w0:=10,w1:=address(t_trans),w2);
w2+w0;
move(.w3.,w0:=8,w1:=address((w1:=transref).tr_name),w2);
w2+w0;
move(.w3.,w0:=10,w1:=address(t_user),w2);
w2+w0;
move(.w3.,w0:=8,w1:=address((w1:=transref).tr_user),w2);
w2+w0;
move(.w3.,w0:=2,w1:=address(nlff),w2);
w2+w0;
w1:= (w3).tc_buf; w1:= address((w1).buf_data1);
w0:= w2-w1;
f2:= savef2;
w3:= b.current;
call w0 return;
end;
end;
body of prlistdate
comment generate a text containing the current date and time.
put the text into the buffer of current coroutine;
begin
procedure convertdecimal(.w3.;w0);
incode
text(11) ownname;
text(7) fillspaces:= " :";
word year,point1:=46,month,point2:=46,day,sp2:=32,
hour,point3:=46,min,nl:=10;
double savef2;
ref return;
begin
savef2:= f2; return:= w3;
w1:= 66; w1:= (w1).word+2;
move(.w3.,w0:=8,w1,w2:=address(ownname));
w1:= 108; ! get clock !
f1:= (w1).double;
f1 ashift -4; f1//(60*60*625);
w3:= 0; f0//(60*625);
convertdecimal(.w3.,w0);
min:= w0;
w0:= 0; f1//24;
convertdecimal(.w3.,w0);
hour:= w0;
f1 lshift 26;
w0+99111;
w3:= 0;
f0//1461; ! year !
w3 ashift -2;
w3*5; w3+461; f3//153;
if w3 ! month ! >=13 then
begin
w3-12; w0+1;
end;
month:= w3;
convertdecimal(.w3.,w0);
year:= w0;
convertdecimal(.w3.,w0:=month);
month:= w0;
w2+5; f2//5;
convertdecimal(.w3.,w0:=w2);
day:= w0;
w0:= address(nl); w1:= address(ownname);
w0-w1+2;
move(.w3.,w0,w1,w2:=address((w2:=(w3).tc_buf).buf_data1));
f2:= savef2;
w3:= b.current;
call w0 return;
end;
body of convertdecimal
begin
incode ref return;
begin
return:= w3;
w3:= 0;
f0//10;
w0+48 lshift 8+w3+48;
w3:= b.current;
call w0 return;
end;
end;
end; ! prlistdate !
body of pr
comment printer coroutine;
begin
label loop, closeup, suicide, startloop;
incode
text(15) contin:= "'12'continuation'10''10'";
text(102) triang1:= "
***************
*************
***********
*********
*******
*****
***
*
'10'";
text(103) triang2:= "'12'
*
***
*****
*******
*********
***********
*************
***************'10''10'";
ref first, last;
ref transref, queueref;
word halt;
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
while w1=w1 do
begin ! get next transport !
w1:= address((w3).tc_nexttr);
w1:= (w1).tq_next;
if w2:=address((w3).tc_nexttr)=w1 then goto suicide; ! end transp. queue !
! hold tranport if no corout in queue matches current !
while w2:=address((w3).tc_nexttr)<>w1 do
begin
queueref:= w1;
looktransport(.w3.,w1:=(w1).tq_transno,w2);
transref:= w2;
compare(.w3.,w0:=8,w1:=address((w2).tr_qgroup),w2:=address((w3).tc_qgroup));
if w0=0 then
compare(.w3.,w0:=8,w1:=address((w1:=transref).tr_qname),
w2:=address((w3).tc_qname));
halt:= w0;
if w0=0 then w1:= address((w3).tc_nexttr)
else w1:= queueref.tq_next;
end;
!test 205;
if w0:=halt<>0 then
begin ! no matching transport found !
w1:= (w3).tc_nexttr;
queueref:= w1;
looktransport(.w3.,w1:=(w1).tq_transno,w2);
transref:= w2;
end;
w1:= queueref;
(w3).tc_transno:= w0:= (w1).tq_transno;
link(.w3.,w1:=queueref,w2:=address(b.tqfreefst));
w2:= transref;
(w3).tc_ointervent:= w0:= 0;
(w3).tc_aintervent:= w0;
(w3).tc_mode:= w0:= (w2).tr_mode;
(w3).tc_bsl:= w0:= (w2).tr_basel;
(w3).tc_bsu:= w0:= (w2).tr_baseu;
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
(w3).tc_state:= w0:= 0;
move(.w3.,w0:=8,w1:=address((w2).tr_bsarea),w2:=address((w3).tc_bsname));
move(.w3.,w0,w1:=address((w1:=transref).tr_qgroup),
w2:=address((w3).tc_qgroup));
move(.w3.,w0,w1:=address((w1:=transref).tr_qname),
w2:=address((w3).tc_qname));
if w0:=b.prheadtrail<>0 then (w3).pr_inpstate:= w0:= -3
else (w3).pr_inpstate:= w0;
if w0:=halt<>0 then
if w0:=(w2:=address((w3).tc_console)).word<>0 then
begin ! hold device !
oproutput(.w3.,w0:=1,w1:=1,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
hold(.w3.);
end;
loop:
if w2:=(w3).tc_ointervent<>0 then
begin ! operator intervention !
!test 206;
case w2 extract 12 of
begin
begin ! start !
looktransport(.w3.,w1:=(w3).tc_transno,w2);
(w3).pr_partial:= w0:= 0;
(w3).pr_worknls:= w0;
(w3).pr_workffs:= w0:= (w3).tc_ointervent lshift -12;
(w3).pr_workptr:= w0:= (w3).tc_bsptr;
(w3).pr_workstartptr:= w0:= (w2).tr_bsstartptr;
startloop:
! backfile until start of file or until !
! an appropriate nr of ffs or nls are met !
if w0:=(w3).pr_workffs=0 then
else
if w0:=(w3).pr_workptr<=(w3).pr_workstartptr then
else
begin
w0:= (w3).pr_partial;
if w0=0 then
begin
if w0:=(w3).tc_bsptr=(w3).pr_workptr then
begin
w0- (w3).tc_bufsize;
if w0<(w3).pr_workstartptr then w0:= (w3).pr_workstartptr;
(w3).tc_bsptr:= w0;
w1:= (w3).tc_buf;
(w1).buf_op:= w0:= 0; (w1).buf_mode:= w0; ! sense !
sendwait(.w3.,w0,w1,w2:=address((w3).tc_name)); ! pass !
get_block(.w3.,w0:=(w3).tc_bufsize,w1:=address((w1).buf_data1),w2);
if w1:=(w3).pr_workptr-(w3).tc_bsptr>w0 then
begin ! error, stop searching !
(w3).pr_workffs:= w0:= 0;
goto startloop;
end;
end;
(w3).pr_workptr:= w0:= (w3).pr_workptr-2;
w1:= (w3).tc_bsptr;
w0-w1; ! relative position in buffer !
w1:= (w3).tc_buf; w1:= address((w1).buf_data1);
w1+w0;
w0:= (w1).word;
end;
w1:= 0;
f1 lshift -8;
(w3).pr_partial:= w0;
w1 lshift -16;
if w1=12 then (w3).pr_workffs:= w0:= (w3).pr_workffs-1
else
if w1=10 then
begin
(w3).pr_worknls:= w0:= (w3).pr_worknls+1;
if w0=b.prlpage then
begin
(w3).pr_workffs:= w0:= (w3).pr_workffs-1;
(w3).pr_worknls:= w0:= 0;
end;
end else;
goto startloop;
end;
(w3).tc_bsptr:= w0:= (w3).pr_workptr;
end; ! start !
begin ! restart !
looktransport(.w3.,w1:=(w3).tc_transno,w2);
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
end;
if w0:=(w3).pr_inpstate<=0 then ! not trailing triangel !
begin ! stop !
oproutput(.w3.,w0:=1,w1:=3,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
(w3).tc_ointervent:= w0:= 0;
hold(.w3.);
(w3).pr_inpstate:= w0:= -4;
goto loop;
end;
begin ! kill !
(w3).tc_state:= w0:= 7; ! killed by operator !
goto closeup;
end
end; ! case !
(w3).tc_ointervent:= w2:= 0;
end;
if w2:=(w3).tc_aintervent<>0 then
begin
(w3).tc_state:= w0:= 8; ! killed by appl !
goto closeup;
end;
case w2:=(w3).pr_inpstate + 5 of
begin ! get next input block !
move(.w3.,w0:=10,w1:=address(contin),
w2:=address((w2:=(w3).tc_buf).buf_data1));
move(.w3.,w0:=68,w1:=address(triang1),
w2:=address((w2:=(w3).tc_buf).buf_data1));
prlistdate(.w3.,w0);
prlistid(.w3.,w0);
begin ! normal input mode !
get_block(.w3.,w0:=(w3).tc_bufsize,w1:=address((w1:=(w3).tc_buf).buf_data1),w2);
if w0<=0 then
begin
(w3).tc_state:= w1:= 6; ! aborted !
(w3).tc_cause:= w1:= 1; ! sender !
(w3).tc_status:= w2;
end
else
begin
! cut block size down if an em-char is found in the block !
w1:= (w3).tc_buf; first:= w2:= address((w1).buf_data1);
w2-2;
w0+w2;
last:= w0;
while w2+2<=last do
begin
w3:= 0;
w0:= (w2).word;
while w0<>0 do
begin
f0 lshift 8;
if w1:= w3 extract 8=25 then
begin
w3 lshift -8;
(w2).word:= w3;
last:= w2;
(w3:=b.current).tc_state:= w1:= 5; ! completed !
w0:= 0;
end;
end;
end;
w0:= last-first+2;
w3:= b.current;
end;
end;
move(.w3.,w0:=70,w1:=address(triang2),
w2:=address((w2:=(w3).tc_buf).buf_data1));
prlistdate(.w3.,w0);
prlistid(.w3.,w0);
end; ! case !
if w0>0 then
begin ! write next output block !
w1:= (w3).tc_buf;
(w1).buf_op:= w2:= 5; (w1).buf_mode:= w2:= (w3).tc_mode;
(w1).buf_first:= w2:= address((w1).buf_data1);
w2+w0-2; (w1).buf_last:= w2;
testout(.w3.,w0,w1:=(w1).buf_first,w2:=0);
w1:= (w3).tc_buf;
sendwait(.w3.,w0,w1,w2:=address((w3).tc_name));
check_devicestatus(.w3.,w0,w1:=address(b.ans_status),w2);
if w1:=(w3).pr_inpstate=0 then ! normal input mode !
(w3).tc_bsptr:= w0:= (w3).tc_bsptr+b.ans_bytes;
if w1<=0 then
if w2<>2 then
begin
if w0:=(w1:=address((w3).tc_console)).word<>0 then
begin
oproutput(.w3.,w0:=2,w1:=2,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
hold(.w3.);
if w0:=b.prheadtrail<>0 then (w3).pr_inpstate:= w0:= -4;
goto loop;
end
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 2; ! receiver !
(w3).tc_status:= w2;
goto closeup;
end;
end;
end;
case w2:=(w0:=(w3).pr_inpstate+1)+4 of
begin
(w3).pr_inpstate:= w0;
(w3).pr_inpstate:= w0;
(w3).pr_inpstate:= w0;
(w3).pr_inpstate:= w0;
begin ! normal input mode !
if w2:=(w3).tc_state>0 then
begin
if w2:=b.prheadtrail<>0 then (w3).pr_inpstate:= w0
else goto closeup;
end;
end;
(w3).pr_inpstate:= w0;
(w3).pr_inpstate:= w0;
goto closeup;
end;
!test 295;
goto loop;
closeup:
closebs(.w3.);
updatetransport(.w3.);
if w0:=b.oprtdetails<>0 then oproutput(.w3.,w0:=1,w1:=4,w2:=(w3).tc_state);
end; ! operation !
suicide:
remove_tc(.w3.,w1:=b.current);
goto b.activate;
end;
end; ! pr !
!branch 2,7;
body of pc
comment punch coroutine;
begin
label loop, closeup, suicide;
incode
ref first, last;
ref transref, queueref;
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
while w1=w1 do
begin ! get next transport !
w1:= address((w3).tc_nexttr);
w1:= (w1).tq_next;
if w2:=address((w3).tc_nexttr)=w1 then goto suicide; ! end transp. queue !
w1:= (w3).tc_nexttr;
queueref:= w1;
looktransport(.w3.,w1:=(w1).tq_transno,w2);
transref:= w2;
w1:= queueref;
(w3).tc_transno:= w0:= (w1).tq_transno;
link(.w3.,w1:=queueref,w2:=address(b.tqfreefst));
w2:= transref;
(w3).tc_ointervent:= w0:= 0;
(w3).tc_aintervent:= w0;
(w3).tc_mode:= w0:= (w2).tr_mode;
(w3).tc_bsl:= w0:= (w2).tr_basel;
(w3).tc_bsu:= w0:= (w2).tr_baseu;
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
(w3).tc_state:= w0:= 0;
move(.w3.,w0:=8,w1:=address((w2).tr_bsarea),w2:=address((w3).tc_bsname));
move(.w3.,w0,w1:=address((w1:=transref).tr_qgroup),
w2:=address((w3).tc_qgroup));
move(.w3.,w0,w1:=address((w1:=transref).tr_qname),
w2:=address((w3).tc_qname));
(w3).pc_inpstate:= w0:= -1;
begin ! hold device !
oproutput(.w3.,w0:=1,w1:=1,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
hold(.w3.);
end;
loop:
if w2:=(w3).tc_ointervent<>0 then
begin ! operator intervention !
!test 206;
case w2 extract 12 of
begin
begin ! start !
end; ! start !
begin ! restart !
looktransport(.w3.,w1:=(w3).tc_transno,w2);
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
end;
if w0:=(w3).pc_inpstate<=0 then
begin ! stop !
oproutput(.w3.,w0:=1,w1:=3,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
(w3).tc_ointervent:= w0:= 0;
hold(.w3.);
(w3).pc_inpstate:= w0:= -1;
goto loop;
end;
begin ! kill !
(w3).tc_state:= w0:= 7; ! killed by operator !
goto closeup;
end
end; ! case !
(w3).tc_ointervent:= w2:= 0;
end;
if w2:=(w3).tc_aintervent<>0 then
begin
(w3).tc_state:= w0:= 8; ! killed by appl !
goto closeup;
end;
case w2:=(w3).pc_inpstate + 2 of
begin ! get next input block !
begin ! put 90 null chars !
w1:= address((w2:=(w3).tc_buf).buf_data1);
(w1).word:= w0:= 0;
move(.w3.,w0:=60,w1,w2:=w1+2);
end;
begin ! normal input mode !
get_block(.w3.,w0:=(w3).tc_bufsize,w1:=address((w1:=(w3).tc_buf).buf_data1),w2);
if w0<=0 then
begin
(w3).tc_state:= w1:= 6; ! aborted !
(w3).tc_cause:= w1:= 1; ! sender !
(w3).tc_status:= w2;
end
else
begin
! cut block size down if an em-char is found in the block !
w1:= (w3).tc_buf; first:= w2:= address((w1).buf_data1);
w2-2;
w0+w2;
last:= w0;
while w2+2<=last do
begin
w3:= 0;
w0:= (w2).word;
while w0<>0 do
begin
f0 lshift 8;
if w1:= w3 extract 8=25 then
begin
w3 lshift -8;
(w2).word:= w3;
last:= w2;
(w3:=b.current).tc_state:= w1:= 5; ! completed !
w0:= 0;
end;
end;
end;
w0:= last-first+2;
w3:= b.current;
end;
end;
begin ! put 90 null chars !
w1:= address((w2:=(w3).tc_buf).buf_data1);
(w1).word:= w0:= 0;
move(.w3.,w0:=60,w1,w2:=w1+2);
end;
end; ! case !
if w0>0 then
begin ! write next output block !
w1:= (w3).tc_buf;
(w1).buf_op:= w2:= 5; (w1).buf_mode:= w2:= (w3).tc_mode;
(w1).buf_first:= w2:= address((w1).buf_data1);
w2+w0-2; (w1).buf_last:= w2;
testout(.w3.,w0,w1:=(w1).buf_first,w2:=0);
w1:= (w3).tc_buf;
sendwait(.w3.,w0,w1,w2:=address((w3).tc_name));
check_devicestatus(.w3.,w0,w1:=address(b.ans_status),w2);
if w1:=(w3).pc_inpstate=0 then ! normal input mode !
(w3).tc_bsptr:= w0:= (w3).tc_bsptr+b.ans_bytes;
if w1<=0 then
if w2<>2 then
begin
if w0:=(w1:=address((w3).tc_console)).word<>0 then
begin
oproutput(.w3.,w0:=2,w1:=2,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
hold(.w3.);
(w3).pc_inpstate:= w0:= -1;
goto loop;
end
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 2; ! receiver !
(w3).tc_status:= w2;
goto closeup;
end;
end;
end;
case w2:=(w0:=(w3).pc_inpstate+1)+1 of
begin
(w3).pc_inpstate:= w0;
begin ! normal input mode !
if w2:=(w3).tc_state>0 then
begin
(w3).pc_inpstate:= w0;
end;
end;
goto closeup;
end;
!test 295;
goto loop;
closeup:
closebs(.w3.);
updatetransport(.w3.);
if w0:=b.oprtdetails<>0 then oproutput(.w3.,w0:=1,w1:=4,w2:=(w3).tc_state);
end; ! get next transport !
suicide:
remove_tc(.w3.,w1:=b.current);
goto b.activate;
end;
end; ! pc !
!branch 2,8;
body of rd
comment reader coroutine;
begin
label loop, closeup, suicide;
incode
ref first, last;
ref transref, queueref;
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
while w1=w1 do
begin ! get next transport !
w1:= address((w3).tc_nexttr);
w1:= (w1).tq_next;
if w2:=address((w3).tc_nexttr)=w1 then goto suicide; ! end transp. queue !
w1:= (w3).tc_nexttr;
queueref:= w1;
looktransport(.w3.,w1:=(w1).tq_transno,w2);
transref:= w2;
w1:= queueref;
(w3).tc_transno:= w0:= (w1).tq_transno;
link(.w3.,w1:=queueref,w2:=address(b.tqfreefst));
w2:= transref;
(w3).tc_ointervent:= w0:= 0;
(w3).tc_aintervent:= w0;
(w3).tc_mode:= w0:= (w2).tr_mode;
(w3).tc_bsl:= w0:= (w2).tr_basel;
(w3).tc_bsu:= w0:= (w2).tr_baseu;
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
(w3).tc_state:= w0:= 0;
move(.w3.,w0:=8,w1:=address((w2).tr_bsarea),w2:=address((w3).tc_bsname));
move(.w3.,w0,w1:=address((w1:=transref).tr_qgroup),
w2:=address((w3).tc_qgroup));
move(.w3.,w0,w1:=address((w1:=transref).tr_qname),
w2:=address((w3).tc_qname));
begin ! hold device !
oproutput(.w3.,w0:=1,w1:=1,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
hold(.w3.);
end;
loop:
if w2:=(w3).tc_ointervent<>0 then
begin ! operator intervention !
!test 206;
case w2 extract 12 of
begin
begin ! start !
(w3).rd_inpstate:= w0:= (w3).tc_ointervent lshift -12;
end; ! start !
begin ! restart !
! command not allowed !
end;
begin ! stop !
oproutput(.w3.,w0:=1,w1:=3,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
(w3).tc_ointervent:= w0:= 0;
hold(.w3.);
goto loop;
end;
begin ! kill !
(w3).tc_state:= w0:= 7; ! killed by operator !
goto closeup;
end
end; ! case !
(w3).tc_ointervent:= w2:= 0;
end;
if w2:=(w3).tc_aintervent<>0 then
begin
(w3).tc_state:= w0:= 8; ! killed by appl !
goto closeup;
end;
! get next input block !
w1:= (w3).tc_buf;
(w1).buf_op:= w2:= 3; (w1).buf_mode:= w2:= (w3).tc_mode;
(w1).buf_first:= w2:= address((w1).buf_data1);
w2+(w3).tc_bufsize-2;
(w1).buf_last:= w2;
sendwait(.w3.,w0,w1,w2:=address((w3).tc_name));
check_devicestatus(.w3.,w0,w1:=address(b.ans_status),w2);
w1:= (w3).tc_buf;
if w0:=b.ans_bytes=0 then
begin
if w2=2 then goto loop;
(w1).buf_data1:= w0:= 4'012101210121; ! "<25><25><25>" !
if w0:= 8'01000002 ! end doc, normal ! onemask w2 then
begin
if w0:=(w3).rd_inpstate>0 then
begin ! file continues on another tape !
oproutput(.w3.,w0:=1,w1:=2,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
end
else
begin
hold(.w3.);
goto loop;
end;
end
else
begin
(w3).tc_state:= w0:= 5; ! completed !
end;
end
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 1; ! sender !
(w3).tc_status:= w2;
end;
w0:= 2;
end;
w1:= (w1).buf_first;
if w2:=(w1).word<>4'012101210121 then testout(.w3.,w0,w1,w2:=0);
put_block(.w3.,w0,w1,w2);
if w2=2 then (w3).tc_bsptr:= w0+(w3).tc_bsptr
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 2; ! receiver !
(w3).tc_status:= w2;
end;
if w0:=(w3).tc_state=0 then goto loop;
closeup:
closebs(.w3.);
updatetransport(.w3.);
if w0:=b.oprtdetails<>0 then oproutput(.w3.,w0:=1,w1:=4,w2:=(w3).tc_state);
end; ! get next transport !
suicide:
remove_tc(.w3.,w1:=b.current);
goto b.activate;
end;
end; ! rd !
!branch 2,9;
body of tw
comment tty coroutine;
begin
label loop, closeup, suicide;
incode
ref first, last;
ref transref, queueref;
ref return;
begin
return:= w3; call w3 return; ! pseudo call !
while w1=w1 do
begin ! get next transport !
w1:= address((w3).tc_nexttr);
w1:= (w1).tq_next;
if w2:=address((w3).tc_nexttr)=w1 then goto suicide; ! end transp. queue !
w1:= (w3).tc_nexttr;
queueref:= w1;
looktransport(.w3.,w1:=(w1).tq_transno,w2);
transref:= w2;
w1:= queueref;
(w3).tc_transno:= w0:= (w1).tq_transno;
link(.w3.,w1:=queueref,w2:=address(b.tqfreefst));
w2:= transref;
(w3).tc_ointervent:= w0:= 0;
(w3).tc_aintervent:= w0;
(w3).tc_mode:= w0:= (w2).tr_mode;
(w3).tc_bsl:= w0:= (w2).tr_basel;
(w3).tc_bsu:= w0:= (w2).tr_baseu;
(w3).tc_bsptr:= w0:= (w2).tr_bsstartptr;
(w3).tc_state:= w0:= 0;
move(.w3.,w0:=8,w1:=address((w2).tr_bsarea),w2:=address((w3).tc_bsname));
(w3).tw_inpstate:= w0:= 5;
oproutput(.w3.,w0:=1,w1:=5,w2);
if w2<>2 then
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 3; ! operator !
(w3).tc_status:= w2;
goto closeup;
end;
loop:
if w2:=(w3).tc_aintervent<>0 then
begin
(w3).tc_state:= w0:= 8; ! killed by appl !
goto closeup;
end;
! get next input block !
w1:= (w3).tc_buf;
(w1).buf_op:= w2:= 3; (w1).buf_mode:= w2:= (w3).tc_mode;
(w1).buf_first:= w2:= address((w1).buf_data1);
w2+(w3).tc_bufsize-2;
(w1).buf_last:= w2;
sendwait(.w3.,w0,w1,w2:=address((w3).tc_name));
check_devicestatus(.w3.,w0,w1:=address(b.ans_status),w2);
w1:= (w3).tc_buf;
if w0:=b.ans_bytes=0 then
begin
if w2=2 then goto loop;
(w1).buf_data1:= w0:= 4'012101210121; ! "<25><25><25>" !
if w0:= 8'10000002 ! timer , normal ! onemask w2 then
begin
if w0:=(w3).tw_inpstate>0 then
begin
(w3).tw_inpstate:= w0-1;
goto loop;
end
else
begin
(w3).tc_state:= w0:= 5; ! completed !
end;
end
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 1; ! sender !
(w3).tc_status:= w2;
end;
w0:= 2;
end
else
(w3).tw_inpstate:= w2:= 0;
w1:= (w1).buf_first;
if w2:=(w1).word<>4'012101210121 then testout(.w3.,w0,w1,w2:=0);
put_block(.w3.,w0,w1,w2);
if w2=2 then (w3).tc_bsptr:= w0+(w3).tc_bsptr
else
begin
(w3).tc_state:= w0:= 6; ! aborted !
(w3).tc_cause:= w0:= 2; ! receiver !
(w3).tc_status:= w2;
end;
if w0:=(w3).tc_state=0 then goto loop;
closeup:
if w0:=b.oprtdetails<>0 then oproutput(.w3.,w0:=1,w1:=4,w2:=(w3).tc_state);
closebs(.w3.);
updatetransport(.w3.);
end; ! get next transport !
suicide:
remove_tc(.w3.,w1:=b.current);
goto b.activate;
end;
end; ! tw !
end.
▶EOF◀