|
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: 36864 (0x9000)
Types: TextFile
Names: »imcprocs4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »imcprocs4tx «
<* ! ! ! ! ! ! !*>
; fgs 1988.03.01 algol 6, imcprocedures page ...1...
b. g1, i12 ; block for tail parts
w.
d.
p.<:fpnames:> ; fpnames
l.
s. c30, e30 ; slang segment
w.
c6 = + 1 ; boolean ADP SW REL 6.0 (-1 = no, 1 = yes)
c25 = - 10 ; size of reserved work area in stack :
c24 = c25 + 0 ; long , addr of reason parameter
c23 = c24 + 2 ; integer, wanted , used in allocate descriptors
c22 = c23 + 2 ; - , return2 , - - wait response
c21 = c22 + 2 ; - , return1 , - - execute operation
c20 = c21 + 2 ; - , operation, - - all procedures
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...2...
b. d10, j300 ; block for first segment
w.
k=0
h.
c0 = 1 ; no of externals
c1 : c2 , c3 ; rel last point , rel last abs word
j3 : c0 + 3 , 0 ; rs reserve
j4 : c0 + 4 , 0 ; rs take expr
j6 : c0 + 6 , 0 ; rs end reg. expression;
j12 : c0 + 12 , 0 ; rs uv
j13 : c0 + 13 , 0 ; rs last used
j21 : c0 + 21 , 0 ; rs general alarm
j30 : c0 + 30 , 0 ; rs save sref, w3
j85 : c0 + 85 , 0 ; rs current activity no
j88 : c0 + 88 , 0 ; rs passivate2
j101: c0 + 101 , 0 ; rs answer address
j201: 1<11 o. 1 , 0 ; segment 1, docname in array
c2=k-2-c1
c3=k-2-c1
w.
e4: ; start external list:
i12: c0 ; no of externals
0 ; no of halfs to copy
<:termzone<0>:>, 0 ; external no 1: termzone
15<18 + 0 , 0 ; specs 1 and 2: illegal procedure
s3 , s4 ; date, time
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...2...
b. a50, b50 ; block for entry imc procedures
w.
i3: am 2 ; imcconnect : op := 8;
i2: am 2 ; imcgetconn : op := 6;
i1: al w0 4 ; imcopenport: op := 4;
rl. w2 (j13.) ; w3 := last used;
ds. w3 (j30.) ; save sref, w3;
al w1 c25 ;
jl. w3 (j3.) ; reserve work;
rs w0 x2+c20 ; work.operation := op;
rl w3 x2+8 ; zone := first formal.2;
zl w1 x3+h1+1 ; kind := zone.kind;
se w1 20 ; if kind <> imc then
jl. d3. ; goto zone kind alarm;
rl w1 x3+h2+6 ;
se w1 8 ; if zone.state <> 8 then
jl. d1. ; goto zonestate error;
sn w0 6 ; if op = getconnect then
jl. a2. ; goto imcgetconn;
rl. w3 (j201.) ; get name param:
jl x3+e5 ; goto get name param on segment 1;
e1: rl w0 x2+c20 ; return from segment 1 after name param:
se w0 4 ; if operation <> openport then
jl. a2. ; goto imcconnect/imcgetconn;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...3...
dl w1 x2+20 ; imcopenport :
so w0 16 ; get last formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stackref, w3;
rs w1 x2+c24 ; work.reason := addr of reason;
dl w1 x2+12 ;
so w0 16 ; get second formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
rl w1 x1 ; scope:= value second actual;
sl w1 0 ; if scope < 0
sl w1 4 ; or scope > 3 then
jl. d2. ; goto scope alarm;
rl w2 x2+8 ; w2 := zone;
al w0 0 ; fncs_needed := 0;
rx w1 0 ; swop (w0, w1);
am (x2+h0+4) ; zone.used share (+2, +4) :=
ds w1 +6+4 ; (scope, fncs_needed);
al w3 x2+h1+2 ; w3 := name address;
jd 1<11+6 ; initialize process;
jl. w3 a24. ; allocate descriptors and sense port;
rl w0 x2+c20 ; operation := work.operation;
rl w1 x2+10 ; index := max_connections : = second formal1;
rl w2 x2+8 ; w2 := zone;
al w3 8 ; zone.state :=
rs w3 x2+h2+6 ; 8;
jl. w3 a22. ; execute operation; <*openport*>
rl w0 x1 ; status := answer.status;
rs w0 x2+14 ; save status in third formal1;
ld w1 70 ; operation := index := 0;
rl w2 x2+8 ; w2 := zone;
jl. w3 a22. ; execute operation; <*sense*>
rl w0 x2+14 ; restore status from third formal1;
sn w0 0 ; if status = 0 then
jl. a13. ; goto return_true else
jl. a11. ; goto return_false_normal;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...4...
a2: dl w1 x2+12 ; imcconnect/imcgetconn:
so w0 16 ;
jl. w3 (j4.) ; get addr index;
ds. w3 (j30.) ; save stackref, w3;
rs w1 x2+12 ; second formal2 := address of index;
rl w1 x1 ; index := value index;
sh w1 -1 ; if index < 0 then
jl. d3. ; goto index alarm;
rl w3 x2+c20 ;
sn w3 6 ; if operation = getconnect then
am -4 ; addr last formal := addr last formal - 4;
dl w1 x2+20 ; get last formal;
so w0 16 ;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stackref, w3;
rs w1 x2+c24 ; work.reason := addr of reason;
; <*also for imcgetconn*>
rl w2 x2+8 ; w2 := zone;
al w0 0 ; zone.
am (x2+h0+4) ; used share.
rs w0 +6+2 ; service := 0;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...5...
al w3 x2+h1+2 ; w3:=name addr;
jd 1<11+6 ; initialise process;
jl. w3 a24. ; allocate descriptors and sense;
al w0 0 ;
am (x2+8) ; zone.state :=
rs w0 +h2+6 ; 0; <*connect operation sent*>
rl w1 (x2+12) ;
sn w1 0 ; if index <> 0 then
jl. a3. ; begin
rs w1 x2+10 ; second formal1 := last index := index;
al w1 x1-1 ; index := index - 1;
; end;
a3: rl w0 x2+c20 ; repeat
al w1 x1+1 ; operation := work.operation;
rs w1 x2+6 ; index := index + 1;
rl w2 x2+8 ; w2 := zone;
jl. w3 a22. ; execute operation;
rl w0 x1 ; status := answer.status;
rl w1 x1+6 ; index := answer.index ;
se w0 0 ;
sn w1 (x2+10) ; until index = last index or status = 0;
jl. a10. ;
jl. a3. ;
a10: rs w1 (x2+12) ; second actual :=
am (x2+8) ; zone.segm count :=
rs w1 +h1+16 ; index;
sn w0 0 ; if status = 0 then
jl. a13. ; goto return_true;
rl. w1 j101. ; w1 := addr rts.answer area;
jl. a11. ; goto return_false_normal;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...6...
e2: ; imcdisconn/imccloseprt :
am (x2+8) ;
al w3 +h1+2 ; w3 := zone.name addr;
jd 1<11+6 ; initialize process ;
rl w0 x2+c20 ; operation := work.operation;
rl w2 x2+8 ; zone := first formal;
rl w1 x2+h1+16 ; index := zone.segm count;
jl. w3 a22. ; execute operation;
rl w0 x1 ; status := answer.status;
se w0 0 ; if status <> 0 then
jl. a11. ; goto return_false_normal;
am (x2+8) ; zone.segment count :=
rs w0 +h1+16 ; 0; <*index*>
jl. a13. ; goto return_true;
m. end imcdisconn/imccloseprt
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...7...
c. c6 ; if ADP SW REL 6.0 then
; include
; procedure sense and get maxconnections :
;
; call : return :
;
; w0 - answer area.max connections
; w1 - address answer area
; w2 zone sref
; w3 link -
b. b1 ; begin block sense and get maxconnections
w. ;
a24: am. (j30.) ; entry:
rl w2 -2 ; w2 := saved sref;
rs w3 x2+14 ; save return in third formal1;
ld w1 70 ; operation := index := 0;
rl w2 x2+8 ; w2 := zone;
jl. w3 a22. ; execute operation; <*sense*>
rl w0 x1+8 ; second formal1 := last index :=
rs w0 x2+10 ; answer area.max connections;
jl (x2+14) ; return;
i.
e. ; end block sense and get maxconnections
z. ; end include ADP SW REL 6.0
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...9...
c. -c6 ; if not ADP SW REL 6.0 then
; include
; procedure get maxconnections : :
;
; call : return :
;
; w0 - maxconnections (= 128)
; w1 - -
; w2 - sref
; w3 link -
;
b. b1 ; begin block allocate descriptors
w. ;
a24: am. (j30.) ; w2 :=
rl w2 -2 ; saved sref;
al w0 128 ; second formal1 :=
rs w0 x2+10 ; max connections := 128;
jl x3 ; return;
i.
e. ; end block get maxconnections;
z. ; end include not ADP SW REL 6.0
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...10...
; procedure execute operation
;
; call : return :
;
; w0 operation 1 (= normal answer)
; w1 index answer area
; w2 zone last used (= call sref)
; w3 link link
;
b. a4, b4 ; begin block execute operation
w. ;
a22: am. (j30.) ; entry:
am (-2) ; save return
rs w3 +c21 ; in work.return1;
jl. a0. ; goto start operation;
a3: jl. w3 a2. ; wait: wait response;
rl w2 x2+8 ; w2 := zone address;
am a5 ; modify entry in send operation;
a0: jl. w3 a1. ; start operation; (w0=op, w1=index, w2=zone)
jl. a3. ; if used share not free then wait;
jl. w3 a2. ; wait response ; ( w2=zone)
se w0 1 ; if dummy answer then
jl. a12. ; goto return_false_dummy
rl w0 x1 ; else
rl w3 x2+c21 ; begin
jl x3 ; w0 := answer area.status;
; restore return from return1;
; goto return;
; end;
\f
; fgs 1988.06.13 algol 6, imc procedures page ...11...
a1: rs. w3 b2. ; send operation: save return;
rl w3 x2+h0+4 ; share := zone.used share;
ls w0 12 ;
rs w0 x3+6 ; share.op := op < 12; <*mode := 0;*>
rs w1 x3+6+6 ; share.index := index;
rl w0 x3 ; state := share.state;
sl w0 2 ; if state neither free nor ready then
jl. (b2.) ; goto return;
a4: rl w1 x2+h0+4 ; w1 := zone.used share.
al w1 x1+6 ; mess area;
al w3 x2+h1+2 ; w3 := zone.docname address;
rl. w2 (j85.) ; w2 := current activity number;
jd 1<11+16 ; send message;
sn w2 0 ; if message buffer claim exceeded then
jd 1<11+18 ; provoke break 6;
rs w2 x1-6 ; share.state := message buffer address;
al w2 x3-h1-2 ; w2 := zone addr;
am. (b2.) ; goto return +
jl 2 ; return + 2;
a2: am. (j30.) ; wait response:
am (-2 ) ;
rs w3 +c22 ; save return in work.return2;
dl. w1 (j30.) ; w0 := saved sref;
jl. w3 (j88.) ; goto passivate2;
dl. w3 (j12.) ; w2 := saved sref;
rl w1 x2+c22 ; w1 := saved return2;
rl w3 x2+8 ; w3 := zone address;
rl w2 (x3+h0+4) ; w2 := zone.used share.state; <*mess buff addr*>
sn w2 0 ; if state = 0 then
jl x1 ; goto return;
rl. w1 j101. ; w1 := address rts answer area;
jd 1<11+18 ; wait answer;
al w2 x3 ; w2 := zone address;
al w3 0 ; zone.used share.state :=
rs w3 (x2+h0+4) ; 0;
dl. w3 (j12.) ; w2 := saved sref;
rl w3 x2+c22 ; restore return from work.return2;
ds. w3 (j30.) ; store sref, w3;
jl x3 ; return;
a5 = a4 - a1 ; modification to entry a1 to get a4
b2 : 0 ; saved return from send operation
m. end execute operation
i.
e. ; end block execute operation
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...12...
a11: al w3 0 ; return_false_normal:
ns w0 7 ; <*w0 = status <> 0*>
el w3 7 ; w0 := bit no of
ac w0 x3-1 ; status <
ls w0 12 ; 12 +
ea. w0 1 ; 1 ; <*bit no < 12 + 1 for normal answer*>
dl w2 x1+14 ;
ls w2 12 ; w1 := answer.state < 12 +
ld w2 12 ; answer.reason;
a12: dl. w3 (j30.) ; return_false_dummy:
; w2 := saved sref;
am -1 ; return_false: return := false;
a13: al w3 1 ; return true : return := true ;
sn w3 1 ; if return then
al w0 1 ; w0 := 0 < 12 + 1;
ds w1 (x2+c24) ; reason := (w0, w1);
al w1 x3 ; w1 := return;
rs. w2 (j13.) ; unstack reserved memory;
jl. (j6.) ; goto end reg. expression;
m. end imcopenport/imcconnect/imcgetconn
i.
e.;end block for imcopenport/imccloseprt/imcconnect/imcgetconn/imcdisconn
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...13...
b. b20 ; begin block alarms
w.
b1 : <:<10>z.state<0>:> ; state alarm
b2 : <:<10>scope<0>:> ; scope alarm
e11: ; external entry:
d1 : am b1-b2 ; zone state alarm:
; general alarm(<:z.state:>,state);
e12: ; external entry:
d2 : al. w0 b2. ; scope alarm:
jl. w3 (j21.) ; general alarm (<:scope:>, scope);
d3: rl. w3 (j201.) ; zone kind alarm on segment 1:
jl x3+e23 ; general alarm (<:z.kind:> , kind );
i.
e. ; end block alarms
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...14...
j20:
c. j20-506
m. code on segment 0 too long
z.
m. end code on segment 0
c. 502-j20
0,r.(:504-j20:)>1 ; fill with zeroes
z.
<:imcprocs 0<0>:> ; alarm text segment 1
m. end segment 0
i.
e.;end block for segment 0
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...15...
b. d10, j200 ; begin block for segment 1
w.
k=0
h.
c10 : c11 , c12 ; rel last point, rel last absword
j1 : 1<11 o. (:-1:), 0 ; ref to segment 0
j3 : c0 + 3 , 0 ; rs entry 3 : reserve
j4 : c0 + 4 , 0 ; rs entry 4 : take expression
j6 : c0 + 6 , 0 ; rs entry 6 : end reg. expression
j13 : c0 + 13 , 0 ; rs entry 13 : last used
j16 : c0 + 16 , 0 ; rs entry 16 : segment table base
j21 : c0 + 21 , 0 ; rs entry 21 : general alarm;
j29 : c0 + 29 , 0 ; rs entry 29 : param alarm
j30 : c0 + 30 , 0 ; rs entry 30 : saved sref, w3
j54 : c0 + 54 , 0 ; rs entry 54 : field alarm
j60 : c0 + 60 , 0 ; rs entry 60 : last of segment table
j101 : c0 +101 , 0 ; rs entry101 : rts answer address
c12 = k-2 - c10 ; rel of last absword
j200 : 1 , 0 ; external no 1, termzone, point
c11 = k-2 - c10 ; rel of last point
j17 = 32 ; slang constant, inout bit in zonestate
j18 = 64 ; - , buflength error bit in zonestate
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...16...
b. a30 ; begin block for imcdisconn/imccloseprt
w.
i4: am 8 ; imcdisconn : op := 10;
i0: al w0 2 ; imccloseprt: op := 2;
rl. w2 (j13.) ; w2 := last used;
ds. w3 (j30.) ; save sref, w3;
al w1 c25 ;
jl. w3 (j3.) ; reserve work;
rs w0 x2+c20 ; work.operation := op;
rl w3 x2+8 ; w3 := zone;
zl w1 x3+h1+1 ;
se w1 20 ; if zone.kind <> 20 then
jl. d3. ; goto zonekind alarm;
se w0 2 ; if op = closeport then
jl. a24. ; begin
rl w1 x3+h2+6 ;
se w1 8 ; if zone.state <> 8 then
jl. d1. ; goto zone state alarm;
a24: dl w1 x2+12 ; end;
so w0 16 ; get last formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stackref, w3;
rs w1 x2+c24 ; work.reason := addr of reason;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...17...
al w1 -4 ;
jl. w3 (j3.) ; reserve (4 halfs more);
ds. w3 (j30.) ; save w2, w3;
dl w0 x2+8 ; termzone.first formal :=
ds w0 x2-12 ; zone formal;
al w0 x2 ; w0 :=
ls w0 4 ; sref < 4;
rl. w1 j200. ; w1 := point (termzone);
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save w2, w3;
rl. w1 (j13.) ;
al w1 x1+4 ; unstack
rs. w1 (j13.) ; 4 halfs;
rl w3 x2+8 ; get zone;
al w0 -1 ;
am (x3+h0+6) ; zone.record base :=
wa w0 +2 ; zone.first share.first shared -
rs w0 x3+h3+0 ; 1;
al w0 0 ; zone.rec length :=
rs w0 x3+h3+4 ; 0;
rl w1 x3+h0+6 ; share := zone.first share;
rl w0 x1+4 ; zone.last byte :=
so w0 1 ; share.last shared +
ea. w0 1 ; if even then
rs w0 x3+h3+2 ; 1 else 0;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...18...
a25: rl w0 x1+4 ; repeat
rs w0 x1+10 ; share.operation.last address :=
al w1 x1+h6 ; share.last shared;
sh w1 (x3+h0+8) ; share := share + share descr length;
jl. a25. ; until share > zone.last share;
rl w0 x3+h2+6 ; state := zone.state;
al w1 8 ; newstate := 8;
sz w0 j18 ; if zone.state contains buflength err bit then
al w1 x1+j18 ; newstate := newstate add buflength err bit;
sz w0 j17 ; if zone.state contains inout bit then
al w1 x1+j17 ; newstate := newstate add inout bit;
rs w1 x3+h2+6 ; zone.state := newstate;
; rl w0 x2+c20 ;
; se w0 10 ; if work.operation = disconnect then
; jl. a26. ; begin
; rl w1 x3+h1+16 ;
; sh w1 0 ; if zone.segment count < 1 then
; jl. d2. ; goto index alarm;
a26: rl. w3 (j1.) ; end;
jl x3+e2 ; goto imcdisconn/imccloseprt, segment 0;
i.
e. ; end block imcdisconn/imccloseprt
\f
; fgs 1988.12.15 algol 6, imcprocedures page ...19...
b. a10, b10 ; begin block for imcsethdr, imcgethdr, etc
w.
i9: am 1 ; imcsetmode (z, l, t) : entry := 4;
i8: am 1 ; imcgetstate (z, r ) : entry := 3;
i7: am 1 ; imcsethdr (z, h ) : entry := 2;
i6: am 1 ; imcgethdr (z ) : entry := 1;
i5: al w0 0 ; imcgetchcnt (z ) : entry := 0;
rl. w2 (j13.) ; sref := last used;
ds. w3 (j30.) ; save sref, w3;
rs w0 x2+6 ; first formal1 := entry;
am (x2+8) ;
zl w1 +h1+1 ;
se w1 20 ; if zone.kind <> imc then
jl. d3. ; goto kind alarm;
sl w0 2 ; if imcgetchcnt or imcgethdr then
jl. a0. ; begin <*only zone parameter*>
rl w3 x2+8 ; w1 := if imcgetchcnt then
se w0 0 ; zone.file count <*chars xferred*>
am 2 ; else
rl w1 x3+h1+12 ; zone.block count; <*header*>
jl. a4. ; end
a0: dl w1 x2+12 ; else
so w0 16 ; begin <*also param2*>
jl. w3 (j4.) ; take addr (param2);
ds. w3 (j30.) ;
rl w0 x2+6 ;
sl w0 4 ; if imcsethdr or imcgetstate then
jl. a2. ; begin
se w0 2 ; if entry = imcsethdr then
jl. a1. ; zone.block count :=
rl w3 x2+8 ;
rl w0 x1 ; param2 extract 8;
la. w0 b0. ;
rs w0 x3+h1+14 ;
jl. a4. ; else
a1: rl. w3 j101. ; begin
rl w0 x3+14 ; param2 := answer.disconnect reason;
rs w0 x1 ; w1 := answer.connection state ;
rl w1 x3+12 ; end;
jl. a4. ; end imcsethdr or imcgetstate
\f
; fgs 1988.12.12 algol 6, imcprocedures page ...20...
; else
a2: al w0 0 ; begin <*imcsetmode*>
rs. w0 b2. ; mode := 0;
al w0 7 ; shifts := 7;
hs. w0 b1. ;
a3: rl w1 x1 ; repeat
sl w1 0 ; if param < 0
sl w1 6 ; or param > 5 then
jl. w3 (j29.) ; goto param alarm;
b1=k+1 ; shifts:
ls w1 7 ; param := param shift shifts;
lo. w1 b2. ; mode :=
rs. w1 b2. ; param or mode;
zl. w0 b1. ;
sn w0 0 ; if shifts = 0 then
jl. a5. ; goto finis;
sn w0 7 ; shifts :=
am 4 ; if shifts = 7 then 4
al w0 0 ; else
hs. w0 b1. ; 0;
se w0 4 ; if shifts = 4 then
am 4 ; formal := third param
dl w1 x2+16 ; else
so w0 16 ; formal := fourth param;
jl. w3 (j4.) ; take formal;
ds. w3 (j30.) ;
jl. a3. ; until shifts = 0;
a5: am (x2+8) ; finis:
hs w1 +h1+0 ; zone.mode := mode;
a4: jl. (j6.) ; end <*imcsetmode*>;
; end <*also param2*>;
b0: 2.11111111 ; mask for octet
b2: 0 ; work for mode
m. end imcsethdr, imcgethdr, etc
i.
e. ; end block for imcsethdr, imcgethdr
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...21...
b. a50, b50 ; begin block for name parameter
w.
b5 : 2.11111 ; mask for kind
e5: ds. w3 (j30.) ; entry get name parameter: save sref, w3;
rl w1 x2+8 ; w1 := zone;
ld w0 70 ;
am (x1+h0+4) ; second part of portname
ds w0 +6+14 ; in zone.used share := 0;
rs w0 x2+6 ; first:=0
dl w1 x2+16 ; start checking:
la. w0 b5. ; isolate kind
se w0 24 ; if string variable
sn w0 28 ; or long variable then
jl. a6. ; goto string
se w0 4 ; if long procedure
sn w0 12 ; or long expression then
jl. a0. ; goto take;
se w0 8 ; if not string expression then
jl. a10. ; goto docname in array;
a0: dl w1 x2+16 ; take:
so w0 16 ; pointer:=take formal(name);
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save w2, w3;
al w3 a4 ; <*a4=a0-a7*>
hs. w3 b11. ; continue:=take;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...22...
a6: dl w0 x1 ; string:
sl w0 0 ; text:=double(pointer);
jl. a1. ; if text=point then
hs. w3 b10. ; begin
bz w3 6 ;
ls w3 1 ; w3:=segm*2 + segm table base;
wa. w3 (j16.) ;
rl. w0 (j60.) ;
sh w0 x3-2 ; if segment tab addr >= last of segtable then
jl. d4. ; goto segment alarm;
rl w3 x3 ;
rl w0 x3 ; load first word on text segment;
b10=k+1 ;
al w1 x3+0 ; w1:=text addr ;
al w3 a9 ; <*a9=a6-a7*>
hs. w3 b11. ; continue:=string;
dl w0 x1 ; w3-0:=string portion;
am -8 ; text addr:=text addr-8;
; comment texts on drum are stored backwards;
; end;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...23...
a1: al w1 x1+4 ; text addr:= text addr+4 ; comment
; text protions in longs are stored forward
rx w1 x2+6 ; swop text addr, first;
am (x2+8) ;
am ( +h0+4) ; zone.used share.portname (1) :=
ds w0 x1+6+10 ; string portion;
sz w0 127 ;
se w1 0 ; if last char<>empty and first=0 then
jl. a8. ; begin
al w1 4 ; first:=4; w1:=text addr;
rx w1 x2+6 ;
b11=k+1 ; goto take or string (continue)
a7: jl. a6. ; comment the address here is changed
; by take and string = point;
a8: al w3 a6-a7 ; end;
hs. w3 b11. ; continue:=string;
rl. w3 (j1.) ;
jl x3+e1 ; goto after name param on segment 0;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...24...
a10: rl w1 x2+14 ; docname in array:
la. w1 b5. ; if kind (param) > zone
sh w1 23 ; or kind (param) < boolean array then
sh w1 16 ;
jl. w3 (j29.) ; goto param alarm;
rl w3 x2+16 ;
rl w1 x3 ;
rs. w1 a13. ; save array base;
ba w3 x2+14 ; w3:=dope;
al w1 1 ; if 1<=lower index-k then
sh w1 (x3) ; goto
jl. a15. ; lower field alarm;
rl w1 x3-2 ;
wa. w1 a13. ;
rs. w1 a14. ; save base+upper index
rl w1 x2+8 ; w1:=zone descr addr;
rl. w3 a13. ; w3:=array base;
rs. w2 a13. ; save stack pointer;
al w2 2 ; count:=2;
a11: rl w0 x3+2 ; loop:
am (x1+h0+4) ; move array
am x2 ; to
rs w0 +6+6 ; used share.portname;
sz w0 255 ;
jl. a17. ; until
jl. a12. ; word ends with zero
a17: al w3 x3+2 ; or
sl. w3 (a14.) ; upper index
jl. a16. ; passed;
al w2 x2+2 ; count:=count+2;
sh w2 8 ; max 4 words are moved;
jl. a11. ; goto loop;
a12: rl. w2 a13. ; exit: restore stack pointer;
rl. w3 (j1.) ; ref to first segm.
jl w3 x3+e1 ; goto first segm, after doc param
a4 = a0-a7 ;
a9 = a6-a7 ;
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...25...
a13: 0 ; array base, stack pointer
a14: 0 ; base array+ upper index
a16: am x2 ; upper field alarm: field := count + 2;
a15: al w1 2 ; lower field alarm: field := 2;
jl. w3 (j54.) ; goto field alarm;
m. end imcopenport/imcconnect docname is array
i.
e. ; end block for docname is array
\f
; fgs 1988.12.12 algol 6, imcprocedures page ...26...
b. b20 ; begin block alarms
w.
;b2: <:<10>z.index<0>:> ; index alarm
b3 : <:<10>z.kind<0>:> ; kind alarm
b4 : <:<10>segment<0>:> ; segment alarm
d1: rl. w3 (j1.) ; zone state alarm on segment 0:
jl x3+e11 ; general alarm (<:z.state:>, state);
;d2: am b2-b3 ; connection index alarm:
; ; general alarm (<:z.index:>, index);
e23: ; external entry:
d3 : al. w0 b3. ; zone kind alarm:
jl. w3 (j21.) ; general alarm (<:z.kind:>, kind);
d4: al. w0 b4. ; segment alarm:
al w1 x3 ;
jl. w3 (j21.) ; goto general alarm (<:segment:>, attempted no);
i.
e. ; end block alarms
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...27...
w.
j20:
c.j20-506
m. code on segment 1 too long
z.
m. end code on segment 1
c.502-j20
0, r.252-j20>1 ; fill segment with zeroes
z.
<:imcprocs 1<0>:> ; alarm text segment 1
m. end segment 1
i.
e. ; end block for segment 1
m. rc 1988.12.15
m. imccloseprt imcopenport imcgetconn imcconnect imcdisconn
m. imcgetchcnt imcgethdr imcsethdr imcgetstate imcsetmode
i.
e. ;end of block for slang segment
\f
; fgs 1988.03.01 algol 6, imcprocedures, tails page ...28...
;tail parts
h.
g0: 0 , 2 ; tail imccloseprt : size
0 , r.8 ; name
2049 , i0 ; entry
w. 2<18+21<12+ 8<6 ; spec1 : boolean proc, long addr, zone
0 ; spec2
h. 4 , i12 ; kind, ext list
2 , 8 ; code segments, owns
2048 , 4 ; tail imcopenport : other tail
0 , r.8 ; name
2048 , i1 ; entry
w. 2<18+21<12+41<6+19 ; spec1 : boolean proc, long addr, undef, int addr
8<18 ; spec2 : zone
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcgetconn : other tail
0 , r.8 ; name
2048 , i2 ; entry
w. 2<18+21<12+19<6+8 ; spec1 : boolean proc, long addr, int addr, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcconnect : other tail
0 , r.8 ; name
2048 , i3 ; entry
w. 2<18+21<12+41<6+19 ; spec1 : boolean proc, long addr, undef, int addr
8<18 ; spec2 : zone
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcdisconn : other tail
0 , r.8 ; name
2049 , i4 ; entry
w. 2<18+21<12+ 8<6 ; spec1 : boolean proc, long addr, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
\f
; fgs 1988.03.01 algol 6, imcprocedures page ...29...
2048 , 4 ; tail imcgetchcnt : other tail
0 , r.8 ; name
2049 , i5 ; entry
w. 3<18+ 8<12 ; spec1 : int proc, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcgethdr : other tail
0 , r.8 ; name
2049 , i6 ; entry
w. 3<18+ 8<12 ; spec1 : int proc, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcsethdr : other tail
0 , r.8 ; name
2049 , i7 ; entry
w. 1<18+19<12+ 8<6 ; spec1 : no type proc, int addr, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
2048 , 4 ; tail imcgetstate : other tail
0 , r.8 ; name
2049 , i8 ; entry
w. 3<18+19<12+ 8<6 ; spec1 : no type proc, int addr, zone
0 ; spec2
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
g1: ; last tail:
2048 , 4 ; tail imcsetmode : other tail
0 , r.8 ; name
2049 , i9 ; entry
w. 1<18+19<12+19<6+19 ; spec1 : no type proc, int addr, int -, int -
8<18 ; spec2 : zone
h. 4 , 0 ; kind
2 , 8 ; code segments, owns
d.
p.<:insertproc:>
▶EOF◀