|
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: »ldprocs4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ldprocs4tx «
<* ! ! ! ! ! ! !*>
; fgs 1988.06.13 algol 6, lan device procedures page ...1...
b. ; block for fpnames
d.
p.<:fpnames:> ; fpnames
l.
b. g1, i12 ; block for tail parts
w.
s. c50, e30 ; slang segment
w.
c6 = + 1 ; boolean ADP SW REL 6.0 (-1 = no, 1 = yes)
c25 = -18 ; size of reserved work area in stack :
c24 = c25 + 0 ; 10 hwds, devname + name table address
c23 = c24 + 10 ; 2 hwds, 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.06.13 algol 6, lan device procedures page ...2...
b. d10, j300 ; block for first segment
w.
k=0
h.
c0 = 0 ; 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
j104: c0 + 104 , 0 ; rs own prodess descr addr
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
s3 , s4 ; date, time
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...3...
b. a50, b50 ; block for entry lan device procedures
w.
i2: am 4 ; ldunlink: op := 10;
i1: al w0 6 ; ld__link: op := 6;
rl. w2 (j13.) ; get last used;
ds. w3 (j30.) ; save sref, w3;
al w1 c25 ;
jl. w3 (j3.) ; reserve (c25 halfs);
rs w0 x2+c20 ; work.operation := op;
rl w3 x2+8 ; zone := first formal.2;
rl w1 x3+h2+6 ;
se w1 0 ; if zone.state <> 0 then
jl. d1. ; goto zonestate error;
dl w1 x2+12 ;
so w0 16 ; get second formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
rs w1 x2+12 ; second formal2 := addr value devno;
rl w1 x1 ; devno:= value second actual;
rl w0 x2+c20 ;
se w0 10 ; if devno <=
am -1 ; (if ldlink then -2
sh w1 -1 ; else -1) then
jl. d2. ; goto devno alarm;
al w0 0 ; first :=
rs w0 x2+6 ; 0;
rl. w3 (j201.) ; get devname param:
jl x3+e5 ; goto get name param on segment 1;
e0: ds. w3 (j30.) ; return from segment 1 after get name:
rl w0 x2+c20 ; last formal :=
se w0 10 ; if ldlink then
am 8 ; 5. formal
dl w1 x2+20 ; else 3. formal;
so w0 16 ; get last formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save stackref, w3;
rs w1 x2+10 ; sec. formal1 := addr of reason;
rl w1 x1 ; work.wanted :=
rs w1 x2+c23 ; value of reason;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...4...
rl w0 x2+c20 ;
sn w0 10 ; if operation = ldunlink then
jl. e2. ; goto ldunlink;
dl w1 x2+20 ;
so w0 16 ; get fourth formal;
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
rl w1 x1 ; devtype:= value fourth actual;
sl w1 1 ; if devtype < 1
sl w1 10 ; or devtype > 9 then
jl. d3. ; goto devtype alarm;
rs w1 x2+20 ; fourth formal2 := devtype;
se w1 5 ; if devtype = 5 <*3270 output*> then
jl. a0. ; devindex :=
am (x2+8) ; zone.
rl w0 +h2+2 ; free param;
jl. a1. ; else
a0: al w0 255 ; devindex := 255
a1: rx w1 0 ; swop (w0, w1);
am (x2+8 ) ;
am ( +h0+4) ; zone.used share (+2, +4) :=
ds w1 +6+4 ; (devtype, devindex);
c. -1 ; if false then include
se w0 1 ; if devtype = 1 <*csp terminal*>
sn w0 8 ; or devtype = 8 <*csp printer *> then
jl. a2. ; begin
jl. a7. ;
z. ; end include;
; begin
a2: al w1 8 ; first :=
rs w1 x2+6 ; 8;
rl. w3 (j201.) ; goto get cspname param on segment 1;
jl x3+e5 ; end;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...5...
e1: ds. w3 (j30.) ; return from segment 1 after cspname;
a7: rl w0 x2+c20 ; operation := work.operation;
am (x2+8) ;
zl w1 +h1+0 ; opmode :=
ls w1 13 ; operation < 12 +
ls w1 -1 ; zone.mode extract
ld w1 12 ; 11;
rl w1 (x2+12) ; index :=value of devno;
rl w2 x2+8 ; w2 := zone;
jl. w3 a22. ; execute operation; <*ldlink *>
se w0 0 ; if status <> 0 then
jl. a11. ; goto return_false_normal;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...6...
rl w3 x1+2 ; second actual :=
rs w3 (x2+12) ; answer.rc8000devno;
al w0 0 ;
rl w1 x1+8 ; devix := answer.device index;
ds w1 (x2+10) ; reason := (0, devix);
rl w0 x2+20 ;
se w0 4 ; if devtype = 4 <*3270 input*> then
jl. a8. ; zone.free param :=
am (x2+8) ; devix;
rs w1 +h2+2 ;
a8: al w3 x2+c24 ; w3 := addr work.devname;
rl w0 x3 ;
sn w0 0 ; if devname (1) <> 0 then
jd 1<11+68 ; generate wrk-name (work.devname);
rl w1 (x2+12) ; w1 := devno;
jd 1<11+54 ; create peripheral process (w1, w3);
sn w0 0 ; if result <> 0 then
jl. a9. ; begin <*ldunlink*>
hs. w0 b1. ; result := w0;
rl w2 x2+8 ; w2 := zone;
am (x2+h0+4) ; zone.share.mess area (2) :=
rs w1 +6+2 ; devno;
al w1 0 ; index := 0;
al w0 10 ; opmode :=
ls w0 12 ; ldunlink <12 +
jl. w3 a22. ; execute operation;
al w1 -1 ; w1 := -1 < 12 +
ls w1 12 ;
b1 = k + 1 ; result:
al w1 x1+0 ; result;
al w0 x1 ; w0 := w1;
jl. a12. ; goto return_false_dummy;
; end <*ldunlink*>;
a9: rl w1 x2+20 ;
rl. w3 (j201.) ;
se w1 2 ; if devtype <> 2 <*not imc porthandler*> then
jl x3+e7 ; goto return devname on segment 1;
al w3 x2+c24 ;
jd 1<11+6 ; initialize process (work.devname);
rl w1 x2+8 ; zone.state :=
al w0 x2+c24 ; addr work.devname;
rs w0 x1+h2+6 ; <*supposed to be zero, must be restored*>
jl. a24. ; goto allocate descriptors and sense;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...7...
e2: ; ldunlink :
al w3 x2+c24 ;
rl w0 x3 ;
sn w0 0 ; if devname (1) <> 0 then
jl. a6. ; begin <*find devno*>
jd 1<11+4 ; get proc descr addr;
sn w0 0 ; if not found then
jl. a6. ; goto not found;
rl w1 74 ; index := first dev in nametable;
a3: sn w0 (x1) ; while proc descr addr <> nametable (index) do
jl. a4. ; begin
al w1 x1+2 ; index := index + 2;
se w1 (76) ; if index = first area in nametable then
jl. a3. ; goto not found;
jl. a6. ; end;
a4: ws w1 74 ; devno :=
ls w1 -1 ; (index - first dev in nametable) / 2;
rs w1 (x2+12) ; 2.actual := devno;
a5: rl w0 x2+c20 ; send:
ls w0 12 ; opmode := operation < 12 + 0;
rl w2 x2+8 ;
am (x2+h0+4) ; zone.used share.mess (+2) :=
rs w1 +6+2 ; devno;
al w1 0 ; index := 0;
jl. w3 a22. ; execute operation;
rl. w3 (j201.) ;
jl x3+e8 ; goto finish ldunlink on segment 1;
; end <*find devno*>;
a6: rl w1 (x2+12) ; devno := value second actual;
jl. a5. ; goto send;
m. end ldunlink
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...8...
c. c6 ; if ADP SW REL 6.0 then
; include
; procedure allocate descriptors and sense :
;
; call : return :
;
; w0 - -
; w1 - address answer area
; w2 sref sref
; w3 link -
;
b. a1, b1 ; begin block allocate descriptors
w. ;
a24: rl w1 x2+c23 ; entry:
sl w1 1 ; no_of_descriptors := value of reason; <*wanted*>
jl. a1. ; if no of decriptors <= 0 then
am. (j104.) ; no_of_descriptors :=
zl w1 +26 ; own proc descr.buffer claim;
a1: rs w1 x2+c23 ; wanted := no_of_descriptors;
al w0 20 ; opmode :=
ls w0 12 ; allocate < 12 + 0;
rl w2 x2+8 ; w2 := zone address;
jl. w3 a22. ; execute operation; <*allocate descriptors*>
ld w1 70 ; operation := index := 0; <*sense*>
rl w2 x2+8 ; w2 := zone;
jl. w3 a22. ; execute operation;
rl. w3 (j201.) ;
jl x3+e6 ; goto finish ldlink on segment 1;
i.
e. ; end block allocate descriptors;
z. ; end include ADP SW REL 6.0
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...9...
c. -c6 ; if not ADP SW REL 6.0 then
; include
; procedure allocate descriptors :
;
; call : return :
;
; w0 - -
; w1 - address answer area
; w2 sref sref
; w3 link -
;
b. a1, b1 ; begin block allocate descriptors
w. ;
b0: 768 ; constant, bufsize;
a24: rl w1 x2+c23 ; entry:
sl w1 1 ; no_of_descriptors := value of reason; <*wanted*>
jl. a1. ; if no of decriptors <= 0 then
rl. w1 (j104.) ; no_of_descriptors :=
zl w1 x1+26 ; own proc descr.buffer claim;
a1: rs w1 x2+c23 ; wanted := no_of_descriptors;
al w0 20 ; repeat <*work.wanted*>
ls w0 12 ; opmode := allocate < 12 + 0;
rl w2 x2+8 ; w2 := zone address;
rl. w3 b0. ; zone.used share.mess.+8 :=
am (x2+h0+4) ; 768; <*size*>
rs w3 +6+8 ;
jl. w3 a22. ; execute operation; <*allocate descriptors*>
rl. w3 (j201.) ;
jl x3+e6 ; goto finish ldlink on segment 1;
i.
e. ; end block allocate descriptors;
z. ; end include not ADP SW REL 6.0
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...10...
; procedure execute operation
;
; call : return :
;
; w0 operation<12+mode status (i.e. normal answer)
; w1 index answer area
; w2 zone last used (= call sref)
; w3 link link
;
b. a5, 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, lan device procedures page ...11...
a1: rs. w3 b2. ; send operation: save return;
rl w3 x2+h0+4 ; share := zone.used share;
rs w0 x3+6 ; share.op := op < 12 + mode;
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 ; w1 := share.mess area;
rl w3 x2+h2+6 ; w3 := zone.state; <*maybe address work.devname*>
sn w3 0 ; if w3 = 0 then
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.06.13 algol 6, lan device procedures page ...12...
e11: ; external entry:
a11: ls w0 4 ; return_false_normal: <*w0 = status <> 0*>
ba. w0 1 ; w0 := status < 4 + 1;
e12: ; external entry:
a12: dl. w3 (j30.) ; return_false_dummy:
ld w0 24 ; (w3, w0) := (w0, 0);
ds w0 (x2+10) ; reason := (w3, w0);
e14: ; external entry:
a14: am -1 ; return_false: return := false;
e13: ; external entry:
a13: al w1 1 ; return true : return := true ;
al w0 0 ;
am (x2+8) ; zone.state :=
rs w0 +h2+6 ; 0;
rs. w2 (j13.) ; w2 := saved sref; unstack reserved memory;
jl. (j6.) ; goto end reg. expression;
m. end ldlink /ldunlink
i.
e.;end block for ldlink /ldunlink
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...13...
c. -1 ; if false then
; include
b. b20 ; begin block alarms
w.
b1 : <:<10>z.state<0>:> ; state alarm text
b2 : <:<10>devno<0>:> ; devno alarm text
b3 : <:<10>devtype<0>:> ; devtype alarm text
d1 : am b1-b2 ; zone state alarm:
d2 : am b2-b3 ; devno alarm:
d3: al. w0 b3. ; devtype alarm:
jl. w3 (j21.) ; general alarm (<:text:> , param);
i.
e. ; end block alarms
z. ; end include
b. b20 ; begin block alarms
w.
d1 : am e21 ; zone state alarm:
d2 : am e22 ; devno alarm:
d3: al w0 e23 ; devtype alarm:
rl. w3 (j201.) ;
hs. w0 b11. ; rel := rel entry on segment 1;
b11=k+1 ; rel:
jl x3+0 ; goto rel on segment 1;
i.
e. ; end block alarms
\f
; fgs 1988.06.13 algol 6, lan device procedures 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.
<:ldprocs 0<0>:> ; alarm text segment 1
m. end segment 0
i.
e.;end block for segment 0
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...15...
b. d10, j200 ; begin block for segment 1
w.
k=0
h.
c10 : c11 , c12 ; rel last point, rel last absword
j4 : c0 + 4 , 0 ; rs entry 4 : take 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
j104 : c0 +104 , 0 ; rs entry 104 : own process description address
j200 : 1<11 o. (:-1:), 0 ; ref to segment 0
c12 = k-2 - c10 ; rel of last absword
c11 = k-2 - c10 ; rel of last point
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...16...
b. a50, b50 ; begin block for name parameter
w.
c. -c6 ; in not ADP release 6.0 then
; include
b3: 1 < 12 + 1 ; streamer : kind < 12 + type
b4: 2 < 12 + 4 ; others : kind < 12 + type
z. ; end include;
b5 : 2.11111 ; mask for kind
e5: ds. w3 (j30.) ; entry get name parameter:
rl w1 x2+6 ; save sref, w3;
sl w1 8 ; if first < 8 then
jl. a2. ; begin <*devname*>
ld w0 70 ;
ds w0 x2+c24+2 ; fst. part of work.devname := 0;
ds w0 x2+c24+6 ; sec. part of work.devname := 0;
jl. a3. ; end else
a2: rl w1 x2+8 ; begin <*cspname*>
c. -c6 ; if not ADP release 6.0 then
; include
se w0 1 ; if devtype = 1
sn w0 8 ; or devtype = 8 then
jl. a5. ; goto csp;
sn w0 9 ; if devtype = 9 <*streamer*> then
am b3-b4 ; kind_type := 1<12+1
rl. w3 b4. ; else
al w0 0 ; kind_type := 2<12+4;
am (x1+h0+4) ;
ds w0 +6+10 ; zone.share.mess (+8, +10) := (kind_type, 0);
ld w0 70 ; zone.share.mess (+12, +14) :=
am (x1+h0+4) ; (0, 0);
ds w0 +6+14 ;
rl w1 x2+6 ; w1 := first;
jl. a8. ; goto return;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...17...
a5: ; csp:
z. ; end include;
ld w0 70 ; zone.share.mess (+ 8, +10) :=
am (x1+h0+4) ; (0, 0);
ds w0 +6+10 ; <*mess area.csp name area*>
; zone.share.mess (+12, +14) :=
am (x1+h0+4) ; (0, 0);
ds w0 +6+14 ; <*mess area.csp name area*>
a3: am (x2+6) ; end;
dl w1 x2+16 ; get 3. formal or 5. formal;
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: rl w1 x2+6 ; take:
sl w1 8 ; if first >= 8 then
am 8 ; formal := 5. formal
dl w1 x2+16 ; else formal := 3. formal;
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.06.13 algol 6, lan device procedures page ...18...
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.06.13 algol 6, lan device procedures page ...19...
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;
sl w1 8 ; if first < 8 then
jl. a20. ; begin <*devname*>
am x1 ; work.devname (1:2) :=
ds w0 x2+c24+2 ; string portion;
jl. a21. ; end else
a20: am (x2+8) ; begin <*cspname*>
am ( +h0+4) ; zone.used share.cspname (1:2) :=
ds w0 x1+6+10-8 ; string portion;
a21: ; end;
se w1 4 ; if first <> 4 and
sn w1 12 ; first <> 12 and
jl. a8. ;
sz w0 127 ; last char <> empty then
jl. a22. ;
jl. a8. ;
a22: ; begin
al w1 x1+4 ; first := first + 4; w1 := text addr;
rx w1 x2+6 ; goto take or string (continue)
b11=k+1 ; comment the address here is changed
a7: jl. a6. ; by take and string = point;
a8: rs w1 x2+6 ; end;
al w3 a6-a7 ; first := w1;
hs. w3 b11. ; continue:=string;
rl. w3 (j200.) ; if first < 8 then
sl w1 8 ; return to after devname
am e1-e0 ; else
jl x3+ e0 ; return to after cspname;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...20...
a10: am (x2+6) ; docname in array:
rl w1 x2+14 ; get 3. formal1 or 5. formal1;
la. w1 b5. ; if kind (param) > zone
sh w1 23 ; or kind (param) < boolean array then
sh w1 16 ;
jl. w3 (j29.) ; goto rs29, param alarm;
am (x2+6) ; get 3. formal2 or 5. formal2;
rl w3 x2+16 ;
rl w1 x3 ;
rs. w1 a13. ; save array base;
am (x2+6) ; get 3. formal1 or 5. formal1;
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. w3 a13. ; w3:=array base;
rs. w2 a13. ; save sref;
al w2 2 ; count:=2;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...21...
a11: rl w0 x3+2 ; loop:
am. (a13.) ;
rl w1 +6 ;
sl w1 8 ; if first < 8 then
jl. a23. ; begin <*devname*>
am. (a13.) ; move array to
am x2 ;
rs w0 +c24-2 ; work.devname;
jl. a24. ; end else
a23: am. (a13.) ; begin <*cspname*>
rl w1 +8 ;
am (x1+h0+4) ; move array
am x2 ; to
rs w0 +6+6 ; used share.cspname;
a24: sz w0 255 ; end;
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 (j200.) ; ref to first segm.
rl w1 x2+6 ; if first < 8 then
sl w1 8 ; return to after devname
am e1-e0 ; else
jl x3+ e0 ; return to after cspname;
a4 = a0-a7 ;
a9 = a6-a7 ;
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...22...
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 ldlink /ldunlink docname is array
i.
e. ; end block for docname is array
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...23...
b. a20, b20 ; begin block finish ldlink
w.
e6: ds. w3 (j30.) ; entry from segment 0: save sref, w3;
rl w3 x2+c23 ; wanted := work.wanted; <*= reason at call*>
c. c6 ; if ADP release 6.0 then
; include
rl w0 x1+10 ; got := answer.unused descriptors;
z. ; end include
c. -c6 ; if not ADP release 6.0 then
; include
rl w0 x1+6 ; got := answer.buffers total ;
z. ; end include
;***************************************************************************
; sl w0 x3 ; if got < wanted then
; jl. a1. ; begin
; rl. w0 b1. ; w0 := 11 < 12 + 1; <*status < 12 + result*>
; rl. w3 (j200.) ; goto return_false_dummy on segment 0;
; jl x3+e12 ; end;
;***************************************************************************
c. c6 ; if ADP release 6.0 then
; include
a1: rl w3 x1+4 ; size := answer area.maxsendsize;
z. ; end include
c. -c6 ; if not ADP release 6.0 then
; include
a1: rl w3 x1+8 ; size := answer area.actual size;
z. ; end include
ls w0 16 ; w3 := reason.left word :=
ld w0 8 ; size < 8 + got;
rl w0 (x2+10) ; w0 := reason.right word :=
ds w0 (x2+10) ; device index;
al w3 x2+c24 ; w3 := work.devname;
jd 1<11+10 ; release process (zone.docname);
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...24...
e7: ; return devname: (entry from segment 0)
al w0 2.11111 ;
la w0 x2+14 ;
sl w0 17 ; if third formal1 < boolean array
sl w0 24 ; or third formal1 > zone then
jl. a2. ; goto skip;
rl w3 (x2+16) ; w3 := devname array base addr;
rl w0 x3+2 ;
se w0 0 ; if first word devname array = 0 then
jl. a2. ; begin
dl w1 x2+c24+2 ; move
ds w1 x3+4 ; work.devname (1:4)
dl w1 x2+c24+6 ; to
ds w1 x3+8 ; devname array (1:4);
a2: ; end;
rl. w3 (j200.) ; goto return_true on segment 0;
jl x3+e13 ; end;
b1: 11<12+1 ; constant, all descriptors in use + normal
i.
e. ; end block finish ldlink
b. a8 ; begin block finish ldunlink
w.
e8: ds. w3 (j30.) ; finish ldunlink: save sref, w3;
rl. w3 (j200.) ; w3 := segment 0;
se w0 0 ; if status <> 0 then
jl x3+e11 ; goto return_false_normal
al w3 1 ; reason :=
ds w0 (x2+10) ; (0 < 12 + 1, 0);
rl. w3 (j200.) ; w3 := segment 0;
jl x3+e13 ; goto return true;
e. ; end block finish ldunlink
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...25...
b. b20 ; begin block alarms
w.
b1 : <:<10>z.state<0>:> ; state alarm text
b2 : <:<10>devno<0>:> ; devno alarm text
b3 : <:<10>devtype<0>:> ; devtype alarm text
b4 : <:<10>segment<0>:> ; segment alarm
d1 : am b1-b2 ; zone state alarm:
d2 : am b2-b3 ; devno alarm:
d3: al. w0 b3. ; devtype alarm:
jl. w3 (j21.) ; general alarm (<:text:> , param);
d4: al. w0 b4. ; segment alarm:
al w1 x3 ; goto general alarm
jl. w3 (j21.) ; (<:segment:>, attempted no);
e21 = d1 - d2, e22 = d2 - d3, e23 = d3 ; external entries to d1, d2, d3
i.
e. ; end block alarms
\f
; fgs 1988.06.13 algol 6, lan device procedures page ...26...
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.
<:ldprocs 1<0>:> ; alarm text segment 1
m. end segment 1
i.
e. ; end block for segment 1
m. rc 1988.07.27
m. ldlink ldunlink
i.
e. ;end of block for slang segment
\f
; fgs 1988.06.13 algol 6, lan device procedures, tails page ...27...
;tail parts
h.
g0: 0 , 2 ; tail ldlink : size
0 , r.8 ; name
2048 , i1 ; entry
w. 2<18+21<12+41<6+19 ; spec1 : boolean proc, long addr, undef, int addr
41<18+19<12+ 8<6 ; spec2 : undef , int addr, zone
h. 4 , i12 ; kind, ext list
2 , 8 ; code segments, owns
g1: 2048 , 4 ; tail ldunlink: other tail
0 , r.8 ; name
2048 , i2 ; 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
w. ;
d.
p.<:insertproc:>
e. ; end block fpnames
▶EOF◀