|
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: 27648 (0x6c00)
Types: TextFile
Names: »comprlib3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »comprlib3tx «
; fgs 1986.07.04 compress algol library page 1
s. b20, c20, f20, g20, w. ; start segment...
d.
p.<:fpnames:>
l.
k = h55
g0. , 0 ; length, not used
jl. g1. ; entry: goto initialize;
; definitions of zones and shares:
b. a5, w. ; a-names used for initialization-chain...
; b0 = inputzone , b1 = input share
h.a0:4 , g2. ; h0+0: base buffer area = g2
0 , 0 ; +2: last of buffer = last of process = h8
2 , b1. ; +4: used share =
2 , b1. ; +6: first share =
a1. , b1. ; +8: last share = b1
0 , r.18 ; h1+0: process description
0 , 0 ; h2+0: give up mask = 0
a1:4 , f0. ; +2: give up action = f0
0 , 0 ; +4
a2. , h22. ; +6: free parameter = abs addr of fp inblock
b0: 0 , r.6 ; h3+0: record description
b1: 0 , 0 ; s+0: share state = 0
a2:a3. , g3. ; +2: first shared = g3
0 , r.20 ; +4
; b2 = output zone , b3 = output share
a3:4 , g2. ; h0+0: base buffer area = g2
0 , 0 ; +2: last of buffer = last of process = h8
2 , b3. ; +4: used share =
2 , b3. ; +6: first share =
a4. , b3. ; +8: last share = b2
0 , r.18 ; h1+0: process description
0 , 0 ; h2+0: give up mask = 0
a4:4 , f1. ; +2: give up action = f1
0 , 0 ; +4
a5. , h23. ; +6: free parameter = abs addr of fp outblock
b2: 0 , r.6 ; h3+0: record description
b3: 0 , 0 ; s+0: share state = 0
a5:a0. , g3. ; +2: first shared = g3
0 , r.20 ; +4
e. w. ; end a-names
\f
; fgs 1986.07.04 compress algol library page 2
; other variables
b4: 0 , r.17 ; lookup area,
b5: 0 ; parameter pointer (points at item before
; current parameter, right byte)
b6: 1<23 + 4 ; constant = <bs>
0, r.9 ; room for tail in connect;
b7: 4095-32 ; largest byte value - 32;
b8: 0 ; saved return from c7
b9: 0 ; fp result
b11: 0 ; saved object entry base (1);
b12: 0 ; - - - - (2);
b13: 0 , r.4 ; - - doc name (1:4);
; remove parameter from parameter list
c6: rl. w3 b5. ; remove from area list:
ba w3 x3 ;
ba w3 x3 ;
ws. w3 b5. ;
hs. w3 (b5.) ;
; find the next legal item (i.e. a name not followed by a
; point) in the parameter list.
; (illegal items are removed from the parameter-chain)
c0: rl. w3 b5. ; next param:
ba w3 x3 ; w3 := item head(param);
bl w0 x3-1 ; w0 := preceding separator;
sh w0 3 ; if end param-list then
jl. c1. ; goto change descriptors;
bl w0 x3 ; if parameter <> <name> then
se w0 10 ; alarm(parameter);
jl. f2. ;
ba w3 x3 ; w3 := item head(following);
bl w0 x3-1 ; w0 := following separator;
sn w0 8 ; if point then
jl. f2. ; alarm(parameter);
; the parameter must describe a bs-area, with content = 4
; and with an entry interval equal to the catalog base.
al w3 x3-9 ; w3 := addr of parameter name;
jl. w2 c7. ; check param(w2,w3); <*w0 never zero*>
se w1 0 ; if result <> ok then
jl. f5. ; alarm(error on input, w1);
rl. w0 b2.+h1+16 ; move segment count in output zone into
sl. w0 (b7.) ; if segment > max possible
jl. f11. ; then goto alarm(too many);
rs. w0 b2.+h1+14 ; blockcount of output zone
rl. w3 b5. ; ...and into separator byte of current
ba w3 x3 ; parameter head;
hs w0 x3-1 ;
\f
; rc 27.03.73 compress algol library page 3
dl w1 x3+3 ; move name of area
ds. w1 b6.+4 ; to connection tail;
dl w1 x3+7 ;
ds. w1 b6.+8 ;
al. w3 g3. ; input.first shared:=
rs. w3 b1.+2 ; first buffer;
al. w1 b0. ; zone:= input;
al. w2 b6. ; descr:= connection tail;
jl. w3 h27. ; connect input (zone, descr);
se w0 0 ; if not ok
jl. f6. ; then connect alarm;
bz. w3 b4.+32 ;
ls w3 9 ; last transport:=
wa. w3 b1.+2 ; segments*512+first shared;
al w3 x3-2 ;
sl. w3 (b0.+h0+2) ; if last transport > last buffer
jl. f4. ; then goto alarm(processes too small);
rs. w3 b1.+4 ; input. last shared:=
rs. w3 b1.+10 ; input.last transf:=
rs. w3 b3.+10 ; output.last transf:= last transport;
jl w3 (x1+h2+6) ; inblock (zone);
jl. w3 c2. ; ps processes ext list;
al. w1 b0. ;
jl. w3 h79. ; terminate inputzone;
al. w1 b2. ; zone:= output;
jl w3 (x1+h2+6) ; outblock (zone);
; increase param pointer...
; and goto next param...
rl. w3 b5. ; increase parameter pointer;
ba w3 x3 ;
rs. w3 b5. ;
jl. c0. ; goto next param;
\f
; fgs 1986.07.04 compress algol library page 4
; at end of parameter list: terminate the output zone and
; change the output entry so that it describes all the output
b. a5 w. ; local block;
c1: al w3 x3-1 ; change descriptors:
rs. w3 b5. ; save end param address...
al. w1 b2. ;
jl. w3 h79. ; terminate outputzone;
al. w1 b4. ; w1 := lookup area;
al. w3 b2.+h1+2 ; w3 := output area name;
jd 1<11+42 ; lookup entry(w1,w3);
rl. w0 b2.+h1+16 ; length in tail :=
rs w0 x1 ; segm count;
jd 1<11+44 ; change entry(w1,w3);
a2: rl. w3 h8. ; w3 := start of area chain;
ba w3 x3+1 ;
sn. w3 (b5.) ; if start = end param addr then
jl. c5. ; goto finis program;
rs. w3 h8. ; area chain start:= this area;
al w3 x3+2 ; w3:= name addr;
al w0 1 ; ensure w0 <> 0;
jl. w2 c7. ; check entry;
se w1 0 ; if not ok
jl. f9. ; then goto alarm;
al. w3 b4.+6 ; w3:= entry.name addr;
jd 1<11+48 ; remove entry;
al. w1 b4.+14 ; w1:= tail addr;
dl w0 x1+4 ; move document name
ds. w0 b13.+2 ; from tail
dl w0 x1+8 ; to saved object docname
ds. w0 b13.+6 ; for use by permanent into auxcat;
dl. w0 b2.+h1+4 ; move name of output
ds w0 x1+4 ; to document name;
dl. w0 b2.+h1+8 ;
ds w0 x1+8 ;
bz. w2 (h8.) ;
al w2 x2+32 ; content:= startsegm + 32;
hs w2 x1+16 ;
rl. w0 b6. ; modekind:= bs;
rs w0 x1+0 ;
al. w3 b4.+6 ; w3:=address of entry name;
jd 1<11+40 ; create entry;
se w0 0 ; if result <> 0 then
jl. a5. ; goto alarm;
al. w2 b13. ; w2 := addr old document name;
al w1 2.111 ;
la. w1 b4. ;
se w1 0 ; if key <> 0
jd 1<11+90 ; then permanent entry into auxcat;
se w0 0 ; if result <> 0 then
jl. a4. ; goto alarm;
dl. w1 b12. ;
jd 1<11+74 ; set entry base (saved base);
se w0 0 ; if result <> 0 then
jl. a3. ; goto alarm;
jl. a2. ; goto next entry;
a3: am 1 ; alarm set entry base:
a4: am 1 ; alarm permanent into auxcat
a5: al w1 10 ; alarm create entry:
jl. f5. ; goto alarm;
e. ; end a-names of catalog scan
\f
; fgs 1986.07.03 compress algol library page ...5...
; finis program: set result and return to fp...
b. a1 w. ; begin block finis program;
c5: rl. w3 h8. ; for all parameters left in
al w0 4 ; paramlist do
a0: hs w0 x3 ; preceding separator (param) := <s>;
am (x3+1) ;
sn w3 x3 ; if separator = 0 then
jl. a1. ; goto finis;
ea w3 x3+1 ;
se. w3 (b5.) ;
jl. a0. ;
a1: rl. w2 b9. ; w2 := fp result;
jl. h7. ; goto fp end program;
e. ; end block finis program;
; procedure pseudo process external list;
; call: jl. w3 c2.
; return: all registers spoiled.
; the procedure inputs one extra segment
; for each segment occupied by the external list,
; and corrects the output zone accordingly;
b. a5, d10 w. ;
c2: rs. w3 d0. ; entry: save return
c4: bz. w3 b4.+31 ; entry, return saved: k:= rel start ext list;
al. w2 g3. ; j:= first segm start;
sl w3 502 ; if k >= 502
jl. w3 c3. ; then input extra segm;
am x2 ;
rl w0 x3 ;
bz w1 0 ; ne:= byte(k+j+1);
bz w0 1 ; ng:= byte(k+j);
ds. w1 d2. ;
al w3 x3+2 ; k:= k + 2;
sl w3 502 ; if k >= 502
jl. w3 c3. ; then input extra segm;
am x2 ;
rl w1 x3 ; nb := word (k + j);
rl. w0 b4.+26 ; w0 := kind and spec (1);
sl w0 0 ; if fortran subroutine then
jl. a1. ; begin
rs. w1 d3. ; save nc, nz;
zl w1 2 ; nb :=
wm. w1 d5. ; nc * 12;
rx. w1 d3. ; nb :=
zl w1 3 ; nz *
wm. w1 d6. ; 18 +
wa. w1 d3. ; nb;
a1: rx. w1 d1. ; end <*fortran subroutine*>;
wm. w1 d4. ;
wa. w1 d2. ; i:= (ne*6+ng)*2+nb;
ls w1 1 ; comment i + 6 is
wa. w1 d1. ; number of unprocessed
al w0 x1 ; bytes in ext list;
a0: wa w0 6 ; rep: i:= i + k;
sh w0 502-7 ; if i + 6 < 502 - 2
jl. (d0.) ; then return;
; comment if there is only one word left
; then it is used as continuation word
jl. w3 c3. ; input extra segm;
al w3 x3-502 ; i:= i - 502;
jl. a0. ; goto rep;
b10:
d0: 0 ; saved return;
d1: 0 ; ne
d2: 0 ; ng
d3: 0 ; work for nc, nz
d4: 6 ; constant 6
d5: 12 ; - 12
d6: 18 ; - 18
e. ; end ps process ext list;
\f
; fgs 1986.07.04 compress algol library page 6
; procedure input extra segment;
; the procedure inputs one extra segment after
; the last and sets the zone variables:
; k:= input.first shared:= input.first transfer:= input.last transfer+2;
; input.last shared:= output.last transfer:= input.last transfer:= k + 510;
; call: w2 : some machine address
; w3 : return address;
; return w0 : unchanged; w1: spoiled
; w2 : w2(entry)+512; w3: byte(x2(entry)+503);
b. d1 w. ;
c3: ds. w3 d1. ; entry: save registers;
al. w1 b0. ;
rl. w2 b1.+10 ; set share variables;
al w2 x2+2 ;
al w3 x2+510 ;
ds. w3 b1.+4 ;
ds. w3 b1.+10 ;
rs. w3 b3.+10 ;
sl w3 (x1+h0+2) ; if k + 510 > last buffer
jl. f4. ; then alarm (process too small);
jl w3 (x1+h2+6) ;
rl. w2 d0. ; w2:= saved w2;
bz w3 x2+503 ; w3:= byte(x2+503);
al w2 x2+512 ; w2:= w2 + 512;
jl. (d1.) ; return
d0: 0 , d1: 0 ; saved w2, return;
e. ; end input extra segm;
; procedure check entry.
; call: jl. w2 c7. ; w3 = addr of entry name.
; ; w0 = 0 => check and save object entry base
; the procedure checks that the entry is a legal compress-parameter.
; at return w1 is the result of the check:
; w1 = 0 == normal return, entry is ok
; w1 = 1 == entry is unknown
; w1 = 2 == wrong interval
; w1 = 3 == illegal content
; w1 = 4 == not area
b. a5, d1 w.
c7: rs. w2 b8. ; entry: save return;
rl w2 0 ; w2 := w0;
al. w1 b4. ; w1 := lookup area;
jd 1<11+76 ; check single entry:
se w0 0 ; if unknown then
jl. a4. ; result := 1 else
se w2 0 ; if object entry then
jl. a5. ; begin
dl w1 x1+4 ;
al w3 0 ; w3 := own process;
rs. w3 d1. ;
al. w3 d1. ;
jd 1<11+72 ; set catalog base (entry base);
se w0 0 ; if catbase not set then
jl. a3. ; result := 2
al. w1 b4. ; else
dl w0 x1+4 ; begin
ds. w0 b12. ; save entry base;
am -2000 ;
am. (h16.+2000) ; set catbase (std base);
dl w1 +78 ;
al. w3 d1. ; w3 := own process;
jd 1<11+72 ; end;
a5: al. w1 b4. ; end;
dl. w0 b12. ; if entry interval is not equal to
sn w3 (x1+2) ; the saved base then
se w0 (x1+4) ; result := 2 else
jl. a3. ;
bz w0 x1+30 ; if content <> 4 then
se w0 4 ; result := 3 else
jl. a2. ;
rl w0 x1+14 ; if size > 0 then
sl w0 1 ; result := 0 else
am 0-4 ; result := 4
am 4-3 ; ;
a2: am 3-2 ;
a3: am 2-1 ;
a4: al w1 1 ;
jl. (b8.) ; return;
d1: 0 ; work;
e.
\f
; fgs 1986.07.04 compress algol library page 7
; alarms ..........
; procedure alarm head.
;
; the procedure writes <:***<program name> :> on current out...
;
; call: jl. w2 f10. ;
b. a1 w.
f10: al. w0 a0. ; w0 := <:***<0>:>;
jl. w3 h31.-2 ; outtext;
am -2000 ;
rl. w3 h8.+2000 ;
al w0 x3+2 ;
jl. w3 h31. ; outtext(program name);
al. w0 a1. ;
jl. w3 h31. ; outtext(<: :>);
al w0 1 ; fp result := sorry;
rs. w0 b9. ;
jl x2 ; return;
a0: <:***<0>:>
a1: <: :>
e.
; alarmtexts.............
b. a20 w.
a0: h. a1 ; result = 0 , connect error
a2 ; 1 , unknown
a3 ; 2 , interval
a4 ; 3 , content
a5 ; 4 , not area
a6 ; 5 , intervals
a7 ; 6 , no collection area
a8 ; 7 , transport error
a9 ; 8 , process too small
a11 ; 9 , too many segments
a12 ; 10, create entry
a13 ; 11, permanent into auxcat
a14 ; 12, setentry base
w.
a1=k-a0 , <: connect error<10><0>:>
a2=k-a0 , <: unknown<10><0>:>
a3=k-a0 , <: interval<10><0>:>
a4=k-a0 , <: content<10><0>:>
a5=k-a0 , <: not area<10><0>:>
a6=k-a0 , <: intervals<10><0>:>
a7=k-a0 , <: no collection area<10><0>:>
a8=k-a0 , <: transport error<10><0>:>
a9=k-a0 , <: process too small<10><0>:>
a11=k-a0, <: too many segments<10><0>:>
a12=k-a0, <: create entry<10><0>:>
a13=k-a0, <: permanent into auxcat<10><0>:>
a14=k-a0, <: set entry base<10><0>:>
a10: 0 ; saved errortext
\f
; rc 06.03.73 compress algol library page 8
; process too small...
f4: am 1 ; process too small: result := 8;
; transport error on input...
f0: al w2 -2 ; result:=7
al. w1 b0. ; terminate input zone...
jl. w3 h79. ;
am x2 ;
; alarms on input parameters...
f11: am 9 ; too many segments: result:=9;
f6: al w1 0 ; connect error: result := 0;
f5: bl. w1 x1+a0. ; other error, result is in w1...
al. w0 x1+a0. ; w0 := alarmtext
rs. w0 a10. ;
jl. w2 f10. ; alarm head...
rl. w3 b5. ;
ba w3 x3 ; w0 := parameter address;
al w0 x3+1 ;
jl. w3 h31. ; outtext(parameter);
rl. w0 a10. ; w0 := saved alarmtext;
jl. w3 h31. ; outtext.
jl. c6. ; goto remove item...
; alarms on output parameter...
f1: am 7 ; transport error: result:=7;
f3: al w1 0 ; connect error: result := 0;
f9: bl. w1 x1+a0. ; other error: result is in w1...
al. w0 x1+a0. ; w0 := alarmtext;
rs. w0 a10. ;
jl. w2 f10. ; alarm head
al. w0 b2.+h1+2 ; w0 := outfile name;
jl. w3 h31. ; outtext;
rl. w0 a10. ; w0 := saved alarmtext;
jl. w3 h31. ;
jl. c5. ; goto finis program;
\f
; rc 01.03.73 compress algol library page 9
; other alarms...
f7: am 1 ; no left side: result := 6;
f8: al w1 5 ; intervals: result := 5;
al w0 0 ;
rs. w0 b2.+h1+2 ; outfilename := 0;
jl. f9. ; goto other error on output parameter...
e. ; end a-names for alarms...
; parameter error...
b. a10 w.
f2: jl. w2 f10. ; alarm head...
al. w0 a0. ;
jl. w3 h31. ; outtext (<:param :>);
a1: rl. w2 b5. ; next: w2 := param pointer;
ba w2 x2 ;
bl w1 x2 ; w1 := parameter kind;
se w1 10 ; if <name> then
jl. a2. ;
al w0 x2+1 ; outtext(param name)
jl. w3 h31.-2 ;
jl. a3. ; else
a2: rl w0 x2+1 ;
jl. w3 h32.-2 ; outinteger(param);
0 ; ...layout...
a3: ba w2 x2 ;
bl w1 x2-1 ; w1 := following separator;
ws. w2 b5. ; remove item from parameterlist...
hs. w2 (b5.) ;
al w2 46 ; w2 := point-character;
al. w3 a1. ; set return to next;
sn w1 8 ; if separator is point then
jl. h26.-2 ; outchar(point);
al w2 10 ;
jl. w3 h26.-2 ; outchar(<10>);
jl. c0. ; goto next param;
a0: <:param <0>:>
e.
\f
; rc 03.04.74 compress algol library page 10
; initialisation of program .......
c8: bz. w2 b4.+32 ; finish init:
wa. w2 b0.+h1+16 ;
al w2 x2-1 ; output.segmentcount :=
rs. w2 b2.+h1+16 ; codesegments + length of extlist - 1;
jl. c0. ; goto next praram;
; define the copy-buffer:
g2 = k-1 ; base buffer area
g3 = k ; first shared
0 , r.17 ; secondary lookup area
; initialize outputname
b. a20, d20
w.
d0: <:catalog:>, 0, 0 ; name of catalog, name tab addr
0 ; message buffer address(first);
d1: 3<12 ; first message(input)
0 ;g0 ; first buff(first);
0 ;g0+510 ; last buff(first);
0 ; segment(first);
0 ; mess buff addr(second);
d2: 3<12 ; second message(input);
0 ;g0+512 ; first buff(second);
0 ;g0+512+510 ; last buff(second);
-1 ; segment(second); init to -1;
d3: 0, r. 8 ; answer area
d4: 0 ; current message
d5: 0 ; other message
d6: -1<2 ; dangerous bits in status
d7: 1<18 + 1<1 ; end document+normal answer
d8: 0 ; last entry(current buffer);
\f
; fgs 1986.07.04 compress algol library page 11
g1: am -1000 ; initialize:
rs. w3 h8.+1000 ; current command := program name...
al w0 x3+1 ; param pointer:=
rs. w0 b5. ; byte before program;
sn w2 x3 ; if no leftside then
jl. f7. ; alarm (no leftside)
al w3 x3-8 ; w3 := outfile name;
dl w1 x3+2 ; move outfile name to output zone...
ds. w1 b2.+h1+4 ;
ds. w1 b6.+4 ; and connection tail;
dl w1 x3+6 ;
ds. w1 b2.+h1+8 ;
ds. w1 b6.+8 ;
al w0 0 ; check entry base and save it;
jl. w2 c7. ; check entry(w3);
se w1 0 ; if not ok then
jl. f9. ; alarm(error on output);
; initialize abs addresses in zones...
al. w1 b0.+h0+1 ; w1 := chain start;
bl w0 x1-1 ;
a1: wa w1 0 ; next: w1 := next element;
bl w2 x1 ;
bl w0 x1-1 ;
wa w2 2 ; w2 := abs address of element;
rs w2 x1 ;
se. w1 b0.+h0+1 ; if not chain start then
jl. a1. ; goto next;
rl. w3 b5. ;
al w3 x3-3 ; initialize last of buffer in zones...
rs. w3 b0.+h0+2 ;
rs. w3 b2.+h0+2 ;
; connect output zone...
al w0 0 ; define area-size;
al. w1 b2. ; w1 := output zone;
al. w2 b6. ; w2 := outfile;
jl. w3 h28. ; connect output;
se w0 0 ; if not ok then
jl. f3. ; alarm(connect error);
al. w1 b0. ;
jl. w3 h27. ; connect input (outfile);
se w0 0 ; if not ok then
jl. f9. ; alarm (error on output)
\f
;fgs 1986.07.04 compress algol library, page 12
;scan catalog to see if left side already compressed ...
al. w3 d0. ;start cat scan:
jd 1<11+52 ; create area process
al. w1 g0. ; (<:catalog:>);
al w2 x1+510 ;
ds. w2 d1.+4 ; initialize buffer addresses(first);
al w1 x1+512 ;
al w2 x1+510 ;
ds. w2 d2.+4 ; initialize buffer addresses(second);
sl. w2 (b0.+h0+2) ; if last buf(catscan) > last buf(input) then
jl. f4. ; alarm(process too small);
al. w1 d1. ; current message:=first;
al. w2 d2. ; other message:=second;
ds. w2 d5. ;
al. w1 d1. ; send message(first buffer);
jd 1<11+16 ;
rs w2 x1-2 ; save mess buff addr(first);
al. w1 d2. ; message:=second;
a3: rl w2 x1+6 ; next segment: comment throughout this loop
al w2 x2+2 ; w3 points at <:catalog:>;
rs w2 x1+6 ; segment(message):=segment(message)+2;
jd 1<11+16 ; send message(message);
rs w2 x1-2 ; save mess buff addr;
rl. w2 d4. ; message buffer address :=
rl w2 x2-2 ; mess buff addr(current);
a4: al. w1 d3. ; wait and check:
jd 1<11+18 ; wait answer(answer area, buff);
al w2 1 ;
ls w2 (0) ; logical status:=
lo w2 x1 ; status + 1<result;
sz. w2 (d6.) ; if dangerous bits then
jl. a8. ; goto end catscan;
rl w2 x1+2 ; if bytes transferred <> 512
sn w2 512 ; then
jl. a5. ; begin
rl. w1 d4. ; send message(current);
jd 1<11+16 ; goto wait and check;
jl. a4. ; end;
a5: rl. w2 d4. ; entry := first of entry;
rl w2 x2+2 ;
al w1 x2+15*34-34; last entry:=(entries per segment - 1)
rs. w1 d8. ; * entry length + first of buffer;
a6: bl w0 x2+0 ; test entry:
sn w0 -1 ; if entry = free then
jl. a7. ; goto next entry;
dl. w1 b12. ;
sn w0 (x2+2) ; if entry base <> saved entry base then
se w1 (x2+4) ; goto next entry;
jl. a7. ;
dl. w1 b0.+h1+4 ; if entry. docname (1:2) <>
sn w0 (x2+16) ; input.procname (1:2) then
se w1 (x2+18) ; goto next_entry;
jl. a7. ;
dl. w1 b0.+h1+8 ; if entry. docname (3:4) <>
sn w0 (x2+20) ; input.procname (3:4) then
se w1 (x2+22) ; goto next_entry;
jl. a7. ;
bz w1 x2+30 ;
al w1 x1-32 ; first segm := entry.content - 32;
sl w1 1 ; if first segm <=0
sh. w1 (b0.+h1+16) ; or first segm < input zone.segment count
jl. a7. ; then goto next entry;
rs. w1 b0.+h1+16 ; input zone.segm:=first segm;
bz w1 x2+32 ; input entry.code length :=
hs. w1 b4.+32 ; entry.code length;
\f
; rc 24.03.83 compress algol library, page 13
a7: al w2 x2+34 ; next entry: entry:=entry + entry length;
sh. w2 (d8.) ; if entry <= last entry
jl. a6. ; then goto test entry;
rl. w1 d5. ; message := current message;
rx. w1 d4. ; current message := other message;
rs. w1 d5. ; other message := message;
jl. a3. ; goto next segment;
a8: al. w1 d0. ; end catscan:
al w3 -2000 ; comment stepping stone;
so. w2 (d7.) ; if status <> end of document
jl. x3+h7.+2000; then goto giveup the run;
rl. w2 d5. ;
rl w2 x2-2 ; w2:= buff address of other message;
al. w1 d3. ;
jd 1<11+18 ; fetch answer to other message;
al. w1 b0. ;
al. w3 c8. ; set return addresses to go
rs. w3 b10. ; via pseudo process ext list
al. w3 c4. ; to finish init and then call
jl (x1+h2+6) ; inblock;
e. ; end a-names of initialization.
g0: 0 ; length of segment, length of next segment...
e. ; end block for fpnames
m.compresslib 1986.07.04
i.
e. ; end segment
▶EOF◀