|
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: 19200 (0x4b00)
Types: TextFile
Names: »uti32«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; rc 01.03.73 compress algol library page 1
s. b20, c20, f20, g20, w. ; start segment...
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
; rc 06.03.73 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
; 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);
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
; rc 27.03.73 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;
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 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;
al w1 2.111 ;
la. w1 b4. ;
se w1 0 ; if key <> 0
jd 1<11+50 ; then permanent entry;
jl. a2. ; goto next entry;
e. ; end a-names of catalog scan
\f
; rc 76.10.27 compress algol library page ...5...
; finis program: set result and return to fp...
c5: rl. w3 h8. ; for all parameters left in
al w0 4 ; paramlist do
hs w0 x3 ; preceding separator (param)
ba w3 x3+1 ; := <s>;
se. w3 (b5.) ;
jl. -6 ;
rl. w2 b9. ; w2 := fp result;
jl. h7. ; goto fp end 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, d3 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 ;
rx. w1 d1. ; nb:= word(k+j);
wm. w1 d3. ;
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;
d0: b10: 0 ; saved return
d1: 0 , d2:0 ; ne, ng
d3: 6 ; constant 6
e. ; end ps process ext list;
\f
; rc 09.08.73 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.
; 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 w.
c7: al. w1 b4. ; w1 := lookup area;
jd 1<11+76; check single entry:
se w0 0 ; if unknown then
jl. a4. ; result := 1 else
am (66) ;
dl w0 +70 ; if entry interval is not equal to
sn w3 (x1+2) ; the catalog 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 x2 ; return;
e.
\f
; rc 06.03.73 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;
rl. w3 h8. ;
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. a11 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
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>:>
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 01.03.73 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. a1 w.
g1: am -1000 ;
rs. w3 h8.+1000; initialize: 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;
jl. w2 c7. ; check entry(w3);
se w1 0 ; if not ok then
jl. f9. ; alarm(error on output);
; check catalog base and standard interval...
a0: rl w3 66 ;
dl w1 x3+70 ; w0w1 := catalog base;
al w1 x1-1 ;
sl w0 (x3+76) ; if catalog base is outside
sl w1 (x3+78) ; the standard interval then
jl. f8. ; alarm(intervals);
\f
; rc 01.03.73 compress algol library page 11
; 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)
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...
i. e.
m. compresslib 27.03.73
e. ; end fp names
▶EOF◀