DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦f0435e7bd⟧ TextFile

    Length: 29184 (0x7200)
    Types: TextFile
    Names: »openiotx    «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »openiotx    « 

TextFile

(openinout=slang
 openinout closeinout resetzones expellinout)

; fgs 1984.10.02  algol 8, openinout, closeinout, resetzones  page ... 1...

b.                      ; dummy block with fpnames

d.
p.<:fpnames:>
l.

b. g1, i7               ; block for insertproc
w.

i4 = 0                  ; segment  count := 0;
i5 = 0                  ; own byte count := 0;

s. f4, g4               ; slang segment for setzones and resetzones
w.

b. c3, j94              ; block for first segment
w.

g0 = 2                  ; no of externals

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.

i2 = k - c1             ; start external list:
              g0        ;   no of externals
               0        ;   no of bytes to copy

<: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 :

              s3        ; date
              s4        ; time

\f



; fgs 1984.02.01  openinout, closeinout, resetzones      page ... 2...



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 1983.11.18  algol 8, openinout, closeinout, resetzones   page... 3...


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+9      ;   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 1983.12.07  algol 8, openinout, closeinout, resetzones  page ... 4...


      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 1983.11.18  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 0<0>:>      ; alarm text

m. segment 1

i.
e.                      ; end block for segment 1

i4 = i4 + 1             ; increase segment count

\f




; fgs 1984.02.15  algol 8, openinout, closeinout, resetzones  page ...11...


b. c7, j94, p0, o4      ; block for second segment
w.

k=10000                 ; k assignment to catch missing relative
h.

c1 : c2     , c3        ; rel last point, rel last absword

j0 :  1     , c4        ; first external, initzones, chain for rel
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<11o.0, c5        ; point own segment, relative c5

c2 = k-2-c1             ; rel last point

w.
\f



; fgs 1984.02.15  algol 8, openinout, closeinout, resetzones  page ...12...


b. a11, b18, d5, e5, c0  ; block for local names in 
                         ; closeinout, resetzones, expellinout
w.

c0 :  4<12 + 18         ; constant, first formal integer array

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:  0                 ; -       , inputzone
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 1983.11.18  algol 8 openinout, closeinout, resetzones  page ...15...



      rl. w1  b5.       ;   appetite :=
      as  w1  2         ;     no of zones * 4 +
      al  w1  x1+28     ;     28;
      ac  w1  x1        ;
      jl. w3 (j3.)      ;   reserve (appetite);
      ds. w3 (j30.)     ;

                        ; stack return inf, w3 = abs addr return;
      al  w0  x2        ;   w0 :=
      as  w0  4         ;     sref < 4; <*in w2 at return from take expr*>
      al. w3  c6.       ;   w3 := abs addr of return from initzones;
      rl. w1  p0.       ;   w1 := point; <*here*>
      jl.    (j4.)      ;   take expression;
c5 = k-c1               ; rel of return here:
      ds. w3 (j30.)     ; 
      rl. w1 (j13.)     ;   w1 := last used;

      al  w0  28        ;   appetite := 28;
      hs  w0  x1+4      ;

      dl  w0  x2+8      ;   move (formal (zone array)) to
      ds  w0  x1+8      ;     new stack top;
      rl. w3  c0.       ;   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 1983.11.18  algol 8, openinout, closeinout, resetzonespage ...16...


                        ; 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. w3 (j0.)      ;   w3 := absword (initzones);

c4 = k+1-c1             ;   rel chain, chain stops here;
      jl      x3+0      ;   goto initzones;

c6 = k                  ; return from initzones:
      ds. w3 (j30.)     ;
      rs. w2 (j13.)     ;   last used := sref;

      el  w0  x2+7      ;   
      se  w0  1         ;   if entry = closeinout then
      jl.     a9.       ;   begin <*state of all zones := 0*>
      dl. w1 (o2.)      ;     restore first, last zone from own1, own2;
      ds. w1  b3.       ;
      al  w0  0         ;
      rl. w3  b2.       ;     zone := first zone;
a8:   rs  w0  x3+h2+6   ;     repeat
      al  w3  x3+h5     ;       zone.state := 0;
      sh. w3 (b3.)      ;       zone := zone + h5;
      jl.     a8.       ;     until zone > last zone;
a9:                     ;   end <*state of all zones := 0*>;
      jl. w3 (j8.)      ;   goto end reg expression;

\f



; fgs 1984.02.15  algol 8, openinout, closeinout, resetzones page ...17...


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+9      ;   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 1984.02.22  algol 8, openinout, closeinout, resetzones page ...18...


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 1983.11.18  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 1<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 1984.02.22  algol 8, openinout, closeinout, resetzones page ...20...


; tails for insertproc

h.
g0:   0      , i4       ; tail openinout: size
      0      , r.8      ;   name
      1<11+ 0, 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 1984.10.02 openinout closeinout, resetzones, expellinout

i.

d.
p.<:insertproc:>
l.

i.
e.                       ; end outer block

finis
▶EOF◀