|
|
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: 1536 (0x600)
Types: TextFile
Names: »origotxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »origotxt«
└─⟦this⟧ »tplot/origotxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦dd2c1b53f⟧ »tplot«
└─⟦this⟧
lookup origor
if ok.yes
(scope temp origor
clear temp origor)
origor=set 5
message origor
origor = algol message.no list.no
external
real procedure origor(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
origor:=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
origor:=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;
origor:=(l*10+zl)*10**(-p)*s;
zde:=-p
end
end
end origor
; end
▶EOF◀