|
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: 15360 (0x3c00)
Types: TextFile
Names: »layoutxt«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »layoutxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »layoutxt«
└─⟦this⟧ »tplot/layoutxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦dd2c1b53f⟧ »tplot«
└─⟦this⟧
;rene moss 8-6-78/17-1-79
scope temp origo minlay laypos numbdigit cutlay,
packlay splitlay charlay exactlay,
approxnumb digits writelay fixexplay
clear temp origo minlay laypos numbdigit cutlay,
packlay splitlay charlay exactlay,
approxnumb digits writelay fixexplay
origo=set 2
minlay=set 2
laypos=set 1
cutlay=set 1
packlay=set 2
splitlay=set 3
charlay=set 3
exactlay=set 2
approxnumb=set 2
digits=set 1
numbdigit=set 1
writelay=set 1
fixexplay=set 3
\f
message approxnumb
approxnumb=algol message.no list.no
external
real procedure approxnumb(a,e,digit);
value a,e; real a,e; integer digit;
comment finds a number r such that an interval of length l
around r contains a. r contains as few digits as possible
less signifikant digit 5 better than even better than odd;
begin
integer i,c,p,s;
s:=sign(a); a:=abs a; e:=abs e;
i:=entier(ln(e)/ln10);
e:=e/10**i; a:=a/10**i; p:=a;
c:=p//10*10;
if abs(a-c)<=e then p:=c
else
begin
c:=p//5*5;
if abs(a-c)<=e then p:=c
else
begin
c:=p//2*2;
if abs(a-c)<=e then p:=c
end
end;
digit:=entier(ln(if p=0 then 1 else p)/ln10)+1;
approxnumb:=s*p*10**i;
end approxnumb
; end
\f
message charlay
charlay=algol message.no list.no
external
boolean procedure charlay(T,lay);
array T; real lay;
begin
integer l1,l2,l,b,h,d,s,pe,fe,pn,fn,v,vg,c,i;
boolean npart;
real t;
charlay:=false;
c:=1 shift 23;
l1:=l2:=l:=b:=h:=d:=s:=pe:=fe:=pn:=fn:=v:=vg:=0;
vg:=T(1) shift (-24) extract 24;
T(1):=T(1) shift 16 shift (-16);
if vg shift (-8)<>60 shift 8 add 60 or vg extract 8 = 0 then goto END;
for i:=0,i+1 while T(i) extract 8 <> 0 do;
t:=T(i);
for v:=v+1 while t extract 8 = 0 do
begin
t:=t shift (-8);
if v=6 then begin i:=i-1; t:=T(i) end
end;
if t extract 8<>62 then goto END;
t:=t shift(-8);
for v:=t extract 8 while v=100 or v=0 do
begin
if v=0 then
begin
if i=1 then goto E;
i:=i-1; t:=T(i)
end
else
begin
h:=h+1;
t:=t shift (-8);
vg:=v
end
end ds;
npart:=t extract 8>=48 or vg=100;
for v:=t extract 8 while v=102 or v=122 or v=45 or
v=43 or v=39 or v=0 do
begin
if v=0 then
begin
if i=1 then goto E;
i:=i-1; t:=T(i)
end
else
begin
if (v=102 or v=122) and npart then
begin
h:=h+1;
npart:=false;
pn:=v shift (-2) extract 2
end
else
if v=39 and h<4 and h>0 then
begin
pe:=pn; fe:=fn; s:=h;
h:=fn:=pn:=0;
npart:=true
end
else
if v=43 and vg>97 then begin fn:=2; npart:=false end
else
if v=45 and vg>97 then begin fn:=1; npart:=false end
else
goto END;
t:=t shift (-8);
vg:=v
end v<>0;
end exp-lay or integer lay without space;
if vg=39 and v<47 then goto END;
for v:=t extract 8 while i>1 or v>0 do
begin
if v=0 then begin i:=i-1; t:=T(i) end
else
begin
if v=46 and npart and vg<>32 and d=0 then
begin
d:=h; h:=0
end
else
if v=43 and vg>97 then begin fn:=2; npart:=false end
else
if v=45 and vg>97 then begin fn:=1; npart:=false end
else
begin
if v=32 and vg<>46 then
begin
l1:=l1 add c;
npart:=vg<>32
end
else
if v=48 and d+h+b=0 or
npart and (v=98 or v=100 or v=102 or v=122) then
begin
h:=h+1;
if v=48 then b:=b-1;
if v extract 2 = 2 then
begin
pn:=(if v=102 then 1 else if v=122 then 2 else 3);
npart:=false
end;
if vg=32 then l1:=l1 shift 2 add c shift (-1)
end
else
goto END;
if l1 extract 1=1 then goto END;
l1:=l1 shift (-1)
end;
t:=t shift (-8);
vg:=v
end
end;
E:b:=b+h+d;
if b>0 and h<16 and d<16 then
begin
l1:=l1 add c;
charlay:=true;
lay:=(-1.0) add l1 shift 6 add b shift 4 add h
shift 4 add d shift 2 add pn shift 2 add fn
shift 2 add s shift 2 add pe shift 2 add fe;
end;
END:
end charlay
; end
\f
message cutlay
cutlay=algol message.no list.no
external
real procedure cutlay(lay,digit);
value digit; integer digit; string lay;
comment changes a given layout to show max.
digit digits;
begin
real l; integer l1,i,j,b,h,d;
cutlay:=l:=real lay;
b:=l shift(-18) extract 5;
if digit<b and digit>0 then
begin
h:=l shift(-14) extract 4;
i:=b-digit; b:=digit;
l1:=l shift (-24) extract 24;
j:=0;
if l shift (-4) extract 2 <>0 then
begin
if i>=h then i:=h-1;
h:=h-i;
for j:=0,j+1 while l1<0 do l1:=l1 shift 1;
j:=j+i+1;
for i:=i step -1 until 0 do
begin
if l1<0 then j:=j+1;
l1:=l1 shift 1
end
end;
cutlay:=(-1.0) add (-1) shift (25-j) add (l1 shift (-j))
shift 6 add b shift 4 add h shift 14 add (l extract 14)
end
end cutlay
; end
\f
message digits
digits=algol message.no list.no
external
real procedure digits(z,nexp,nd);
value z; real z; integer nexp,nd;
begin
integer b,p; real a,r,roundr;
r:=abs z;
if r<=0.0 then
begin
digits:=0; nexp:=nd:=0
end
else
begin
roundr:=2**34;
p:=entier(ln(roundr*2/r)/ln10)-1;
r:=r*10**p+roundr-roundr;
b:=(if r>=1000000000 then 11 else 10);
for p:=p+1,p-1 while r*10-a=0.0 do
begin
a:=r;
b:=b-1;
r:=a/10-.5+roundr-roundr
end;
digits:=if z>0 then a else -a;
nexp:=-p;
nd:=b
end
end digits
;end
\f
message exactlay
exactlay=algol message.no list.no
external
real procedure exactlay(z,npos,zr);
value z; real z,zr; integer npos;
begin
integer b,h,d,s,fn,fe,n,p;
real r,roundr,zb;
zr:=z; h:=b:=1; d:=s:=fn:=fe:=n:=0;
if z<0 then
begin
fn:=1; z:=-z
end;
if z>0 then
begin
roundr:=2**34;
p:=entier(ln(roundr*2/z)/ln10)-1;
r:=z*10**p+roundr-roundr;
b:=(if r>=1000000000 then 10 else 9);
p:=p-b;
for b:=b+1,b-1 while r*10-zb=0.0 do
begin
zb:=r;
r:=zb/10+.5+roundr-roundr-1
end;
h:=b; p:=-p-b;
if p>2 or p<-2-b then
begin
if p<0 then fe:=1;
s:=(if abs p>99 then 3 else if abs p>9 then 2 else 1);
n:=1
end
else
begin
if p<0 then
begin
d:=-p; n:=1
end;
h:=b+p; if h<=0 then h:=1
end
end;
exactlay:=1.0 shift 29 add b shift 4 add h shift 4 add d
shift 4 add fn shift 2 add s shift 4 add fe;
npos:=n+h+d+s+fe+fn
end exactlay
; end
\f
message fixexplay
fixexplay=algol message.no list.no
external
real procedure fixexplay(lay,zref,z,zr);
value lay,zref,z; real lay,zref,z,zr;
begin
integer l,h,b,d,pref,p,r,l1,n;
fixexplay:=lay;
zr:=z;
l1:=lay shift (-24) extract 24;
h:=lay shift (-14) extract 4;
b:=lay shift (-18) extract 5;
n:=lay shift (-4) extract 2;
d:=lay shift (-10) extract 4;
r:=l:=0;
for l1:=l1 shift 1 while l1<0 do l:=l+1;
if z=0.0 then
begin
for l1:=l1 shift (-1) while l1<>0 do l:=l+l1 extract 1;
l:=33-l-h-(if n>0 then n+1 else 0)+(if lay extract 2<>0 then 0 else 1)-
(if d>0 then d+1 else 0)-(if lay shift(-6) extract 2>0 then 1 else 0);
fixexplay:=(-1.0) add (-1) shift l add 17 shift 14
end
else
if zref<>0.0 then
begin
p:=entier(ln(abs z)/ln10);
pref:=entier(ln(abs zref)/ln10);
if p<>pref then
begin
if n>0 then
begin
n:=d+h-b;
r:=-(pref-h+1) mod (n+1);
if r<0 then r:=r+3;
p:=p-pref
end
else n:=p:=p-h+1;
if p>r shift 1 then
begin
for p:=p-1 while l>0 and p>=0 do
begin
h:=h+1; b:=b+1; l:=l-1;
l1:=l1 shift (-1)
end
end
else
if p<r shift 1-n then
begin
r:=(if n>d then n-d+1 else 1);
for p:=p+1 while h>r and p<=0 do
begin
l1:=l1 shift 1;
l:=(if l1<0 then l+2 else l+1);
h:=h-1; b:=b-1
end;
if b<1 then b:=1
end;
fixexplay:=(-1.0) add (-1) shift 24 add (l1 extract 23) shift (5-l)
add b shift 4 add h shift 14 add (lay extract 14)
end
end expdel
end fixexplay
; end
\f
message laypos
laypos=algol message.no list.no
external
integer procedure laypos(lay,b);
value lay; real lay; integer b;
comment the value is the number of positions for the layout lay;
begin
integer i,pos;
pos:=0;
if lay extract 2 <> 0 then pos:=pos+1;
lay:=lay shift(-4);
pos:=pos+lay extract 2;
lay:=lay shift (-2);
if pos>0 then pos:=pos+1;
if lay extract 2 <> 0 then pos:=pos+1;
lay:=lay shift(-4);
if lay extract 4 <> 0 then pos:=pos+lay extract 4+1;
lay:=lay shift(-4);
pos:=pos+lay extract 4;
lay:=lay shift(-4);
b:=lay extract 4;
lay:=lay shift (-6);
for i:=1 step 1 until 23 do
begin
pos:=pos+lay extract 1;
lay:=lay shift (-1)
end;
laypos:=pos;
end laypos
; end
\f
message minlay
minlay=algol message.no list.no
external
real procedure minlay(z,errz,npos,zr);
value z,errz; real z,errz,zr; integer npos;
begin
integer b,h,d,fn,s,fe,p,n;
zr:=z; b:=h:=1; d:=s:=fn:=fe:=n:=0;
if z<0 then
begin
z:=-z; fn:=1
end;
if z>0 then
begin
if errz=0.0 then b:=h:=11
else
begin
if errz<0.0 then errz:=-z/errz
else errz:=1/errz;
if errz>1.0 then
begin
h:=b:=ln(errz)/ln10+.5;
if b>11 then b:=h:=11;
end
end;
p:=ln(z)/ln10-.5;
if b=11 and z*10**(-p)>3.4359738368 then b:=h:=10;
p:=p-b+1;
if p>2 or p<-1-b then
begin
if p<0 then fe:=1;
s:=(if abs p>99 then 3 else if abs p>9 then 2 else 1);
n:=1
end
else
begin
if p<0 then
begin
d:=-p; n:=1
end;
h:=b+p; if h<1 then h:=1
end
end z>0;
minlay:=1.0 shift 29 add b shift 4 add h shift 4 add d
shift 4 add fn shift 2 add s shift 4 add fe;
npos:=n+h+d+s+fe+fn
end minlay
; end
\f
message numbdigit
numbdigit=algol message.no list.no
external
integer procedure numbdigit(a,c,ar);
value a; real ar,a; integer c;
begin
integer n; real b,r,roundr;
ar:=a;
a:=abs a;
if a=0.0 then
begin
numbdigit:=0; c:=0
end
else
begin
roundr:=2**34;
r:=a*10**entier(ln(roundr*2/a)/ln10-1)+roundr-roundr;
n:=(if r>=1000000000 then 10 else 9);
for n:=n,n-1 while r*10-b=0.0 do
begin
b:=r;
r:=b/10+.5+roundr-roundr-1
end;
numbdigit:=n+1;
c:=b-10*r
end
end numbdigit
; end
\f
message origo
origo = algol message.no list.no
external
real procedure origo(zl,zh,zde);
value zl,zh; real zl,zh;
integer zde;
begin
real s,roundr,h,l;
integer p;
if zh<zl then
begin
s:=zl; zl:=zh; zh:=s
end;
if zl<0 then
begin
s:=zl; zl:=-zh; zh:=-s; s:=-1
end
else s:=1;
if zl<=0 then
begin
origo:=0; zde:=0
end
else
begin
roundr:=2**34;
p:=entier(ln(roundr*2/zh)/ln10)-1;
l:=zl*10**p; h:=zh*10**p;
for p:=p+1,p-1 while l<h or zl=10*l or zh=10*h do
begin
zl:=l; zh:=h;
h:=zh/10+.5+roundr-roundr-1;
l:=-(-zl/10-.5-roundr+roundr)
end;
zl:=zl-l*10;
if zl<0 then
begin
zl:=zl+10; l:=l-1
end;
if zh-l*10>=10 then
begin
origo:=s*(l+1)*10**(1-p); zde:=1-p
end
else
begin
zh:=zh-h*10;
if zh>=5 and 5>=zl then zl:=5
else
begin
if s<0 then
begin
h:=zl; zl:=zh; zh:=h
end;
h:=entier((zl+s)/2)*2;
if s*h<=s*zh then zl:=h
end;
origo:=(l*10+zl)*10**(-p)*s;
zde:=-p
end
end
end origo
; end
\f
message packlay
packlay=algol message.no list.no
external
boolean procedure packlay(l,b,h,d,s,type,lay);
value l,b,h,d,s; integer l,b,h,d,s; string type; real lay;
begin
integer l1,l2,v;
real r;
packlay:=false;
if l>22 or b>32 or h>15 or d>15 or s>3 or
l<0 or b<0 or h<0 or d<0 or s<0 then goto END;
l1:=(-1) shift (23-l);
l2:=b shift 4 add h shift 4 add d;
r:=real type;
v:=r shift (-32) extract 8;
l:=(if v=100 then 0 else
if v=102 then 1 else
if v=122 then 2 else
if v=98 then 3 else -1);
if l<0 then goto END;
l2:=l2 shift 2 add l;
v:=r shift (-40) extract 8;
l:=(if v=32 then 0 else
if v=45 then 1 else
if v=43 then 2 else -1);
if l<0 then goto END;
l2:=l2 shift 2 add l;
if s=0 then l2:=l2 shift 6
else
begin
v:=r shift (-24) extract 8;
if v<>39 then goto END;
v:=r shift (-16) extract 8;
l:=(if v=32 then 0 else
if v=45 then 1 else
if v=43 then 2 else -1);
if l<0 then goto END;
v:=r shift (-8) extract 8;
v:=(if v=100 then 0 else
if v=102 then 1 else
if v=122 then 2 else -1);
if v<0 then goto END;
l2:=l2 shift 2 add s shift 2 add v shift 2 add l
end;
packlay:=true;
lay:=(-1.0) add l1 shift 24 add l2;
END:
end packlay
; end
\f
message splitlay
splitlay=algol message.no list.no
external
integer procedure splitlay(lay,l,b,h,d,s,CF);
integer l,b,h,d,s; real lay; array CF;
begin
integer i,j,k,no,v,ind,l1,l2;
real r;
procedure addchar(A,val);
value val; array A; integer val;
begin
no:=no+1;
if no mod 6 = 1 then
begin
ind:=ind+1; CF(ind):=(-1.0) add val
end
else CF(ind):=CF(ind) shift 8 add val
end addchar;
CF(1):=(-1.0) add 60 shift 8 add 60; no:=2; ind:=1;
l1:=lay shift (-24) extract 24;
l2:=lay extract 24;
i:=0;
for l1:=l1 shift 1 while l1<0 do
begin
i:=i+1; addchar(CF,32)
end;
k:=l:=i;
i:=l2 shift (-6) extract 2 +1;
v:=case i of (32,45,43);
if v<>32 then addchar(CF,v); r:=(-1.0) add v;
i:=l2 shift (-8) extract 2+1;
v:=case i of (100,102,122,98);
addchar(CF,v); r:=r shift 8 add v;
h:=i:=l2 shift (-14) extract 4;
b:=l2 shift (-18) extract 5; j:=b-1;
for i:=i-1 step -1 until 1 do
begin
l1:=l1 shift 1;
if l1<0 then addchar(CF,32);
addchar(CF,if j>0 then 100 else 48);
j:=j-1
end;
d:=i:=l2 shift (-10) extract 4;
if i>0 then
begin
addchar(CF,46);
for i:=i step -1 until 1 do
begin
l1:=l1 shift 1;
if l1<0 then addchar(CF,32);
addchar(CF,if j>0 then 100 else 48);
j:=j-1
end
end;
s:=i:=l2 shift (-4) extract 2;
if i<=0 then lay:=r shift 32
else
begin
addchar(CF,39); r:=r shift 8 add 39;
j:=l2 extract 2 +1;
v:=case j of (32,45,43);
if v<>32 then addchar(CF,v); r:=r shift 8 add v;
j:=l2 shift (-2) extract 2 + 1;
v:=case j of (100,102,122);
addchar(CF,v);
lay:=r shift 8 add v shift 8;
for i:=i-1 step -1 until 1 do addchar(CF,100)
end;
splitlay:=no-2;
addchar(CF,62);
for no:=no while no mod 6 <> 0 do addchar(CF,0);
end splitlay
; end
\f
message writelay
writelay=algol message.no list.no
external
procedure writelay(z,lay);
value lay; real lay; zone z;
begin
integer i;
array A(1:11);
cleararray(A);
splitlay(lay,i,i,i,i,i,A);
i:=1;
write(z,A(increase(i)));
end writelay
; end
▶EOF◀