|
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: 30720 (0x7800)
Types: TextFile
Names: »openio3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »openio3tx «
(openinout=slang
openinout closeinout resetzones expellinout)
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ... 1...
b. ; dummy block with fpnames
d.
p.<:fpnames:>
l.
b. g1, i9 ; block for insertproc
w.
i4 = 0 ; segment count := 0;
i5 = 0 ; own byte count := 0;
s. f4, g4 ; slang segment for openinout and resetzones
w.
b. c7, ; block for local names first segment
w.
k=10000 ; k assignment to catch missing relative
h.
c1 : c2 , c3 ; rel last point, rel last absword
c3 = k-2-c1 ; rel last absword
c2 = k-2-c1 ; rel last point
w.
g0 = 3 ; no of externals;
i2 = k - c1 ; start external list:
g0 ; no of externals;
0 ; no of halfs to copy to own core;
<:initzones<0>:> ; external no 1 : name
1<18+25<12+25<6+30 ; spec : no type proc (zone arr, int arr, int arr)
0 ; spec :
<:termzone<0>:>, 0 ; external no 2 : name
15<18 ; spec : illegal type proc
0 ; spec :
<:open<0>:> , 0, 0 ; external no 3 : name
1<18+19<12+41<6+19 ; spec : no type proc (zone, int addr, undef,
8<18 ; spec : int addr );
s3 ; date
s4 ; time
c0 = k - c1 ;
c. c0 - 506
m. code on segment 0 too long
z.
c. 502 - c0
0, r.(:504-c0:) > 1 ; fill with zeroes
z.
<:openinout 0<0>:> ; alarm text
m. segment 0
i.
e. ; end block for local names first segment
i4 = i4 + 1 ; increase segment count
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ... 2...
b. c3, j94 ; block for first segment
w.
k=10000 ; k assignment to catch missing relative
h.
c1 : c2 , c3 ; rel last point, rel last absword
j1 : 1<11o.1, 0 ; segtable address next segment
j4 : g0 + 4, 0 ; rs entry 4, take expression
j8 : g0 + 8, 0 ; - 8, end addr expression
j13: g0 + 13, 0 ; - 13, last used
j18: g0 + 18, 0 ; - 18, zone index alarm
j30: g0 + 30, 0 ; - 30, saved sref, w3
j94: g0 + 94, 0 ; - 94, take value integer
c2 = k-2-c1, c3 = k-2-c1; rel last point, rel last absword
w.
\f
; fgs 1986.10.03 openinout, closeinout, resetzones page ... 3...
b. a13, b20, d4 ; block for local names in openinout
w.
b0 : h5 ; constant, zone descriptor length
b1 : h6 ; - , share -
b2 : 0 ; variable, first zone
b3 : 0 ; - , last -
b4 : 0 ; - , no of shares
b5 : 0 ; - , no of buffers
b6 : 2 ; - , bufunit, default 2
b7 : 0 ; - , buflength
b8 : 0 ; - , top share
b9 : 0 ; - , top buffer
b10: 0 ; - , bufexcess
b11: 0 ; - , current zone
b12: 0 ; - , base area
b13: 0 ; - , last area
b14: 0 ; - , first share
b15: 0 ; - , last share
b16: -1-64 ; constant, mask for removal of buflength error
b17 = 32 ; slang constant, inout in zone state
b18 = 64 ; - - , buflength error in zone state
b19 : 0 ; variable , share descr claim
b20 : 0 ; - , char conv table claim
\f
; fgs 1986.10.04 algol 8, openinout, closeinout, resetzones page... 3...
i8 = i4 ; entry openinout, segment part:
i0 = k - c1 ; entry openinout:
rl. w2 (j13.) ; get last used;
ds. w3 (j30.) ; save sref, w3;
dl w1 x2+12 ; w0w1 := formal (index);
so w0 16 ; if expr then
jl. w3 (j4.) ; take expr;
ds. w3 (j30.) ; save sref, w3;
al w0 3 ;
la w0 x2+11 ; w0 := type (index);
jl. w3 (j94.) ; take value integer;
rs w1 x2+12 ; formal (2) := value (index);
wm. w1 b0. ; index.formal (1) :=
wa w1 x2+8 ; base address zones +
rs w1 x2+10 ; index * zone descr length;
el w0 x2+6 ;
sh w0 1 ; if no of zones < 2 then
jl. w3 d4. ; goto zone number alarm;
rl w1 x2+12 ;
sh w1 (0) ; if index > no of zones
sh w1 0 ; or index <= 0 then
jl. w3 (j18.) ; goto zone index alarm;
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ... 5...
rl w3 x2+8 ; first zone :=
al w3 x3+h5 ; base addr zones +
rs. w3 b2. ; zone descr length;
wm. w0 b0. ; last zone :=
wa w0 x2+8 ; no of zones * zone descr length +
rs. w0 b3. ; base addr zones;
rl. w3 b2. ;
rl w1 x3+h0+8 ; no of shares :=
ws w1 x3+h0+6 ; (last share -
al w0 0 ; first share)//
wd. w1 b1. ; share descr length +
al w1 x1+1 ; 1 ;
rs. w1 b4. ;
as w1 1 ; no of buffers :=
al w1 x1-1 ; no of shares * 2 -
rs. w1 b5. ; 1 ;
al w1 h6 ; top share := share descr claim :=
wm. w1 b4. ; no of shares *
rs. w1 b8. ; share descr length;
el w1 x2+6 ; share descr claims :=
wm. w1 b8. ; no of zones *
rs. w1 b19. ; share descr claim;
el w0 x2+6 ; char conv table claims :=
es. w0 1 ; (no of zones - 1) *
rl w1 x3+h4+2 ; (if first zone.rel entry block proc even then
sz w1 1 ; 0
am h53 ; else
al w1 0 ; h53
wm w1 0 ; );
rs. w1 b20. ;
\f
; fgs 1984.02.22 algol 8, openinout, closeinout, resetzones page ... 5...
rl. w3 b2. ; zone := first zone;
a0: rl w1 x3+h2+6 ; repeat
la. w1 b16. ; state := zone.state except buflength error bit;
se w1 0 ; if state <> 0 and
sn w1 8 ; state <> 8 then
jl. a1. ;
jl. d1. ; goto state alarm;
a1: al w1 x1+b17 ; state := state add inout;
rs w1 x3+h2+6 ; zone.state := state;
rl w1 x3+h0+8 ;
ws w1 x3+h0+6 ; zone.no of shares :=
al w0 0 ; (zone.last share -
wd. w1 b1. ; zone.first share)//
al w1 x1+1 ; share descr length + 1;
se. w1 (b4.) ; if zone.no of shares <> no of shares then
jl. w3 d2. ; goto share alarm;
rl w1 (x3+h0+4) ;
se w1 0 ; if zone.used share.state <> free then
jl. d0. ; goto share state alarm;
al w0 512 ;
el w1 x3+h1+1 ;
se w1 4 ; if zone.kind = 4
sn w1 6 ; or zone.kind = 6 then
rs. w0 b6. ; bufunit := 512;
rl w1 x2+10 ; zone.free param :=
rs w1 x3+h2+2 ; address input zone;
al w0 0 ; zone.partial word :=
al w1 x3 ; (zone address -
ws w1 x2+8 ; base address zones) /
wd. w1 b0. ; zone descr length ;
rs w1 x3+h2+4 ; <*index in zone array*>
al w3 x3+h5 ; zone := zone + zone descr length;
sh. w3 (b3.) ;
jl. a0. ; until zone > last zone;
\f
; fgs 1983.11.18 algol 8, openinout, closeinout, resetzones page ... 6...
rl. w1 b6. ; w1 :=
wm. w1 b5. ; bufunit * no of buffers;
am. (b2.) ; buflength :=
al w0 +h0 ; ((first zone descr start -
ws w0 (0) ; first zone.base buffer -
es. w0 1 ; 1 -
ws. w0 b19. ; share descr claims -
ws. w0 b20. ; char conv table claims) //
al w3 0 ; (bufunit * no of buffers)) *
wd w0 2 ; bufunit;
wm. w0 b6. ;
rs. w0 b7. ;
al w0 h6 ; top buffer :=
wm. w0 b5. ; no of buffers *
rs. w0 b9. ; share descr length;
ws. w0 b8. ; bufexcess :=
rs. w0 b10. ; top buffer - top share;
rl. w0 b7. ; lenght :=
wm. w0 b5. ; buflength * no of buffers;
am. (b2.) ; base area :=
rl w1 +h0 ; first zone.base buffer area;
al w2 x1 ;
wa w2 0 ; last area :=
ds. w2 b13. ; base area + length;
al w2 x2+1 ; first share :=
al w1 x2 ; last area + 1;
wa. w2 b8. ; last share :=
al w2 x2-h6 ; first share + top share -
ds. w2 b15. ; share descr length;
\f
; fgs 1984.10.02 algol 8, openinout, closeinout, resetzones page ... 7...
rl. w3 b2. ; zone := first zone;
a9: ds w2 x3+h0+8 ; repeat
rs w1 x3+h0+4 ; zone.first share := zone.used share :=
dl. w2 b13. ; first share;
ds w2 x3+h0+2 ; zone.last share := last share;
rs w1 x3+h3 ; zone.base buffer := zone.record base := base area;
ws w2 2 ; zone.last buffer := last area;
rs w2 x3+h3+4 ; zone.record length := last area - first area;
wa. w1 b7. ; zone.last halfword := base area +
al w1 x1-2 ; buflength - 2;
rs w1 x3+h3+2 ;
rl w1 x3+h2+6 ; state := zone.state add
al w1 x1+b18 ; buflength error bit;
sn w2 0 ; if length = 0 then
rs w1 x3+h2+6 ; zone.state := state;
al w0 0 ; share := 0;
rs. w3 b11. ; repeat
a10: rl w3 x3+h0+6 ; share addr :=
wa w3 0 ; zone.first share + share;
rl. w1 b12. ;
al w1 x1+1 ; zone.share.top transferred :=
rs w1 x3+22 ; base area + 1;
am. (b11.) ; opmode :=
zl w2 +h1+0 ; 0 shift 12 +
ld w2 37 ; zone.mode extract
ld w2 -37 ; 11;
rs w2 x3+6 ; zone.share.operation := opmode;
rs w1 x3+0 ; zone.share.state := 0;
rl. w3 b11. ;
wa. w0 b1. ; share := share + share descr length;
se. w0 (b8.) ;
jl. a10. ; until share = top share;
dl. w2 b15. ; first share :=
wa. w1 b8. ; first share + top share;
wa. w2 b8. ; last share :=
ds. w2 b15. ; last share + top share;
al w3 x3+h5 ; zone := zone + zone descr length;
sh. w3 (b3.) ;
jl. a9. ; until zone > last zone;
rl. w3 b2. ; first :=
rl w1 x3+h0 ; first zone.base buffer + 1;
al w1 x1+1 ;
al w2 x1-2 ; last :=
wa. w2 b7. ; first + buflength - 2;
\f
; fgs 1983.11.17 algol 8, openinout, closeinout, resetzones page ... 8...
al w0 0 ; share := 0;
; repeat
a2: se w0 0 ; if share = 0 then
jl. a4. ; begin <*common buffer for all zones*>
rl. w3 b2. ; zone := first zone;
a3: am (x3+h0+6) ; repeat
ds w2 +4 ; zone.first share.first shared := first;
am (x3+h0+6) ; zone.first share.last shared := last ;
ds w2 +10 ; zone.first share.first addr := first;
al w3 x3+h5 ; zone.first share.last addr := last ;
sh. w3 (b3.) ; zone := zone + h5;
jl. a3. ; until zone > last zone;
jl. a8. ; end else
a4: sl. w0 (b8.) ; if share <= top share then
jl. a5. ; begin <*buffer belongs to input zone*>
rl. w3 b2. ; zone :=
rl w3 x3+h2+2 ; first zone.free param; <*inp zone addr*>
rl w3 x3+h0+6 ;
am (0) ; zone.share.first shared := first;
ds w2 x3+4 ; zone.share.last shared := last;
am (0) ; zone.share.first addr := first;
ds w2 x3+10 ; zone.share.last addr := last ;
jl. a8. ; end else
a5: rl. w3 b2. ; begin <*buffer common to all outputzones*>
a6: sn w3 (x3+h2+2) ; zone := first zone;
jl. a7. ; repeat
rs. w3 b11. ;
rl w3 x3+h0+6 ; if outputzone then
ws. w0 b10. ; begin
am (0) ; share := share - bufexcess;
ds w2 x3+4 ; zone.share.first shared := first;
am (0) ; zone.share.last shared := last;
ds w2 x3+10 ; zone.share.first addr := first;
wa. w0 b10. ; zone.share.last addr := last;
rl. w3 b11. ;
a7: al w3 x3+h5 ; share := share + bufexcess;
sh. w3 (b3.) ; end;
jl. a6. ; until zone > last zone;
; end <*buffer common*>;
a8: wa. w1 b7. ; first := first + buflength;
wa. w2 b7. ; last := last + buflength;
wa. w0 b1. ; share := share + share descr length;
se. w0 (b9.) ;
jl. a2. ; until share = top buffer;
jl. w3 (j8.) ; goto end expression;
\f
; fgs 1984.02.22 algol 8, openinout, closeinout, resetzones page ... 9...
d4: rx w1 0 ; zone number alarm:
am f3 ;
d2: am f2 ; zone share alarm:
d1: am f1 ; zone state alarm :
d0: al w0 f0 ; share state alarm:
hs. w0 d3. ; set relative entry on next segment;
rl. w3 (j1.) ; w3 := segtable (next segment);
d3 = k + 1 ;
jl x3+0 ; goto next sement + rel;
\f
; fgs 1986.11.03 algol 8, openinout, closeinout, resetzones page ...10...
i.
e. ; end block for local names setzones
c0 = k - c1 ;
c. c0 - 506
m. code on segment 1 too long
z.
c. 502 - c0
0, r.(:504-c0:) > 1 ; fill with zeroes
z.
<:openinout 1<0>:> ; alarm text
m. segment 1
i.
e. ; end block for segment 1
i4 = i4 + 1 ; increase segment count
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ...12...
b. c7, j94, p1, o4 ; block for second segment
w.
k=10000 ; k assignment to catch missing relative
h.
c1 : c2 , c3 ; rel last point, rel last absword
j1 : 2 , c7 ; second - , stop zone, chain for rel
o1 : 0 , 1 ; own variable, first zone
o2 : 0 , 3 ; - , last zone
o3 : 0 , 5 ; - , no of shares
o4 : 0 , 7 ; - , bufsize
i5 = i5 + k - 2 - j1 ; increase own byte count
j3 : g0 + 3, 0 ; rs entry 3, reserve
j4 : g0 + 4, 0 ; - 4, take expression
j8 : g0 + 8, 0 ; - 8, end addr expression
j13: g0 + 13, 0 ; - 13, last used
j18: g0 + 18, 0 ; - 18, zone index alarm
j21: g0 + 21, 0 ; - 21, general alarm
j30: g0 + 30, 0 ; - 30, saved sref, w3
j94: g0 + 94, 0 ; - 94, take value integer
c3 = k-2-c1 ; rel last absword
p0 : 1, 0 ; point 1. external (initzones);
p1 : 3, 0 ; point 3. external (open)
c2 = k-2-c1 ; rel last point
w.
\f
; fgs 1986.10.10 algol 8, openinout, closeinout, resetzones page ...13...
b. a11, b18, d5, e5 ; block for local names in
; closeinout, resetzones, expellinout
w.
b0 : h5 ; constant, zone descriptor length
b1 : h6 ; - , share -
b2 : 0 ; variable, first zone
b3 : 0 ; - , last -
b5 : 0 ; - , no of zones
b6 : h53 ; - , char conv table claim, default h53
b8 : 0 ; - , top share = no of shares * sh descr length
b11: 4<12 + 18 ; constant, first formal integer array
b12: 6<12 + 23 ; - , - - zone
b13: 4<12 + 20 ; - , - long array
b16: -1-64 ; constant, mask fro removal of buflength error
b17 = 32 ; slang constant, inout bit in zone state
b18 = 64 ; - , buflength error bit in zone state
\f
; fgs 1984.08.31 algol 8, openinout, closeinout, resetzones page ...13...
i3 = i4 ; entry.rel segment no := segment count;
;
i1 = k - c1 ; entry closeinout:
am 1 ;
i6 = k - c1 ; entry resetzones:
al w0 0 ; w0 := entry;
rl. w2 (j13.) ; w2 := sref ;
ds. w3 (j30.) ;
hs w0 x2+7 ; save entry in 1.formal.kind;
el w0 x2+6 ; if no of zones < 1 then
sh w0 1 ; goto zone no alarm;
jl. d4. ;
rl w3 x2+8 ; first zone := own1 :=
al w3 x3+h5 ; base addr zones +
rs. w3 (o1.) ; zone descr length;
rs. w3 b2. ;
wm. w0 b0. ; last zone := own2 :=
wa w0 x2+8 ; no of zones *
rs. w0 (o2.) ; zone descr length +
rs. w0 b3. ; base addr zones;
el w0 x2+7 ; w0 := entry;
rl. w3 b2. ; zone := first zone;
a0: rl w1 x3+h2+6 ; repeat
la. w1 b16. ; state := zone.state except buflength error;
se w0 1 ; if entry = resetzones and
sn w1 4 ; state <> 4 then
jl. a2. ; goto state alarm
jl. w3 d1. ; else
a2: sn w0 1 ; if entry = closeinout and
sn w1 b17+0 ; state <> after openinout and
jl. a10. ; state <> after opennout on mt and
se w1 b17+8 ; state <> inoutrec then
sn w1 b17+9 ; goto state alarm;
jl. a10. ;
jl. d1. ;
a10: al w3 x3+h5 ; zone := zone + h5;
sh. w3 (b3.) ;
jl. a0. ; until zone > last zone;
\f
; fgs 1984.02.01 algol 8, openinout, closeinout, resetzones page ...14...
se w0 1 ; if entry = closeinout then
jl. a7. ; begin <*stop all zones*>
dl w1 x2+8 ;
ds. w1 (o4.) ; save 1. formal in own3, own4;
rl. w1 b3. ;
rs w1 x2+8 ; 1. formal (2) := last zone;
a4: rl. w1 (o4.) ; while base address zones < 1. formal (2) do
sl w1 (x2+8) ; begin <*stop the zone*>
jl. a5. ;
rl. w3 (j1.) ; w3 := absword (stop zone);
c7 = k + 1 - c1 ; chain for rel stops here ;
jl w3 x3+0 ; stop zone stacks return point;
rl w1 x2+8 ; 1. formal (2) :=
al w1 x1-h5 ; 1. formal (2) -
rs w1 x2+8 ; zone descr length;
jl. a4. ; end while;
a5: dl. w1 (o4.) ; restore 1. formal from own3, own4;
ds w1 x2+8 ;
dl. w1 (o2.) ; restore first, last zone from own1, own2;
ds. w1 b3. ;
al w0 4 ;
rl. w3 b2. ; zone := first zone;
a6: rs w0 x3+h2+6 ; repeat
al w3 x3+h5 ; zone.state := 4;
sh. w3 (b3.) ; zone := zone + h5;
jl. a6. ; until zone > last zone;
a7: rl. w3 b2. ; end <*stop all zones*>;
el w0 x2+6 ;
rs. w0 b5. ; no of zones := first half 1.formal (1);
rl w1 x3+h4+2 ;
al w0 0 ; if first zone.rel entry block proc
so w1 1 ; even <*zone init by algol rts version 1*> then
rs. w0 b6. ; char conv table claim := 0;
rl w1 x3+h0+8 ; no of shares :=
ws w1 x3+h0+6 ; (last share -
wd. w1 b1. ; first share) //
al w1 x1+1 ; share descr length +
rs. w1 (o3.) ; 1 ;
wm. w1 b1. ; share descr claim :=
wm. w1 b5. ; no of zones *
rs. w1 b8. ; no of shares * share descr length;
rl. w1 b5. ;
al w1 x1-1 ; buflength :=
wm. w1 b6. ; (- (no of zones - 1) * char conv claim
wa. w1 b8. ; - share descr claim
wa w1 x3+h0+0 ; - first zone.base buffer area
al w1 x1+1 ; - 1
ac w1 x1 ;
wa. w1 b2. ; + first zone
al w1 x1+h0+0 ; + relative to start of descr ) //
wd. w1 b5. ; no of zones //
as w1 -2 ; 4;
rs. w1 (o4.) ;
\f
; fgs 1986.10.10 algol 8 openinout, closeinout, resetzones page ...16...
rl. w1 b5. ; appetite :=
as w1 2 ; no of zones * 4 +
al w1 x1+34 ; 34;
ac w1 x1 ;
jl. w3 (j3.) ; reserve (appetite);
ds. w3 (j30.) ;
dl w0 x2+8 ; move (formal (zone array)) to
ds w0 x1+8 ; new stack top;
rl. w3 b11. ; third formal :=
al w0 x1+20 ; (4<12 + 18,
ds w0 x1+12 ; abs addr baseword (bufsize));
al w0 x1+28 ; fourth formal :=
ds w0 x1+16 ; (4<12 + 18,
; abs addr baseword (shares));
el w3 x2+6 ; dope (bufsize) :=
as w3 1 ; dope (shares ) :=
al w0 0 ; (2 * no of zones,
ds w0 x1+24 ; 0 );
ds w0 x1+32 ;
al w0 x1+32 ; baseword (bufsize) :=
rs w0 x1+20 ; x1+32;
wa w0 6 ; baseword (shares ) :=
rs w0 x1+28 ; x1+32+2 * no of zones;
\f
; fgs 1986.10.06 algol 8, openinout, closeinout, resetzonespage ...17...
; initialize bufsize and shares arrays:
al w1 x1+32 ; base := w1 + 32;
el w3 x2+6 ; increment := w3 :=
as w3 1 ; no of zones *
rs. w3 b5. ; 2;
wa w3 2 ; last := base + increment;
rl. w0 (o4.) ; w0 := bufsize;
a1: al w1 x1+2 ; rep: base := base + 2;
rs w0 x1 ; word (base) := w0;
se w1 x3 ; if base < last then
jl. a1. ; goto rep;
wa. w3 b5. ; last := last + increment;
al w0 0 ;
rx. w0 (o3.) ; swop (w0, no of shares);
se w0 0 ; if w0 <> 0 then
jl. a1. ; goto rep;
rl. w1 (j13.) ; the six halfs are
al w1 x1+6 ; stacked by
rs. w1 (j13.) ; by take expression;
al w0 x2 ;
ls w0 4 ; w0 := sref<4 + 0;
rl. w1 p0. ; w3 := point (initzones);
jl. w3 (j4.) ; take expression (point);
ds. w3 (j30.) ; save sref, w3;
rs. w2 (j13.) ; unstack reserved core;
\f
; fgs 1986.10.10 algol 8, openinout, closeinout, resetzones page ...18...
el w0 x2+7 ;
se w0 1 ; if entry = closeinout then
jl. a9. ; begin <*reopen all zones*>
a8: al w1 -32 ; repeat
jl. w3 (j3.) ; reserve (32 hwds);
ds. w3 (j30.) ; saved sref, w3 := w2, w3;
rl. w1 (o1.) ; zone := saved zone;
rl. w0 b12. ;
ds w1 x2-29 ; 1. param := zone;
al w3 26 ;
rl w0 x1+h1+0 ; modekind :=
ls w0 1 ; zone.modekind extract
ls w0 -1 ; 23;
rs w0 x2-15 ; literal (modekind) :=
al w0 x2-15 ; modekind;
ds w0 x2-25 ; 2. param := literal (modekind);
rl. w3 b13. ;
al w0 x2-13 ;
ds w0 x2-21 ; 3. param := long array (zone.name);
dl w0 x1+h1+4 ; move name from
ds w0 x2-5 ; zone.docname
dl w0 x1+h1+8 ; to
ds w0 x2-1 ; literal locations;
al w0 x2-9 ; baseword :=
rs w0 x2-13 ; addr literal locations;
al w3 16 ; <*upper *>
al w0 0 ; <*lower - k*>
ds w0 x2-9 ; dope vector := ( upper, lower - k);
al w3 26 ;
al w0 x1+h2+1 ;
ds w0 x2-17 ; 4. param := give up mask;
al w0 x2 ;
ls w0 4 ; w0 := sref < 4 + 0;
rl. w1 p1. ; w1 := point (open);
jl. w3 (j4.) ; take expression (point);
ds. w3 (j30.) ; save sref, w3;
rs. w2 (j13.) ; unstack reserved core;
rl. w1 (o1.) ; zone := saved zone;
al w1 x1+h5 ; zone := zone + zone descr length;
rs. w1 (o1.) ; saved zone := zone;
rl. w0 (o2.) ;
sh w1 (0) ; until
jl. a8. ; zone > last zone;
a9: ; end <*reopen all zones*>;
jl. w3 (j8.) ; goto end addr expression;
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ...19...
i7 = k - c1 ; entry expellinout:
rl. w2 (j13.) ; get last used;
ds. w3 (j30.) ; save sref, w3;
dl w1 x2+12 ; w0w1 := formal (index);
so w0 16 ; if expression then
jl. w3 (j4.) ; goto take expression;
ds. w3 (j30.) ; save sref, w3;
al w0 3 ;
la w0 x2+11 ; w0 := type (index);
jl. w3 (j94.) ; take value integer;
rs w1 x2+12 ; formal (2) := value (index);
wm. w1 b0. ; index.formal (1) :=
wa w1 x2+8 ; base address zones +
rs w1 x2+10 ; index * zone descr length;
el w0 x2+6 ;
rl w1 x2+12 ;
sh w1 (0) ; if index > no of zones
sh w1 0 ; or index <= 0 then
jl. w3 (j18.) ; goto zone index alarm;
rl w3 x2+10 ; zone := index.formal (1);
rl w1 x3+h2+6 ; state := zone.state;
se w1 b17+0 ; if state <> after openinout and
sn w1 b17+8 ; state <> after openinout on mt then
jl. a11. ; goto zone state alarm;
jl. d1. ;
a11: se w3 (x3+h2+2) ; if zone <> inputzone then
rs w3 x3+h2+4 ; zone.partial word := zone;
jl. w3 (j8.) ; goro end address expression;
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ...20...
e0: <:<10>s.state :> ;
e1: <:<10>z.state :> ;
e2: <:<10>z.shares :> ;
e4: <:<10>z.zones :> ;
d4: rx w1 0 ; zone number alarm:
d3: am e4.-e2. ; zone number alarm (number in w1):
d2: am e2.-e1. ; zone share alarm:
d1: am e1.-e0. ; zone state alarm:
d0: al. w0 e0. ; share state alarm:
jl. w3 (j21.) ; goto general alarm (text addr, number);
f3 = d3 - d2 ; rel entry zone number alarm (number in w1)
f2 = d2 - d1 ; - - - shares -
f1 = d1 - d0 ; - - - state -
f0 = d0 - c1 ; - - share - -
\f
; fgs 2186.10.03 algol 8, openinout, closeinout, resetzones page ...19...
i.
e. ; end block for local names resetzones
c0 = k - c1 ;
c. c0 - 506
m. code on segment 2 too long
z.
c. 502 - c0
0, r.(:504-c0:) > 1 ; fill with zeroes
z.
<:openinout 2<0>:> ; alarm text
m. segment 2
i.
e. ; end block for segment 2
i4 = i4 + 1 ; increase segment count
i.
e. ; end slang segment
\f
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ...22...
; tails for insertproc
h.
g0: 0 , i4 ; tail openinout: size
0 , r.8 ; name
1<11+i8, i0 ; entry
w. 1<18+13<12+30<6 ; no type proc, zone array, integer value
0 ;
h. 4 , i2 ; kind, external list
i4 , i5 ; code segments, own bytes
2048 , 4 ; tail closeinout: size
0 , r.8 ; name
1<11+i3, i1 ; entry point
w. 1<18+30<12 ; no type proc (zone array)
0 ;
h. 4 , i2 ; kind, start external list
i4 , i5 ; code segments, own bytes
2048 , 4 ; resetzones: size
0 , r.8 ; docname
1<11+i3, i6 ; entry point
w. 1<18+30<12 ; no type proc, zone array
0 ;
h. 4 , i2 ; kind, start external list
i4 , i5 ; code segments, own bytes
g1: ; last tail:
2048 , 4 ; expellinout: size
0 , r.8 ; docname
1<11+i3, i7 ; entry point
w. 1<18+13<12+30<6 ; no type proc (zone array, integer value)
0 ;
h. 4 , i2 ; kind, start external list
i4 , i5 ; code segments, own bytes
m. rc 1986.10.10 openinout closeinout, resetzones, expellinout
i.
d.
p.<:insertproc:>
l.
i.
e. ; end outer block
finis
▶EOF◀