|
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: 6144 (0x1800)
Types: TextFile
Names: »uti5«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦f8e4b63af⟧ »trcfput«
└─⟦this⟧
; rc 76.07.01 textcompr
b.
d.
p.<:fpnames:>
l.
;this program compresses a slang text i.e. removes all
;blind characters (spaces and non-graphics) except in text
;strings and messages. all vt and ff is converted to nl.
; call: result=textcompr infile
s. j5, i5, g5, f5, e5, d5, c10, b5, a5
w.
k=h55
0
b2: 0 ;
ds. w3 b2. ; entry: save fpparam
sn w3 x2 ; if no left side then
jl. a1. ; alarm(call)
al. w1 h19.
jl. w3 h79.
al. w3 b1.
rs. w3 h80.+2
al w3 x3-1
rs w3 x1+h0
al w3 x3+512
rs w3 x1+h0+2
al w2 x2+2
al w0 1<1+1
jl. w3 h28.
se w0 0
jl. a2.
rl. w3 b2. ;
bl w1 x3+10
sh w1 3
jl. a3. ; if no param then alarm
bl w1 x3+11 ;
se w1 10 ; if param<>text
jl. a3. ; then alarm(param)
jl. w3 h29.-4 ; stack cur in
rl. w3 b2. ;
al w2 x3+12 ; connect input
jl. w3 h27.-2 ;
se w0 0
jl. a2.
jl. c1. ; goto next;
c0: rs. w2 f3. ; outnext:
al. w1 h19.
jl. w3 h26. ; outchar(char);
c1: jl. w3 h25.-2 ; next: inchar(char)
d0: bl. w3 x2+g0. ; take action: action:= table(char);
al w0 1 ;
j0: jl. x3 ; goto action;
d1: al w0 1 ; normal1:
c2=k-j0
sn. w0 (f0.) ; normal:
jl. c1. ; goto if comment then next else outnext;
jl. c0. ;
c3=k-j0
se. w0 (f1.) ; space:
sn. w0 (f2.) ; goto if string or message
jl. c0. ; then outnext else next;
jl. c1. ;
c4=k-j0
al w2 10 ; nl: vt: ff:
al w0 0 ; char:= nl;
se. w0 (f2.) ; if message then message:= false else
rs. w0 f2. ;
se. w0 (f0.) ; if comment then comment:= false;
rs. w0 f0. ;
al w3 10 ;
sn. w0 (f1.) ; if string or
se. w3 (f3.) ; char<>10 then
jl. c0. ; goto outnext else
jl. c1. ; goto next;
c5=k-j0
jl. w3 h30.-4 ; unstack cur in
al. w1 h19. ; em:
rl w0 x1+h3 ;
ws w0 x1+h0 ;
hs. w0 c10. ; recbase-basebuf
jl. w3 h95.
jl. w3 h79. ; terminate program
al w2 x1
al w3 x1+h1+2
al. w1 h54. ; lookup area
jd 1<11+42 ; lookup entry
rl w3 x2+h1+16 ; tail(0):=segm.count
rs w3 x1 ;
al w3 x3-1 ; (segm-1)
ls w3 9 ; *512
c10=k+1
al w3 x3+80 ; +(recbase-basebuf
al w3 x3+2 ; +2)
rs w3 x1+18 ; => loadlength
dl w0 110 ;
ld w0 5 ;
rs w3 x1+10 ; shortclock
al w3 x2+h1+2 ; restore w3
bz w2 x2+h1+1 ; output kind
sn w2 4 ; if kind=bs then
jd 1<11+44 ; changeentry
al w2 0 ; ok:=true;
jl. h7. ; goto fp end program;
c6=k-j0
sn. w0 (f0.) ; semicolon:
jl. c1. ; if comment then goto next;
se. w0 (f1.) ;
sn. w0 (f2.) ; if string or message
jl. c0. ; then goto outnext;
rs. w0 f0. ; comment:= true;
jl. c1. ; goto next;
\f
; rc 21.05.74 page 2
c7=k-j0
am 1 ; m: m: mess:= true; goto inn;
c8=k-j0
al w3 0 ; less than: mess:= false;
hs. w3 b0. ; inn:
sn. w0 (f0.) ; if comment then goto next;
jl. c1. ;
se. w0 (f1.) ;
sn. w0 (f2.) ; if string or message then goto outnext;
jl. c0. ;
al. w1 h19.
jl. w3 h26. ; outchar(char);
jl. w3 h25.-2 ; inchar(char);
b0=k+1;mess, true=1,false=0
se w3 x3 ; if mess then goto message;
jl. a0. ;
se w2 58 ; if char<>colon then goto take action;
jl. d0. ;
rs. w0 f1. ; string:= true;
jl. c0. ; goto outnext;
a0: se w2 46 ; message:
jl. d0. ; if char<>point then goto take action;
rl. w3 f3. ;
sh w3 63 ; if oldchar<>letter then
rs. w0 f2. ; message:= true;
jl. c0. ; goto outnext;
c9=k-j0
al w0 0 ; colon:
sn. w0 (f1.) ;
jl. d1. ; if not string then goto normal1;
al. w1 h19.
jl. w3 h26. ; outchar(char);
jl. w3 h25.-2 ; inchar(char);
se w2 62 ; if char<>greater than then
jl. d0. ; then goto take action;
rs. w0 f1. ; string:= false;
jl. c0. ; goto outnext;
e1: <:***textcompr call<10><0>:>
e2: <:***textcompr connect error<10><0>:>
e3: <:***textcompr param<10><0>:>
a1: am e1-e2
a2: am e2-e3
a3: al. w0 e3.
jl. w3 h31.-2
al w2 1
jl. h7.
;booleans, true=1, false=0
f0: 0 ; comment
f1: 0 ; string
f2: 0 ; message
f3: 0 ; oldchar
h.
c0=c0-j0, c1=c1-j0
g0:
;0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
c1,c1,c1,c1,c1,c1,c1,c1,c1,c1,c4,c4,c4,c1,c1,c1; 0-15
c1,c1,c1,c1,c1,c1,c1,c1,c1,c5,c1,c1,c1,c1,c1,c1;16-31
c3,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2;32-47
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c9,c6,c8,c2,c2,c2;48-63
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c7,c2,c2;64-79
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2;80-95
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c7,c2,c2;96-111
c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c2,c1;112-127
w.
b1: 0, r.256 ; buffer for program zone
e.
e.
e.
▶EOF◀