|
|
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: 75264 (0x12600)
Types: TextFile
Names: »mhost «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »mhost «
\f
m. monhost - host process drivers 17.0 beta
;--------------------------------------------------------------------------
; REVISION HISTORY
;--------------------------------------------------------------------------
; DATE TIME OR DESCRIPTION
; RELEASE
;--------------------------------------------------------------------------
;88.03.24 14.1A HSI start of description
; rc3600 terminal: send att-mess to user of remoter when
; terminal is disconnected
;88.04.19 08.32 HSI Error in procedure n24; if more than one mess in remoter
; queue the monitor will break.
;
b.i30 w.
i0=88 03 02, i1=12 00 00
; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
c.i0-a133
c.i0-a133-1, a133=i0, a134=i1, z.
c.i1-a134-1, a134=i1, z.
z.
i10=i0, i20=i1
i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
i2: <: date :>
(:i15+48:)<16+(:i14+48:)<8+46
(:i13+48:)<16+(:i12+48:)<8+46
(:i11+48:)<16+(:i10+48:)<8+32
(:i25+48:)<16+(:i24+48:)<8+46
(:i23+48:)<16+(:i22+48:)<8+46
(:i21+48:)<16+(:i20+48:)<8+ 0
i3: al. w0 i2. ; write date:
rs w0 x2+0 ; first free:=start(text);
al w2 0 ;
jl x3 ; return to slang(status ok);
jl. i3. ;
e.
j.
; block containing host - and subprocess drivers.
b.u100 w.
c.-p103
p301=p71
p302=p72
p303=p73
p321=p91
p322=p92
p323=p93
z.
; block containing host and subhost drivers.
b.s120 w.
; host process.
b.i10,j10 w.
; format of the process description:
m. host
; a250: ; <driver process description address>
; a402: ; <user bit table - dummy>
; a48: ; <interval>
; a49: ; <interval>
; a10: ; <kind>=90
; a11: ; <name>=<:host:>
; a50: ; <dummy>
; a52: ; <dummy>
; a57, a58: ; <dummy>
; a54: ; <next message>
; a55: ; <last message>
; a56: ; <dummy>
\f
; format of message and answer:
s0=8 , s1=s0+1 ; operation , mode
s2=s0+2 ; first addr(buffer)
s3=s2+2 ; last addr(buffer)
s4=s3+2 , s5=s4+1 ; dh.linkno , hostno
s6=s4+2 ; dh.host-id
s7=s6+2 , s8=s7+1 ; dh.home-reg, dh.net-id
s9=s7+2 ; jh.host-id
s10=s9+2 , s11=s10+1 ; jh.linkno , jh.net-id
s31=22 ; size of datas used in connection with operation=1
; the host-driver accepts the following operations and modes:
; operation mode header-func name
; 1 5 9 lookup process
; 1 6,7 13 lookup
; 1 8,9 17 lookup reserve
; 1 10,21 11 cancel reservation
; 1 12,13 25 linkup remote
; 1 14,15 29 linkup local
; 1 16,17 32 lookup link
; 2 0,1 8 release link
; 9 0,1,2,3 45 operator output
; 11 0,1,2,3 41 operator output-input
; 2 create
; 6 remove
\f
a0=1<23
i0: a0>0+a0>1+a0>2+a0>9+a0>11
i1: a0>5+a0>6+a0>7+a0>8+a0>9+a0>10+a0>11+a0>12+a0>13+a0>14+a0>15+a0>16+a0>17
i2: a0>0+a0>1
i3: a0>0+a0>1+a0>2+a0>3
h90: bz w0 x2+s0 ; host process:
rl. w1 i1. ;
sn w0 2 ; mode mask:=mode mask(operation);
rl. w1 i2. ;
se w0 16 ;
sl w0 3 ;
rl. w1 i3. ;
rl. w0 i0. ;
jl w3 g16 ; check operation(operation mask, mode mask);
; check host-addr.
rl w0 x2+s1 ;
so w0 2.1 ; if address mode=1 then
jl. j1. ; begin
la w0 g50 ; address mode:=0;
rs w0 x2+s1 ;
rl w3 x2+s4 ; sub:=proc desc addr(mess);
rl w1 b4 ;
al w1 x1-2 ;
j0: al w1 x1+2 ; if sub is not included in device part of nametable then
sl w1 (b5) ; goto result 3;
jl g5 ;
se w3 (x1) ;
jl. j0. ;
rl w0 x3+a10 ;
la w0 g50 ;
se w0 p112 ; if kind(sub)<>local or remote process then
jl g5 ; goto result3;
rl w0 x3+a50 ; if main(sub)=0 then
sn w0 0 ; goto free sub;
jl. j4. ;
bz w0 x3+p11 ;
hs w0 x2+s4 ; dh.linkno:=dh.linkno(sub);
rl w0 x3+p5 ;
rs w0 x2+s6 ; dh.host-id:=dh.host-id(sub);
bz w0 x3+p6 ;
hs w0 x2+s7 ; dh.home-reg:=dh.home-reg(sub);
bz w0 x3+p7 ;
hs w0 x2+s8 ; dh.net-id:=dh.net-id(sub);
bz w0 x3+p9 ;
hs w0 x2+s10 ; jh.linkno:=jh.linkno(sub);
rl w1 x3+a50 ;
rl w0 x1+p202+p5;
rs w0 x2+s9 ; jh.host-id:=jh.host-id(subhost);
bz w0 x1+p202+p7;
hs w0 x2+s11 ; jh.net-id:=jh.net-id(sender host);
bz w0 x1+p202+p9;
hs w0 x2+s5 ; hostno:=rcno(subhost(main(sub)));
; end;
; this block transfers the operation and mode of the message
; into a function mode of the format:
; fmode:=header function<2+header mode.
j1: bz w0 x2+s0 ;
se w0 1 ; if operation=1 then
jl. j2. ; begin
bz w3 x2+s1 ; if mode(mess)<>32 then
ls w3 1 ;
se w3 32 ; header function:=(mode(mess)+1)<1;
al w3 x3+1 ; else
ls w3 2 ; header function:=mode(mess)<1;
rl w0 x2+s3 ;
ws w0 x2+s2 ; if size(data)<std data buffer size then
sh w0 s31-2-1 ; goto result 3;
jl g5 ; end;
jl. j3. ;
j2: al w3 8<2 ; if operation=2 then
se w0 2 ; begin
jl. j5. ; header function := 8;
zl w0 x2+s10 ; if message.jh-linkno outside
ls w0 1 ; device part of nametable then
wa w0 b4 ;
sl w0 (b4) ;
sl w0 (b5) ; goto result 3;
jl g5 ;
jl. j3. ; end;
j5: ;
sn w0 9 ; if operation=9 then
al w3 45<2 ; header function:=45;
sn w0 11 ; if operation=11 then
al w3 41<2 ; header function:=41;
bz w0 x2+s1 ;
se w0 0 ; if mode<>0 then
al w3 x3+1 ; header mode:=1;
j3: hs w3 x2+s1 ;
; call subhost.
bz w3 x2+s5 ; subhost:=
ls w3 1 ; word(hostno<1+start(name table));
wa w3 b4 ;
sl w3 (b5) ; if host process outside name table then
jl g5 ; goto result3;
rl w3 x3 ;
rl w0 x3+a10 ;
se w0 p111 ; if kind(subhost)<>subhost kind then
jl g5 ; goto result 3;
rs w3 b19 ; current process:=subhost;
c.-p103
jl. h34. ; goto subhost-driver;
z.
c.p103-1
jl. h82. ; goto subhost-driver;
z.
j4: rl w0 x2+s0 ; free sub:
se. w0 (i10.) ; if operation<>lookup process then
jl g5 ; goto result3;
ld w0 -100 ;
rs w0 g20 ;
ds w0 g22 ; status, bytes trf:=0,0;
jl g7 ; goto result1;
i10: 1<12+2<1 ;
e. ; end host process.
\f
; subhost process.
; block including the host-process driver.
b.n130,q10,r40,t10 w.
m. subhost
; a250: ; <driver process description address>
; a402: ; <user bit tabel>
; a48: ; <interval>
; a49: ; <interval>
; a10: ; <kind>
; a11: ; <name>
; a50: ; <mainproc>
; a52: ; <reserver>
; a57, a58: ; <work0>,<work1>
; a54: ; <next message>
; a55: ; <last message>
; a56: ; <external state>
; p0: start of specific part:
; p1: top of specific part;
; p11: , p9 : ; <devno> , <rcno>
; p10: , p8 : ; <subkind=-2> , <various>
; p12: ; <state>
; p14: ; <next subproc>
; p15: ; <last subproc>
; p16: , p17: ; <buffers free> , <current bufno>
; p18: ; <max bufsize=24>
; p7 : , p6 : ; <net-id(subhost)> , <home reg(subhost)>
; p5 : ; <host-id(subhost)>
; p13: ; <current message>
; p19: ; start(mess buf table):
; p19+v3<1 ; top(mess buf table).
s100=p19+v3<1 ; start of output buffer:
s101=20 ; size of output buffer
s102=s100+s101 ; start of input buffer:
s103=s101 ; size of input buffer
\f
h99: q0 ; deliver message
q1 ; transfer operation
q2 ; end transfer
q3 ; receive operation
q4 ; end receive
; q5 ; initiate process
; answers to create and remove operations are stored in a message buffer
; (claims are borrowed from the subprocess). the message buffers are queued
; up in the event queue until the answer can be transmitted.
; format of the save-buffer:
s16=8 , s17=s16+1 ; -1 , header function<2
s18=s16+2 , s19=s18+1 ; dh.linkno , jh.linkno
s20=s18+2 , s21=s20+1 ; bufno , result
s22=s20+2 , s23=s22+1 ; unused , quality mask
s24=s22+2 , s25=s24+1 ; jh.net-id , jh.home-reg
s26=s24+2 ; jh.host-id
s28=s26+2 , s29=s28+1 ; state , unused
s30=s28+2 ; mode
r0: ; internal output buffer.
h. r1: 0 , r2: 0 ; mode , kind
r3: 0 , r4: 0 ; timeout , buffers
w. r5: 0 ; buffersize
r6: 0 , r.4 ; devicename
r7: 0 ; jh. linkno
r8: 0 ; jh. host-id
h. r9: 0 , r10: 0 ; jh. home-reg, jh. net-id
w. r11: 0 ; proc desc
r20: ; internal input buffer.
r22: 0 ; kind
r24: 0 ; max. buffers
r25: 0 ; max. buffersize
r26: 0 , r.4 ; devicename
r27: 0 ; jh. linkno
r28: 0 ; jh. host-id
h. r29: 0 , r30: 0 ; jh. home-reg, jh. net-id
w. r31: 0 ; process description
r32: 0 ; dh. linkno
\f
; entry0.
b.i10,j10 w.
q0: ; entry0:
rl w2 b18 ;
rl w1 x2+6 ; proc:=sender(mess);
jl w3 g14 ; check user;
rl w1 b19 ;
c.p101 b.f1 w. ;*****test72*****
rs. w3 f0. ;
jl. w3 f4. ;
72 ;
f0: 0 ;
jl. f1. ;
al w0 x2+8 ; dump contents of mess buffer
al w1 x2+22 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test72*****
bz w0 x2+s1 ;
sn w0 9<2 ; if fmode=9<2 then
jl. j0. ; goto lookup-process;
jl. w3 n20. ; link operation;
jl. w3 n21. ; testready and link;
jl (b101) ; exit0: return to main;
; lookup process.
; lookup process delivers an answer equal to the one described in xxx and
; an input data buffer of the format-
;
; +0 kind
; +2 buffers
; +4 max. buffersize
; +6 name of the external process
; +14 jh. linkno(=logical devicenumber)
; +16 jh. host-id (=sender host)
; +18 jh. home-reg, jh. net-id
; +20 process description(external process)
j0: bz w3 x2+s10 ; lookup process:
rs. w3 r27. ; jh.linkno:=jh.linkno(mess);
ls w3 1 ;
wa w3 b4 ;
rl w3 x3 ; sub:=sub(rcno);
bl w0 x3+p10 ;
rs. w0 r22. ; kind:=subkind(sub);
sn w0 -2 ;
am v3<1-v0<1 ; if sub=subhost then
am v0<1 ; number of message entries:=v3
al w0 x3+p19 ; else
rs. w0 i0. ; number of message entries:=v1;
al w1 x3+p19 ; max. buffers:=buffers free(sub);
al w0 0 ; for entry=first message entry step 1 until last entry do
bl w2 x3+p16 ; if entry used(<>0) then
j1: se w0 (x1) ; number of buffers:=number of buffers+1;
al w2 x2+1 ;
al w1 x1+2 ;
se. w1 (i0.) ;
jl. j1. ;
rs. w2 r24. ; max. buffers:=number of buffers;
rl w0 x3+p18 ;
ls w0 -1 ;
wa w0 x3+p18 ;
rs. w0 r25. ; max. buffersize:=max. buffersize(sub)//2*3;
dl w1 x3+a11+2 ;
ds. w1 r26.+2 ; name of external process:=process name(sub);
dl w1 x3+a11+6 ;
ds. w1 r26.+6 ;
rl w1 b19 ;
rl w0 x1+p5 ;
rs. w0 r28. ; jh. host-id:=host-id(subhost);
rl w0 x1+p6 ;
hs. w0 r29. ; jh. home-reg:=home-reg(subhost);
rl w0 x1+p7 ;
hs. w0 r30. ; jh. net-id:=net-id(subhost);
rs. w3 r31. ; process description:=sub;
c.p101 b.f1 w. ;*****test73*****
rs. w3 f0. ;
jl. w3 f4. ;
73 ;
f0: 0 ;
jl. f1. ;
al. w0 r20. ;
al. w1 r32. ; dump contents of input area
jl. w3 f5. ;
f1: ;
e.z. ;*****test73*****
rl w2 b18 ;
jl. w3 n1. ; deliver data(mess);
am 0 ; sender stopped: impossible;
rl. w0 (r31.) ; if kind(sub)=remote subkind then
sn w0 p112 ; link desc:=1
am 2-1 ; else
al w0 1 ; link desc:=2;
ls w0 12 ;
rs w0 x2+s1 ; return value:=ok;
al w3 s31 ;
al w0 s31>1*3 ; bytes trf(mess), chars trf(mess):=std buffer size;
j4: ds w0 x2+s3 ;
jl. w3 n19. ; deliver: deliver answer(ok,mess);
jl (b101) ; exit: return to main;
i0: 0 ;
e. ; end of entry0;
\f
; entry1.
b.i10,j10,m20 w.
q1: jl. w3 (i2.) ; entry1: find first unprocessed message;
c.p101 b.f1 w. ;****test74*****
rs. w3 f0. ;
jl. w3 f4. ;
74 ;
f0: 0 ;
jl. f1. ;
al w0 x2 ; dump contents of mess
sn w2 0 ; if no mess then
al w0 x2+24 ; no record
al w1 x2+22 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test74*****
sn w2 0 ; if message queue empty then
jl. (i1.) ; goto no block;
bz w3 x2+s1 ;
ls w3 -2-1 ; function:=fmode>2;
jl. (x3+i0.) ; goto case function of
i0: m0 ; ( 0-3 : create,
m0 ; 4-7 : remove,
m2 ; 8-11 : release link,
m3 ; 12-15 : lookup,
m3 ; 16-19 : lookup reserve,
m3 ; 20-23 : cancel reservation,
m6 ; 24-27 : linkup remote,
m7 ; 28-31 : linkup local,
m2 ; 32-35 : lookup link,
-1 ; 36-39 : unused,
m10 ; 40-43 : operator output/input,
m10 ; 44-47 : operator output);
i1: u3 ;
i2: u12 ;
; create.
; remove.
;
m0: rl w3 x1+a50 ; create:
bz w0 x2+s1 ;
ls w0 -2 ;
hs w0 x3+p61 ; function(trm):=function( m buff)
bz w0 x2+10 ;
hs w0 x3+p69 ; receiver linkno(trm):=devno( m buff)
bz w0 x2+11 ;
hs w0 x3+p78 ; sender linkno(trm):=rcno( m buff)
bz w0 x2+13 ;
rs w0 x3+p64 ; size(trm):= result( m buff)
bz w0 x2+20 ;
c.p103-1
hs w0 x3+p62 ; state(rec):=state(mess);
rl w0 x2+22 ; status(rec):=mode(mess);
rs w0 x3+p63 ;
z.
c.-p103
hs w0 x3+p74 ; various(trm):= quality mask( m buff )
z.
rl w0 x2+16 ; receiver net-id, home reg(trm):=
rs w0 x3+p301 ; answer add1( m buff)
rl w0 x2+18 ; receiver host-id(trm):=
rs w0 x3+p303 ; answer add2( m buff)
jl. w3 n10. ; get next free message entry;
la w2 g50 ;
am (x1+a50) ;
hs w3 +p68 ; bufno(rec) := cur buf;
jl (b101) ; return to main
; release.
; lookup link.
;
m2: jl. w3 n4. ; release: setup header1;
jl (b101) ; exit: return;
; lookup.
; lookup reserve.
; cancel reservation.
;
m3: jl. w3 n0. ; lookup: get data buffer(mess);
jl. m16. ; sender stopped: goto stopped sender;
ld w0 -100 ; ok:
ds. w0 r8. ; value(unused fields):=0;
rs. w0 r10. ;
jl. j0. ; goto deliver;
; linkup remote.
;
m6: jl. w3 n0. ; linkup remote: get data buffer(mess);
jl. m16. ; sender stopped: goto stopped sender;
al w0 0 ; ok:
rs. w0 r7. ; jh.linkno:=0;
se. w0 (r8.) ; if host-id=0 then
jl. j0. ; host-addr:=host-addr(subhost);
rl w0 x1+p5 ;
rs. w0 r8. ;
bz w0 x1+p6 ;
hs. w0 r9. ;
bz w0 x1+p7 ;
hs. w0 r10. ;
j0: jl. w3 n2. ; deliver: check and packin(data);
jl. m17. ; error: goto parameter error;
j1: jl. w3 n5. ; setup: setup header2;
c.p101 b.f1 w. ;*****test75*****
rs. w3 f0. ;
jl. w3 f4. ;
75 ;
f0: 0 ;
jl. f1. ;
al w0 x1+s100 ; dump output buffer
al w1 x1+s100+s101-2
jl. w3 f5. ;
f1: ;
e.z. ;*****test75*****
jl (b101) ; exit: return;
; linkup local.
;
m7: jl. w3 n0. ; linkup local: get data buffer(mess);
jl. m16. ; sender stopped: goto stopped sender;
rl w0 x1+p5 ; ok:
rs. w0 r8. ; host-addr:=host-addr(subhost);
bz w0 x1+p6 ;
hs. w0 r9. ;
bz w0 x1+p7 ;
hs. w0 r10. ;
jl. w3 n2. ; check and packin(data);
jl. m17. ; error: goto parameter error;
rl. w2 r7. ; ok:
am (b18) ;
hs w2 +s10 ; jh.linkno(mess):=jh.linkno(data);
ls w2 1 ;
wa w2 b4 ;
sl w2 (b5) ; if jh.linkno > max linkno then
jl. m17. ; goto parameter error;
rl w2 x2 ; sub:=proc(jh. linkno);
rs. w2 r11. ; process desc:=proc desc(sub);
rl w0 x2+a10 ;
rl w3 x2+a50 ; if kind(sub)<>free subprocess
sn w0 p113 ; or main(sub)<>0 then
se w3 0 ; goto no resources;
jl. m15. ;
jl. w3 n25. ; create subprocess(sub,host);
rl w2 b18 ;
rl. w3 r11. ;
rl w0 x2+s6 ;
rs w0 x3+p5 ; host-id(sub):=dh.host-id(mess);
bz w0 x2+s7 ;
hs w0 x3+p6 ; home-reg(sub):=dh.home-reg(mess);
bz w0 x2+s8 ;
hs w0 x3+p7 ; net-id(sub):=dh.net-id(mess);
al w0 -1 ; dh-linkno(sub) := jh-linkno(sub) := -1;
rs w0 x3+p11 ;
jl. j1. ; goto setup;
; operator output.
; operator output-input.
;
m10: ; operator output:
bz w0 x2+s1 ;
so w0 2.1 ; if function mode(mess)=1 then
jl. j2. ;
al w0 0 ;
hs w0 x2+s4 ; dh.linkno:=0;
hs w0 x2+s10 ; jh.linkno:=0;
j2: jl w3 g34 ; examine sender(mess);
jl. m16. ; sender stopped: goto stopped sender;
jl w3 g31 ; increase stopcount(sender);
jl. w3 n6. ; setup header3;
jl (b101) ; exit: return to main;
; no resources in job host.
m15: ; no resources:
rl w2 b18 ;
jl. w3 n14. ; return noresources answer;
jl. q1. ; goto entry1;
; stopped sender.
m16: rl w2 b18 ; stopped sender:
jl. w3 n12. ; return stopped answer;
jl. q1. ; goto entry1;
; parameter error in data.
m17: al w0 3 ; parameter error: result:=3;
jl w3 g19 ; deliver result;
jl. q1. ; goto entry1;
e. ; end of entry1;
\f
; entry2.
b.i5,j5 w.
q2: ; entry2:
al w0 0 ;
rs w0 x1+p13 ; current message:=0;
jl. w3 (i0.) ; test after header and data transmitted;
jl. j1. ; goto error;
; ok:
jl. w3 n8. ; get mess buf(trm);
sn w2 0 ; if mess = 0 then
jl. j0. ; goto testnext;
bz w0 x2+s1 ;
so w0 2.10<2 ; if type(header)<>answer then
jl. j0. ; goto test next;
rs w2 b18 ; answer type:
am (x1+a50) ;
bz w0 +p60 ;
sn w0 p161 ; if int status=wait then
rs w2 x1+p13 ; current mess:=mess;
se w0 p161 ; else
jl. w3 n27. ; release buffer;
jl. w3 (i1.) ; clear message entry(trm);
jl. j0. ; goto test next;
j1: ;error:
; <* partly created subprocesses must be removed *>
am (x1+a50) ; function := transmitter.function;
zl w0 +p61 ;
se w0 29 ; if function = linkup local or
sn w0 v32 ; function = answer create
sz ;
jl. j0. ; then begin
am (x1+a50) ; jh.linkno := transmitte.jhlinkno;
bz w2 +p78 ;
ls w2 1 ;
wa w2 b4 ;
rl w2 x2 ; proc := name table(jh.linkno);
jl. w3 n24. ; remove subprocess(proc);
; end;
; end;
j0: ; test next:
c.p101 b.f1 w. ;*****test76*****
rs. w3 f0. ;
jl. w3 f4. ;
76 ;
f0: 0 ;
jl. f1. ;
al w0 x1+p19 ;
al w1 x1+p19+16 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test76*****
jl. w3 (i2.) ; find first unprocessed message;
se w2 0 ; if mess<>0 then
jl. w3 n21. ; testready and link;
jl (b101) ; exit2: return;
i0: u40 ;
i1: u41
i2: u12
e.
\f
; entry3.
b.j10,i10 w.
q3: jl. w3 n9. ; entry3: get mess(bufno);
c.p101 b.f1 w. ;*****test80*****
rs. w3 f0. ;
jl. w3 f4. ;
80 ;
f0: 0 ;
jl. f1. ;
al w0 x2+0 ; dump contents of mess
al w1 x2+22 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test80*****
rl w3 x1+a50 ;
bz w0 x3+p99 ;
sn w0 3 ; if local function=reject then
jl. j3. ; goto rejected;
bz w0 x3+p81 ;
se w0 v23+1 ; if function<>operator output-input then
jl. j1. ; goto lookup;
jl. w3 (i0.) ; operator output-input: test and increase stopcount;
jl. j0. ; error: goto setskip;
rl w3 x1+a50 ; ok:
rl w0 x2+s2 ; first:=first(mess);
rs w0 x3+p85 ;
c.-p103
rl w0 x2+s3 ; last:=last(mess);
rs w0 x3+p86 ; count:=0;
z.
c.p103-1
al w0 0 ;
hs w0 x3+p92 ; address code:=sender area;
c. p103-1
rs w2 x3+p91 ; message buffer(main):= message
z.
z.
jl. j2. ; goto setok;
j3: ; rejected:
bz w0 x3+p81 ;
se w0 8 ; if operation(rec)=release link
sn w0 29 ; or operation(rec)=linkup local then
jl. w3 n22. ; check and remove;
jl. w3 n9. ; get mess buffer;
al w0 0 ; bytes tranferred:=0;
jl. w3 n11. ; return answer(bytes trf);
j0: al w0 p162 ; setskip:
am (x1+a50) ; internal status:=skip;
hs w0 +p80 ;
jl. w3 (i1.) ; find first message;
se w2 0 ; if mess<>0 then
jl. w3 n21. ; testready and link;
jl (b101) ; exit: return to main;
j1: ; lookup:
al w0 x1+s102 ;
rs w0 x3+p85 ; first:=first(std input buffer);
c.-p103
al w0 x1+s102+s101-2
rs w0 x3+p86 ; last:=first+size;
al w0 0 ;
hs w0 x3+p87 ; charcount:=0;
z.
c.p103-1
al w0 s101>1*3 ;
rs w0 x3+p86 ; size(rec):=std data size;
c. p103-1
al w0 0 ; messagebuf(main):= 0 (no buf.)
rs w0 x3+p91 ;
z.
al w0 8 ;
hs w0 x3+p92 ; address code:=dirty;
z.
j2: al w0 p160 ; setok:
am (x1+a50) ;
hs w0 +p80 ; internal status:=ok;
jl (b101) ; exit: return;
i0: u21 ;
i1: u12
e. ; end of entry3;
\f
; entry 4.
b.i10,j20,m20 w.
q4: ; entry4:
am (x1+a50) ;
bz w3 +p81 ;
c.p101 b.f1 w. ;*****test84*****
rs. w3 f0. ;
jl. w3 f4. ;
84 ;
f0: 0 ;
jl. f1. ;
rl w3 x1+a50 ;
al w0 x3+p80 ; dump param area(rec)
al w1 x3+p90 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test84*****
ls w3 -1 ;
jl. (x3+i0.) ; goto case function of
i0: m0 ; ( 0-3 : create,
m1 ; 4-7 : remove,
m2 ; 8-11 : release,
m3 ; 12-15 : lookup,
m3 ; 16-19 : lookup reserve,
m3 ; 20-23 : cancel reservation,
m6 ; 24-27 : linkup remote,
m7 ; 28-31 : linkup local,
m3 ; 32-35 : lookup link,
-1 ; 36-39 : unused,
m10 ; 40-43 : operator output-input,
m11 ; 44-47 : operator output);
; create.
;
b.i10,j20 w.
m0: jl. w3 n26. ; create: get free buffer;
; initialize selected message buffer
al w0 -1 ;
hs w0 x2+8 ;
al w0 v32<2 ;
hs w0 x2+9 ; mess(0):=-1,function;
c.-p103
bz w0 x3+p94 ;
hs w0 x2+15 ; quality mask:=various
z.
c.p103-1
bz w0 x3+p82 ;
hs w0 x2+20 ; state(mess):=state(rec);
rl w0 x3+p83 ;
rs w0 x2+22 ; mode(mess):=mode(rec);
z.
bz w0 x3+p98 ;
hs w0 x2+10 ; devno(m buf):=sender lnkno(rec)
rs. w0 i3. ; save dh.linkno
rl w0 x3+p321 ; answer add1(m buf):=
rs w0 x2+16 ; sender net-id, sender home reg
rl w0 x3+p323 ; answer add2(m buf):=
rs w0 x2+18 ; sender host-id
rs. w0 i4. ; save dh.id
; find free subprocess description. start searching from high device numbers.
; 1. search for a subprocess used in an earlier communication with this
; device.
; 2. if not found then select a free one (free: name=0, users=0)
rl w1 x1+a50 ; w1=main;
rl w3 b5 ; sub := last sub;
j6: al w3 x3-2 ; while sub >= first sub do
sl w3 (b4) ; begin
jl. +4 ;
jl. j4. ;
;
rl w2 x3 ; if sub.kind = free, remote or local then
rl w0 x2+a10 ; begin
se w0 p112 ;
sn w0 p113 ;
sz ;
jl. j6. ;
rl w0 x1+p323 ; if sub.hostid = main.receiver.hostid and
se w0 (x2+p5) ;
jl. j6. ;
; rl w0 x1+p321 ; sub.netid,sub.homereg = main.receiver.
; se w0 (x2+p7) ; netid,main.receiver.homereg and
; jl. j6. ; <* excluded until defined in net *>
el w0 x1+p98 ; sub.linkno = main.receiver.dh-linkno then
bs w0 x2+p11 ;
se w0 0 ; begin
jl. j6. ;
rl w0 x2+a50 ; <* device has used this subproc before -
sn w0 0 ; test if it is already connected *>
jl. j5. ; if subproc.main = 0 then goto found;
; <* device already connected - subproc will not
; be reinitialized - return ok-answer *>;
ws w3 b4 ;
as w3 -1 ;
ds. w3 i1. ; save subproc, rc devno;
al w0 p113 ; sub.kind := temp;
rs w0 x2+a10 ;
jl. j8. ; goto return ok answer;
; end;
; end;
; end;
; <* sub not found - select a free subprocess *>
j4: rl w3 b5 ; sub := last subprocess;
j3: al w3 x3-2 ; next:
sl w3 (b4) ; if sub < first external then
jl. +4 ; goto return result (no resources);
jl. j13. ;
;
rl w2 x3 ;
al w0 p113 ; if sub.kind <> free or remote then goto next;
se w0 (x2+a10) ;
jl. j3. ;
rl w1 x2+a11 ;
se w1 0 ;
jl. j3. ; if sub.name(0) <> 0 then goto next;
; test users:
j2: am x1 ; users := sub.user(w1);
rl w0 x2+a402 ; if users <> 0 then goto next;
se w0 0 ;
jl. j3. ;
al w1 x1+2 ; w1 := w1 + 2;
sh w1 a403-2 ;
jl. j2. ; goto test users;
;
j5: ; found:
; free process description found: w2=free sub found, w3=add of subproc nametable entry
ws w3 b4 ; rcno:=(entry(sub) - entry(first dev))/2
as w3 -1 ;
ds. w3 i1. ; save sub, rcno - jobhost linkno -
rl w1 b19 ; w1:= host proc
jl. w3 n25. ; create subprocess
; transfer receive parameters to subprocess
rl w1 x1+a50 ; w1:=main
rl w0 x1+p84 ;
al w3 0 ;
wd w0 g48 ;
ls w0 1 ; max buffersize(sub):=size(rec)/3*2;
rs w0 x2+p18 ;
bz w0 x1+p88 ;
hs w0 x2+p16 ; buffers free(sub):=bufno(rec)
al w0 8.377 ;
la w0 x1+p83 ;
hs w0 x2+p10 ; subkind(sub):=status(rec)(16:23);
bz w0 x1+p98 ;
hs w0 x2+p11 ; devno(sub):= sender linkno(rec)
rl. w0 i1. ;
hs w0 x2+p9 ; rcno(sub):= saved rcno
c.-p103
bz w0 x1+p94 ;
ls w0 -2 ;
z.
c.p103-1
bz w0 x1+p82 ;
ls w0 5 ;
rl w3 x1+p83 ;
ls w3 -8 ;
lo w0 6 ; data quality(sub):=state(mess)<5+mode(mess)(0:4);
z.
hs w0 x2+p8 ; *data quality(sub):=quality mask(rec)
bz w0 x1+p321 ;
hs w0 x2+p7 ; receiver net-id(sub):=sender net-id(rec)
bz w0 x1+p322 ;
hs w0 x2+p6 ; receiver home reg(sub):=sender home reg(rec)
al w0 0 ;***until net-id and home-reg are defined in the net:
rs w0 x2+p6 ; net-id, home-reg:=0,0;
rl w0 x1+p323 ; receiver host-id(sub):=sender host-id(rec)
rs w0 x2+p5 ;
zl w1 x2+p11 ;
jl. w3 n30. ; name subproc(dh-hostid, dh-linkno, subproc);
c.p101 b.f1 w. ;*****test85*****
rs. w3 f0. ;
jl. w3 f4. ;
85 ;
f0: 0 ;
jl. f1. ;
al w0 x2-4 ;
al w1 x2+p19+14 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test85*****
j8: rl w1 b19 ; w1:=host proc
rl w2 b18 ; w2:=mess buff
; set rcno in message buffer; receive param internal status:= ok;
; link message to event queue of host and if host not already in
; main queue then link it first in main queue. finnally return
; to main initialize return point.
rl w3 x1+a50 ; w3:=main
rl. w0 i1. ;
hs w0 x2+11 ; rcno(m buf):=saved rcno
al w0 p160 ;
hs w0 x3+p80 ; internal status(rec):=ok
c.p101 b.f1 w. ;*****test86*****
rs. w3 f0. ;
jl. w3 f4. ;
86 ;
f0: 0 ;
jl. f1. ;
rl. w3 f0. ;
al w0 x3+p80 ;
al w1 x3+p90 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test86*****
jl. w3 n23. ; testready and link answer;
rl. w2 i0. ; return: w2:=sub created
am (b101) ;
jl -2 ; return to main init
; error.
j10: am 0-1 ;
j12: am 1-3 ; error1:
j13: am 3-5 ; error3:
j9 : al w0 5 ; error5:
c.p101 b.f1 w. ;*****test87*****
rs. w3 f0. ;
jl. w3 f4. ;
87 ;
f0: 0 ;
jl. f1. ;
rs w0 x3 ;
al w0 x3 ;
al w1 x3 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test87*****
rl w2 b18 ;
hs w0 x2+13 ; result(m buf):=case error _entry of ((0),1,3,5)
j14: rl w1 b19 ; out:
rl w3 x1+a50 ;
al w0 p160 ;
hs w0 x3+p80 ; internal state(main):=ok
jl. w3 n23. ; testready and link answer;
jl (b101) ;
; remove.
;
m1: jl. w3 n26. ; remove: get free mess buffer;
al w0 -1 ;
hs w0 x2+8 ;
al w0 v38<2 ;
hs w0 x2+9 ; mess(0):=-1,function;
bz w0 x3+p88 ;
hs w0 x2+12 ; bufno(m buf):= bufno(rec)
bz w0 x3+p98 ;
hs w0 x2+10 ; dh.linkno(mess):=dh.linkno(rec);
bz w0 x3+p89 ;
hs w0 x2+11 ; jh.linkno(mess):=jh.linkno(rec);
rl w0 x3+p321 ; answer add1(m buf):=
rs w0 x2+16 ; sender net-id,home reg(rec)
rl w0 x3+p323 ; answer add2(m buf):=
rs w0 x2+18 ; sender host-id
bz w2 x3+p89 ;
ls w2 1 ;
wa w2 b4 ;
rl w2 x2 ; sub:=proc(rcno)
rl w0 x2+a10 ;
la w0 g50 ; if kind(subproc kind)<>sub or
sn w0 p112 ; main(sub)<>main(host)
se w3 (x2+a50) ;
jl. j12. ; then goto error1
bz w0 x3+p98 ;
bs w0 x2+p11 ;
bz w3 x3+p89 ;
bs w3 x2+p9 ;
sn w0 0 ; if dh.linkno(sub)<>dh.linkno(mess)
se w3 0 ; or jh.linkno(sub)<>jh.linkno(mess) then
jl. j12. ; goto error1;
jl. w3 n24. ; remove subprocess(sub);
c.p101 b.f1 w. ;*****test88*****
rs. w3 f0. ;
jl. w3 f4. ;
88 ;
f0: 0 ;
jl. f1. ;
al w0 x2-4 ;
al w1 x2+p19+14 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test88*****
rl w2 b18 ;
jl. j14. ; goto out;
j20: al w0 p163 ; error4:
hs w0 x3+p80 ; internal status:=reject;
jl (b101) ; return(std);
; parameters.
i0: 0 ; subproc
i1: 0 ; rcno
i2: 0 ; devno
i3: 0 ; save dev.host linkno
i4: 0 ; save dev.host id
e.
; release.
;
m2: jl. w3 n9. ; release:
am (x1+a50) ;
rl w0 +p84 ;
sn w0 0 ; if result=ok then
jl. j0. ; goto deliver;
rl w3 x2+s9 ; notok:
bz w0 x2+s11 ; if jh.host-id(mess)<>jh.host-id(subhost)
bs w0 x1+p7 ; or jh.net-id(mess)<>jh.net-id(subhost) then
sn w3 (x1+p5) ; goto deliver;
se w0 0 ;
jl. j0. ;
bz w3 x2+s10 ;
ls w3 1 ;
wa w3 b4 ;
rl w3 x3 ;
rl w0 x2+s6 ; sub:=proc(jh.linkno);
bz w1 x2+s8 ; if dh.host-id(mess)=dh.host-id(sub)
bs w1 x3+p7 ; and dh.net-id(mess)=dh.net-id(sub)
sn w0 (x3+p5) ; and dh.linkno(mess)=dh.linkno(sub)
se w1 0 ; and jh.linkno(mess)=jh.linkno(sub) then
jl. j10. ; remove subprocess(sub);
bz w0 x2+s4 ;
bs w0 x3+p11 ;
bz w1 x2+s10 ;
bs w1 x3+p9 ;
sn w0 0 ;
se w1 0 ;
jl. j10. ;
al w2 x3 ;
jl. w3 n24. ;
al w0 0 ;
rl w1 b19 ;
am (x1+a50) ; simulate ok-result;
rs w0 +p84 ;
j10: rl w1 b19 ;
rl w2 b18 ;
j0: al w0 0 ; deliver:
j1: ; return answer;
c.p101 b.f1 w. ;*****test89*****
rs. w3 f0. ;
jl. w3 f4. ;
89 ;
f0: 0 ;
jl. f1. ;
rl w2 b18 ;
al w0 x2+0 ;
al w1 x2+22 ; dump contents of mess
jl. w3 f5. ;
f1: ;
e.z. ;*****test89*****
jl. w3 n11. ; return answer;
jl. w3 u12. ; find first message;
se w2 0 ; if mess<>0 then
jl. w3 n21. ; testready and link;
jl (b101) ; exit: return to main;
; lookup.
; lookup reserve.
; cancel reservation.
; lookup link.
;
m3: jl. w3 n9. ; lookup:
jl. w3 n18. ; return operation;
jl. j1. ; goto release;
; linkup remote.
;
m6: ;linkup remote:
jl. w3 n9. ; get message buffer;
jl. w3 n18. ; return operation;
rs. w0 i1. ; save result (size);
al w3 8.77 ;
am (x1+a50) ;
la w3 +p84 ; result := rec.size;
sn w0 0 ; if data.size = 0 or
jl. j6. ;
se w3 0 ; result<> 0,7 then
sn w3 7 ;
jl. j3. ;
; begin
j6: rl w0 x2+s9 ; <* remove the partly created subprocess
se w0 (x1+p5) ; if the job host is this job host *>
jl. j4. ; if message.jh-id = subhost.jh-id and
; zl w0 x2+s11 ; message.jh-netid = subhost.jh-netid
; bs w0 x1+p7 ;
; se w0 0 ; <* netid test excluded until netid defined *>
; jl. j4. ;
zl w2 x2+s10 ; then begin
ls w2 1 ; subproc := message.jh-linkno * 2 +
wa w2 b4 ; <first dev in nametable>;
rl w2 x2 ;
jl. w3 n24. ; remove subprocess(subproc);
jl. j4. ; end;
; end else
j3: ; begin
rl w1 x2+6 ; sender :=
sh w1 0 ; if message.sender < 0 then
ac w1 x1 ; -message.sender else
rl. w2 r31. ; message.sender;
sn w2 0 ; if message.jh-hostid= subhost.jh-hostid then
jl. j4. ; begin
jl w3 d126 ; include user(sender, subproc);
rl w1 (b6) ; exclude user(procfunc, subproc);
jl w3 d123 ; <*procfunc was included as user in the partly
; created subprocess *>;
; end;
; end;
; end;
j4: rl. w0 i1. ; <* restore result (size)
rl w1 b19 ; subhost
rl w2 b18 ; message *>
jl. j1. ; return operation;
;
i1: 0 ; saved result (size)
; linkup local.
;
m7: jl. w3 n9. ; linkup local:
rl w3 x1+a50 ;
rl w0 x3+p84 ; result:=size(18:23);
bz w3 x3+p99 ;
se w3 3 ; if local function=reject
sz w0 8.77 ; or result<>0 then
jl. j2. ; goto clear subprocess;
jl. w3 n3. ; packout(buffer);
rl w1 b4 ;
jl. +4 ;
j15: al w1 x1+2 ; for dev:= first dev. in name table step 2
sh w1 (b5) ; until last dev. in name table do
jl. +4 ; begin
jl. j16. ;
rl w2 x1 ; if kind(dev) = remote subkind or
rl w0 x2+a10 ; kind(dev) = local subkind then
sn w0 p112 ; begin
jl. j17. ;
se w0 p113 ;
jl. j15. ;
j17: am (b18) ; if dh.id(dev) = dh.id and
rl w0 +s6 ; dh.linkno(dev) = dh.linkno(mess)
se w0 (x2+p5) ; then remove subprocess(dev);
jl. j15. ;
bz w0 x2+p11 ;
se. w0 (r32.) ;
jl. j15. ;
jl. w3 n24. ;
jl. j15. ; end;
; end;
; initiate process description.
j16: rl w1 b19 ;
rl. w2 r31. ;
al w0 p112 ;
rs w0 x2+a10 ; kind(sub):=local kind;
am (b18) ;
rl w1 +6 ; proc:=sender(mess);
sh w1 0 ;
ac w1 x1 ;
j7: jl w3 d126 ; include proc + all ancestors as user
rl w1 x1+a34 ;
se w1 0 ;
jl. j7. ;
rl w1 (b6) ; internal := procfunc;
jl w3 d123 ; remove user(internal, subproc);
; <* procfunc was included as user to prevent removel of
; the (partly) created subproc *>
rl. w0 r32. ;
hs w0 x2+p11 ; dh.linkno(sub):=dh.linkno;
rl. w0 r27. ;
hs w0 x2+p9 ; jh. linkno(sub):=jh.linkno;
rl. w0 r22. ;
hs w0 x2+p10 ; subkind(sub):=subkind;
rl. w0 r24. ;
hs w0 x2+p16 ; buffers free(sub):=max buffers;
rl. w0 r25. ;
al w3 0 ;
wd w0 g48 ;
ls w0 1 ;
rs w0 x2+p18 ; max bufsize(sub):=max.bufsize/3*2;
zl w1 x2+p11 ;
rl w0 x2+p5 ;
jl. w3 n30. ; name subproc(dh-hostid, dh-linkno, subproc);
rl w1 b19 ;
rl w2 b18 ;
jl. w3 n1. ; deliver data;
am 0-s31 ; error: size:=0;
al w0 s31 ; ok: size:=std buffer size;
rl. w3 r32. ;
hs w3 x2+s4 ; dh.linkno(mess):=dh.linkno;
c.p101 b.f1 w. ;*****test90*****
rs. w3 f0. ;
jl. w3 f4. ;
90 ;
f0: 0 ;
jl. f1. ;
rl w2 b18 ;
al w0 x2+0 ; dump contents of mess
al w1 x2+22 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test90*****
jl. w3 n11. ; return answer;
jl. w3 u12. ; find first message;
se w2 0 ; if mess<>0 then
jl. w3 n21. ; testready and link;
rl. w2 r31. ; init-exit:
am (b101) ;
jl -2 ; return to main(init);
; clear subprocess description.
j2: am (b18) ; clear process:
bz w2 +s10 ;
ls w2 1 ;
wa w2 b4 ; sub:=word(jh.linkno(mess)<1+base(name table));
rl w2 x2 ;
jl. w3 n24. ; remove subprocess(sub);
rl w2 b18 ;
jl. w3 n18. ; return operation;
jl. j1. ; goto deliver;
; operator output-input.
;
m10: jl. w3 n9. ; operator output-input:
am (x1+a50) ;
bz w0 +p81 ;
so w0 2.1 ; if no datas received then
jl. j0. ; goto deliver size0;
am (x1+a50) ;
bz w2 +p88 ; bufno:=bufno(rec);
jl. w3 u18. ; test and decrease stopcount;
c.-p103
rl w2 b18 ;
al w0 2 ;
wa w0 x2+s3 ; bytes trf:=last(mess)-first(mess)+2;
ws w0 x2+s2 ;
z.
c.p103-1
am (x1+a50) ;
rl w0 +p86 ; bytes trf:=size(data);
jl. w3 u15. ; convert bytes8 to bytes12;
z.
jl. j1. ; goto deliver size;
; operator output.
;
m11: jl. w3 n9. ; operator output:
jl. j0. ; goto deliver;
e. ; end of entry4.
c.p101
; stepping stones.
jl. f4. ;
f4=k-2
jl. f5. ;
f5=k-2
jl. f6. ;
f6=k-2
z.
\f
; subprocedures used in subhost.
; get data.
; copies a data area defined by current message buffer from sender to std driver
; buffer.
; deliver data.
; transfers a datablock from std driver buffer to an internal process. the
; buffer is defined in a message buffer.
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 mess unchanged
; w3 link destroyed
c.p103-1
b.i2 w.
n0: am i2 ; get data:
n1: al. w1 i1. ; deliver data:
jd 1<11+84 ; general copy;
rl w1 b19 ;
se w0 0 ; if result<>0 then
jl x3+0 ; return to link;
jl x3+2 ; exit: return to link+2;
i0: 2<1+0 ; function (addr pair<1+mode)
r0 ; first
r0+s31-2 ; last
0 ; relative
i1: 2<1+1 ; function (addr pair<1+mode)
r20 ; first
r20+s31-2 ; last
0 ; relative
i2=i0-i1
e.
z.
c.-p103
b.i5,j5 w.
n0:
ds. w3 i1. ; get data buffer:
al w0 s31 ; bytecount:=std size(data);
al. w1 r0. ; first addr:=start(int driver buffer);
wa w0 x2+10 ;
rl w2 x2+10 ;
j0: rl w3 x2 ;
rs w3 x1 ;
al w2 x2+2 ;
al w1 x1+2 ;
se w2 (0) ;
jl. j0. ;
rl w1 b19 ;
dl. w3 i1. ;
jl x3+2 ;
n1:
ds. w3 i1. ; get data buffer:
al w0 s31 ; bytecount:=std size(data);
al. w1 r20. ; first addr:=start(int driver buffer);
wa w0 x2+10 ;
rl w2 x2+10 ;
j0: rl w3 x1 ;
rs w3 x2 ;
al w2 x2+2 ;
al w1 x1+2 ;
se w2 (0) ;
jl. j0. ;
rl w1 b19 ;
dl. w3 i1. ;
jl x3+2 ;
i0: 0 ;
i1: 0 ;
e.
z.
; check and packin(buffer).
; checks the values of the different fields and packs the data buffer into the
; std output buffer in the process description of hostprocess. return to link
; in case of errors else to link+2.
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 unchanged
; w3 link destroyed
b.i10 w.
n2: rs. w3 i0. ; check and packin:
bl. w3 r1. ;
sl w3 -1 ; if mode<-1
sl w3 1<8 ; or mode>255 then
jl. (i0.) ; return to link;
bl. w0 r2. ;
sl w0 -1 ; if subkind<-1
sl w0 1<8 ; or subkind>255 then
jl. (i0.) ; return to link;
ls w0 16 ;
ld w0 8 ;
rl. w0 r3. ;
sz. w0 (i4.) ; if size(timeout) or size(buffers)>=8 bits then
jl. (i0.) ; return to link;
ls w0 4 ;
ld w0 8 ; word0(outarea):=
rs w3 x1+s100+0 ; mode<16+subkind<8+timeout;
ls w0 4 ;
rl. w3 r5. ;
sz. w3 (i7.) ; if size(buffer size)>=16 bits then
jl. (i0.) ; return to link;
lo w0 6 ;
rs w0 x1+s100+2 ; word1(outarea):=buffers<16+buffer size;
rl. w3 r7. ;
sz. w3 (i6.) ; if size(jh.linkno)>=10 bits then
jl. (i0.) ; return to link;
ls w3 8 ;
rl. w0 r10. ;
sz. w0 (i5.) ; if size(jh.net-id)>=8 bits then
jl. (i0.) ; return to link;
lo w0 6 ;
rs w0 x1+s100+8 ; word4(outarea):=jh.linkno<8+jh.net-id;
bz. w0 r9. ;
sz. w0 (i5.) ; if size(jh.home-reg)>=8 bits then
jl. (i0.) ; return to link;
ls w0 16 ;
rl. w3 r8. ;
sz. w3 (i7.) ; if size(jh.host-id)>=16 bits then
jl. (i0.) ; return to link;
lo w0 6 ; word5(outarea):=
rs w0 x1+s100+10; jh.home-reg<16+jh.host-id;
dl. w0 r6.+2 ;
ds w0 x1+s100+14;
dl. w0 r6.+6 ; word6-9(outarea):=
ds w0 x1+s100+18; devicename;
am. (i0.) ;
jl +2 ; exit: return to link+2;
i0: 0 ; saved link
i4: 8.7400 7400 ;
i5: 8.7777 7400 ;
i6: 8.7777 6000 ;
i7: 8.7760 0000 ;
e.
; packout.
; packs out a buffer from the std. input buffer in the process description of
; the subhost process. the parameters are delivered in the std. driver input
; buffer.
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 destroyed
; w3 link destroyed
b.i5 w.
n3: rs. w3 i0. ; packout:
rl w0 x1+s102+0 ;
ls w0 -8 ;
la. w0 i4. ;
rs. w0 r22. ; subkind:=word0(8:15);
rl w0 x1+s102+2 ;
al w3 0 ;
ld w0 8 ;
rs. w3 r24. ; max. buffers:=word1(0:7);
ls w0 -8 ;
rs. w0 r25. ; max. buffersize:=word1(8:23);
rl w0 x1+s102+4 ;
ls w0 -8 ;
la. w0 i5. ;
rs. w0 r32. ; dh.linkno:=word2(6:15);
rl w3 x1+s102+8 ;
ld w0 -8 ;
la. w3 i5. ;
rs. w3 r27. ; jh.linkno:=word4(6:15);
ld w0 -16 ;
hs. w0 r30. ; jh.net-id:=word4(16:23);
rl w0 x1+s102+10;
ld w0 8 ;
hs. w3 r29. ; jh.home-reg:=word5(0:7);
ls w0 -8 ;
rs. w0 r28. ; jh.host-id:=word5(8:23);
al w0 0 ;***jh.home-reg,jh.net-id:=0
rs. w0 r29. ;*** used until they are defined from the dev contr
dl w0 x1+s102+14;
ds. w0 r26.+2 ;
dl w0 x1+s102+18;
ds. w0 r26.+6 ; devicename:=word6-9(inarea);
rl. w3 r27. ;
ls w3 1 ;
wa w3 b4 ;
rl w3 x3 ;
bz w0 x1+p7 ;
bs. w0 r30. ;
rl w2 x1+p5 ;
sn w0 0 ; if jobhost(data)=jobhost(subhost) then
se. w2 (r28.) ; proc desc:=word(jh.linkno<1+base(nametable));
al w3 0 ; else
rs. w3 r31. ; proc desc:=0;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
i4: 8.0000 0377 ;
i5: 8.0000 1777 ;
e.
; setup header1.
; this procedure sets up the header transmission parameters according to
; the format used of release link and lookup link.
;
; setup header2.
; this procedure sets up the header transmission parameters according to
; the format used of lookup, lookup reserve, cancel reservation, linkup
; remote and linkup local.
;
; setup header3.
; this procedure sets up the header transmission parameters according to
; the format used of operaor output and operator output-input.
;
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 mess unchanged
; w3 link destroyed
b.i5,j5 w.
n4: ds. w3 i1. ; setup header1:
rl w3 x1+a50 ;
rl w0 x2+s9 ;
rs w0 x3+p64 ; size:=jh.host-id;
bz w0 x2+s11 ;
rs w0 x3+p63 ; mode:=jh.net-id;
jl. j0. ; goto common part;
n5: ds. w3 i1. ; setup header2:
rl w3 x1+a50 ;
al w0 x1+s100 ;
rs w0 x3+p65 ; first:=first(outarea);
c.-p103
al w0 x1+s100+s101-2;
rs w0 x3+p66 ; last:=last(outarea);
al w0 s101>1*3 ;****midlertidigt
rs w0 x3+p64 ;*****
z.
c.p103-1
al w0 s101>1*3 ;
rs w0 x3+p66 ; size:=std buffer size;
al w0 8 ;
hs w0 x3+p72 ; address code:=dirty;
z.
jl. j0. ; goto common2;
n6: rs. w3 i1. ; setup header3:
al w0 x2+1 ;
rs. w0 i0. ; saved mess:=uneven mess;
rl w0 x2+s2 ;
am (x1+a50) ;
rs w0 +p65 ; first(trm):=first(mess);
al w0 2 ;
wa w0 x2+s3 ;
ws w0 x2+s2 ; size12:=last(mess)+2-first(mess);
jl. w3 u14. ; convert size12 to size8;
rl w3 x1+a50 ;
rs w0 x3+p64 ; size(trm):=size8;
c.-p103
rl w0 x2+s3 ;
z.
rs w0 x3+p66 ; last(trm):=last(mess);
; charcount(trm):=0;
c.p103-1
c. p103-1
al w0 0 ;
hs w0 x3+p72 ; address code(main):= sender area
al w0 x2 ;
rs w0 x3+p71 ; message buffer(main):= message
z.
z.
j0: bz w0 x2+s4 ; common1:
hs w0 x3+p69 ; rec.linkno:=dh.linkno(mess);
bz w0 x2+s10 ;
hs w0 x3+p78 ; sender linkno(trm):=jh.linkno(mess);
j1: bz w0 x2+s1 ; common2:
ls w0 -2 ; internal status:=ok, function(trm):=header function(mess);
hs w0 x3+p61 ; state(trm):=0;
al w0 2.11 ;
la w0 x2+s1 ;
rs w0 x3+p63 ; mode(trm):=function mode(mess);
bz w0 x2+s8 ;
hs w0 x3+p301 ; receiver net-id(trm):=dh.net-id(mess);
bz w0 x2+s7 ;
hs w0 x3+p302 ; receiver home-reg(trm):=dh.home-reg(mess);
rl w0 x2+s6 ;
rs w0 x3+p303 ; receiver host-id(trm):=dh.host-id(mess);
rl. w2 i0. ; mess:=saved mess;
jl. w3 n10. ; get next free message entry(host);
la w2 g50 ; mess:=even mess;
am (x1+a50) ;
hs w3 +p68 ; bufno(trm):=current bufno;
jl. (i1.) ; exit: return;
i0: 0 ; saved mess
i1: 0 ; saved link
e.
; get mess buffer.
;
; call: return:
; w0 unchanged
; w1 subhost unchanged
; w2 mess buffer(bufno)
; w3 link unchanged
b. w.
n8: am p68-p88 ; get mess buf(trm):
n9: al w2 p88 ; get mess buf(rec);
am (x1+a50) ;
zl w2 x2 ;
am x2 ;
am x2 ;
rl w2 x1+p19 ; mess:=even message addr(bufno);
la w2 g50 ;
rs w2 b18 ; current buffer:=mess;
jl x3 ; return;
e.
; get next free message entry.
; finds the next free mess entry in the message table, and inserts the value in
; current bufno. mess - even or uneven - is inserted in the mess entry.
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 mess unchanged
; w3 link bufferno
b.i0,j1 w.
n10: rs. w3 i0. ; get next free mess entry:
al w0 -1 ;
ba w0 x1+p16 ; buffers free:=buffers free-1;
hs w0 x1+p16 ;
al w0 0 ;
bz w3 x1+p17 ;
al w3 x3-1 ;
j0: al w3 x3+1 ;
sl w3 v3 ;
al w3 0 ;
am x3 ;
am x3 ;
se w0 (x1+p19) ;
jl. j0. ;
j1: hs w3 x1+p17 ;
am x3 ;
am x3 ;
rs w2 x1+p19 ; insert message in mess entry;
ac w0 (x2+4) ;
sl w0 0 ; if receiver(mess) > 0 then
jl. (i0.) ; begin
rs w0 x2+4 ; receiver(mess):= -receiver(mess);
al w0 -1 ;
am (b21) ; bufclaim( driverproc):=
ba w0 +a19 ; bufclaim( driverproc) - 1;
am (b21) ;
hs w0 +a19 ; end;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
e.
; return answer.
;
; call: return:
; w0 bytes trf destroyed
; w1 subhost unchanged
; w2 mess destroyed
; w3 link destroyed
b.i0 w.
n11: rs. w3 i0. ; return answer:
rl w3 0 ;
ls w0 -1 ;
wa w0 6 ; bytes trf(mess):=bytes trf;
ds w0 x2+s3 ; chars trf(mess):=bytes trf*3/2;
am (x1+a50) ;
rl w3 +p84 ;
ld w0 -8 ;
ls w3 2 ;
ld w0 2 ;
ls w3 6 ;
ld w0 6 ;
am (x1+a50) ;
zl w0 +p99 ;
sn w0 3 ; if local function=reject then
al w3 8 ; function result:=8;
rs w3 x2+s0 ; return value:=device status<16+linkno descriptor<12+function result;
rl. w0 r32. ;
hs w0 x2+s4 ; dh.linkno(mess):=dh.linkno;
jl. w3 u11. ; clear message entry;
jl. w3 n19. ; deliver answer(ok,buf);
am (x1+a50)
bz w0 +p81
sn w0 42
am p162-p160
al w0 p160 ;
am (x1+a50) ;
hs w0 +p80 ; internal status(rec):=ok;
jl. (i0.) ; exit: return;
i0: 0 ; saved link;
e.
; return stopped answer.
;
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 mess destroyed
; w3 link destroyed
b.i0 w.
n12: am -1+2 ; return stopped answer:
n13: am -2-3 ; return relected answer:
n14: al w0 3 ; return noresources answer:
rs. w3 i0. ;
rs w0 x2+s1 ; function result:=-1;
ld w0 -100 ;
ds w0 x2+s3 ; bytes, chars trf:=0,0;
jl. w3 n19. ; deliver answer(ok,mess);
jl. (i0.) ; exit: return;
i0: 0 ; saved link
e.
; return operation.
; call: return:
; w0 size
; w1 subhost unchanged
; w2 message
; w3 link destroyed
b.i4,j4 w.
n18: rs. w3 i0. ; return operation:
rl w3 x1+a50 ;
bz w0 x3+p81 ;
bz w3 x3+p99 ;
sz w0 2.1 ; if no datas
sn w3 3 ; or local function=reject then
jl. j0. ; size:=0;
jl. w3 n3. ; else
rl w2 b18 ; packout;
jl. w3 n1. ; deliver data;
j0: am 0-s31 ; sender stopped: size:=0;
al w0 s31 ; ok: size:=std size;
jl. (i0.) ; exit: return;
i0: 0 ; save link
e.
; deliver answer(ok,mess).
;
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 mess destroyed
; w3 link destroyed
b.i0 w.
n19: ; deliver answer:
c.-p103
al w0 1 ;
rs w0 x2+4 ; result(mess):=0k;
jl d15 ; deliver answer(mess);
z.
c.p103-1
rs. w3 i0. ;
dl w0 x2+10 ;
ds w0 g21 ;
dl w0 x2+14 ; transfer 5 words from buffer to
ds w0 g23 ; answer area to possibilitate
rl w0 x2+16 ; the use of g18
rs w0 g24 ;
jl w3 g18 ; deliver result(ok);
jl. (i0.) ; exit: return;
i0: 0 ; saved link
z.
e.
; link operation.
;
; call: return:
; w0 destroyed
; w1 proc unchanged
; w2 mess destroyed
; w3 link destroyed
b.i0 w.
n20: rs. w3 i0. ; link operation:
al w1 x1+a54 ;
jl w3 d6 ;
al w1 x1-a54 ;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
e.
; testready and link.
; if free buffers is less than two and sender.cur mess not the subhost itself
; then return.
; (save the last message entry for answers to avoid deadlock )
;
; if the subhost is in mainproc queue, the state of the subhost is ready
; and there is free buffers the subhost is linked in the main process queue.
; call: return:
; w0 destroyed
; w1 proc destroyed
; w2 destroyed
; w3 link destroyed
b.i1 w.
n21: zl w0 x1+p16 ; if free buffers <= 1
sl w0 2 ; and sender(cur mess) < > cur receiver then
jl. n23. ;
rl w2 b18 ; return else
se w1 (x2+6) ; begin
jl x3 ;
n23: ; subentry: test and link answer
rl w0 x1+p14 ; testmore:
se w0 x1+p14 ; if proc already in mainproc queue then
jl x3 ; return to link;
rl w0 x1+p12 ;
se w0 0 ; if state(proc)<>0 then
jl x3 ; return to link;
bl w0 x1+p16 ;
sh w0 0 ; if buffers free=<0 then
jl x3 ; return to link;
al w2 x1+p14 ;
rl w1 x1+a50 ; main:=main(host);
rl w1 x1+p14 ; queue head:=last(mainproc queue);
jl d6 ; link(head,elem);
; exit: return to link;
e.
; procedure check and remove.
; call: return:
; w0 destroyed
; w1 subhost unchanged
; w2 destroyed
; w3 link destroyed
b.i4 w.
n22: rs. w3 i0. ; check and remove:
rl w3 x1+a50 ;
bz w2 x3+p89 ;
ls w2 1 ;
wa w2 b4 ; sub:=proc(jh.linkno(rec));
rl w2 x2 ;
rl w0 x3+p323 ;
sn w0 (x2+p5) ; if main(sub)=main
se w3 (x2+a50) ; and dh.host-id(sub)=dh.host-id(rec)
jl. (i0.) ; and dh.net-id(sub)=dh.net-id(rec) then
bz w0 x3+p321 ; remove subprocess(sub);
bs w0 x2+p7 ;
sn w0 0 ;
jl. w3 n24. ;
jl. (i0.) ; exit: return;
i0: 0 ;
e.
; remove subprocess(sub).
; removes a subprocess by returning all messages in the event queue
; with dummy answer and clearing the mainproc addr.
; call: return:
; w0 destroyed
; w1 unchanged
; w2 subproc unchanged
; w3 link destroyed
b.i6,j5 w.
v102: ; remove subprocess:
n24: ;
rs. w3 i0. ; remove subprocess: save link;
rs. w1 i1. ; save w1;
c.p101 b.f1 w. ;*****test94*****
rs. w3 f0. ;
jl. w3 f4. ;
94 ;
f0: 0 ;
jl. f1. ;
rs w2 x3 ;
al w0 x3 ;
al w1 x3 ;
jl. w3 f5. ;
f1: ;
e.z. ;*****test94*****
jl. w3 (i2.) ; clean subproc(sub);
zl w0 x2+p10 ; if terminal then
se w0 8 ;
jl. j2. ;
; begin
rs. w2 i5. ; save terminal
rl w3 (b3) ;
al w0 x3+a54 ; message:= remoter.eventq.first;
rl w3 x3+a54 ; while message <> none do
rs. w0 i4. ; begin
j3: rs. w3 i3. ;
sn. w3 (i4.) ;
jl. j2. ;
zl w0 x3+a150 ; if message.operation = wait for connect then
se w0 2 ; begin
jl. j5. ;
zl w0 x3+a150+1 ; if (message.mode = all connections) or
so w0 2.1 ; (message.mode = specific main and
jl. j4. ; message.mainaddress = this main) then
rl w0 x3+a151 ; begin
se w0 (x2+a50) ;
jl. j5. ;
j4: rl w3 x3+a142 ; sender:= message.sender;
rl w0 x3+a10 ; if sender.kind<>internal then
se w0 0 ; sender:=sender.main; <*pseudo proc*>
rl w3 x3+a50 ;
rs. w3 i6. ; save reciver
rl. w2 i5. ;
al w3 0 ;
al w0 1<1 ;
al w1 g20 ; att-mess +0 : 0
ds w0 g21 ; +2 : 1<1 ; terminal disconnected
rs w2 g22 ; +4 : pd of terminal
dl w0 x2+a11+2 ; +6-12: name of terminal
ds w0 g23+2 ;
dl w0 x2+a11+6 ;
ds w0 g23+6 ;
rl. w3 i6. ; send att-mess(w0=mess, w2=sender, w3=receiver)
rl w2 x2+a50 ;
jd 1<11+17 ;
rl. w2 i5. ; restore terminal
jl. j2. ; end;
j5: rl. w3 i3. ;
rl w3 x3+a140 ; message:=message.next;
jl. j3. ; end;
j2:
al w0 p113 ;
rs w0 x2+a10 ; kind(sub):=remote subproc kind;
ld w0 -100 ;
ds w0 x2+a11+2 ; name(subproc):=0;
ds w0 x2+a11+6 ;
rs w0 x2+a50 ; mainproc(subproc):=0;
rs w0 x2+a52 ; reserver:=0
j0: am x3 ;
rs w0 x2+a402 ; users:=0
al w3 x3+2 ;
sh w3 a403-2 ;
jl. j0. ; end;
j1: rl. w1 i1. ; restore w1;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
i1: 0 ; saved w1
i2: v101 ; address of clean subprocess
i3: 0 ; message
i4: 0 ; mess queue head
i5: 0 ; terminal
i6: 0 ; receiver
e.
; create subprocess.
; call: return:
; w0 destroyed
; w1 hostproc unchanged
; w2 subproc unchanged
; w3 link destroyed
b.i10,j10 w.
n25: rs. w3 i0. ; create subprocess: save link;
ds. w2 i2. ; save host, sub;
al w0 0 ; insert zeroes in
al w3 x2+2 ; process description;
j0: rs w0 x3 ;
al w3 x3+2 ;
sh w3 x2+a79-2 ;
jl. j0. ;
dl w0 x1+a49 ;
ds w0 x2+a49 ; interval(sub):=interval(subhost);
rl w0 x1+a50 ;
rs w0 x2+a50 ; main(sub):=main(host);
al w0 x2+a54 ; initiate next,last event;
rs w0 x2+a54 ;
rs w0 x2+a55 ;
al w1 x2+p14 ;
rs w1 x2+p14 ; next, last subproc(sub):=sub;
rs w1 x2+p15 ;
; procfunc is inserted as user to prevent the monitor to remove the
; subprocess while the subprocess is under creation.
rl w1 (b6) ; internal := procfunc;
jl w3 d126 ; include user(internal, subproc);
rl. w1 i1. ; restore host;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
i1: 0 ; saved host
i2: 0 ; saved sub
e.
; get free buffer.
; takes the first free buffer from the message buffer pool and inserts
; it in the event queue.
; call: return:
; w0 destroyed
; w1 host unchanged
; w2 buffer
; w3 link main
b.i0 w.
n26: rs. w3 i0. ; get free buffer:
rl w2 b8 ; buffer:=first free in pool;
rs w2 b18 ;
jl w3 d5 ; remove buffer;
rs w1 x2+4 ; receiver(buf):=subhost;
rs w1 x2+6 ; sender(buf):=subhost;
ld w0 -100 ;
ds w0 x2+10 ;
ds w0 x2+14 ; insert zeroes in mess buffer;
ds w0 x2+18 ;
ds w0 x2+22 ;
rl w1 x1+a54 ; link message in front of queue
jl w3 d6 ; (to avoid deadlock)
rl w1 x2+4 ; restore subhost
rl w3 x1+a50 ;
jl. (i0.) ; exit: return;
i0: 0 ; link
e.
; release buffer.
; removes a buffer from the event queue and inserts it in the
; pool of free buffers.
; call: return:
; w0 unchanged
; w1 unchanged
; w2 buffer destroyed
; w3 link destroyed
b.i5 w.
n27: rs. w3 i0. ; release buffer:
rs. w1 i1. ; save link, w1;
rl w3 x2+4 ; if rec(buf) < 0 then
sl w3 0 ; begin
jl. i3. ;
al w1 1 ;
am (b21) ; claim(driverproc) :=
ba w1 +a19 ; claim(driverproc) + 1;
am (b21) ;
hs w1 +a19 ; end;
i3: jl w3 d5 ; remove buffer;
al w1 b8 ; pool:=empty pool;
jl w3 d13 ; insert buffer in pool;
rl. w1 i1. ; restore w1;
jl. (i0.) ; exit: return;
i0: 0 ; saved link
i1: 0 ; saved w1
; procedure name subproc(dh-hostid, dh-linkno, subproc);
; gives the subprocess a unic name. the name will be illegal,
; this is done to prevent any collision with existing names.
; call return
; w0 dh-hostid destroyed
; w1 dh-linkno destroyed
; w2 subproc subproc
; w3 link destroyed
;
b. i10, j10 w.
n30: ; name subproc
ds. w1 i1. ; begin
ds. w3 i3. ;
ld w0 -100 ; subproc.name := 0;
ds w0 x2+a11+2 ;
ds w0 x2+a11+6 ;
al w2 x2+a11 ; convert integer to text(dh-linkno, subproc.name,
jl. w3 n31. ; no of char);
rl. w2 i2. ;
rl w1 x2+a11 ;
sl w3 3 ; if no of char<3 then
jl. j1. ; subproc.name(1,3) :=
am x3 ; if no of char=2 then
jl. x3 ; "0" + subproc.name(1,2)
ls w1 -8 ; else "00" + subproc.name(1,1);
ls w1 -8 ;
lo. w1 x3+i5. ;
rs w1 x2+a11 ;
;
j1: rl. w1 i6. ; subproc.name(3,3) := <:sub:>;
rs w1 x2+a11+2 ;
al w2 x2+a11+4 ; convert integer to text(dh-hostid,
rl. w1 i0. ; subproc.name(7,6), no of char);
jl. w3 n31. ;
;
dl. w3 i3. ;
jl x3 ;
;
i0: 0 ; save registers
i1: 0 ;
i2: 0 ;
i3: 0 ;
i5: 48<16 + 48<8 ; '0' + '0'
48<16 ; '0'
i6: <:sub:> ;
;
e. ; end;
; procedure convert integer(integer, text, no of char);
; converts the (positive) integer to a textstring stored in
; the specified address.
; call return
; w0 - destroyed
; w1 integer destroyed
; w2 text address destroyed
; w3 link no of char
;
b. i10, j10 w.
i0: 1 ; divisor table
10 ;
100 ;
1000 ;
10000 ;
100000 ;
1000000 ;
i1: 0 ; char shift
i2: 0 ; no of char
i3: 0 ; position
i4: 0 ; integer
i5: 0 ; text
i6: 0 ; link
;
n31: ; convert integer
al w0 0 ; begin
ds. w1 i4. ; save params;
ds. w3 i6. ;
al w3 16 ; position := 0;
rs. w3 i1. ; char shift := 16;
;
al w3 0 ; repeat begin
j1: wd. w1 i0.+2 ; integer := integer / 10;
al w3 x3+1 ; no of char := no of char + 1;
al w0 0 ;
se w1 0 ; end until integer = 0;
jl. j1. ;
;
rs. w3 i2. ; rem character := no of char;
j2: rl. w2 i4. ; repeat begin
al w1 0 ; char := (integer//divisor table(rem character)+
am x3 ; 48) shift char shift;
wd. w2 x3+i0.-2 ;
al w2 x2+48 ;
ls. w2 (i1.) ;
rs. w1 i4. ; integer:=integer mod divisortabel(rem character);
;
rl. w1 i3. ;
wa. w1 i5. ;
lo w2 x1 ; text.position := char;
rs w2 x1 ;
;
al w0 -8 ;
wa. w0 i1. ; charshift := charshift - 8;
sl w0 0 ;
jl. j3. ; if charshift<0 then
al w0 2 ; begin
wa. w0 i3. ; position := position + 2;
rs. w0 i3. ; char shift := 16;
al w0 16 ; end;
j3: rs. w0 i1. ;
al w3 x3-1 ; rem character := rem character - 1;
se w3 0 ; end until rem character = 0;
jl. j2. ;
;
rl. w3 i2. ;
jl. (i6.) ; end;
;
e. ;
e.
e. ; end of subhost driver.
e. ; end of host- and subhost drivers.
c. p101
jl. f4. ; stepping stone testoutput
f4=k-2
jl. f5. ; stepping stone testoutput
f5=k-2
jl. f6. ; stepping stone testoutput
f6=k-2
z. ; end test
▶EOF◀