DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦63e8cc7df⟧ TextFile

    Length: 1536 (0x600)
    Types: TextFile
    Names: »origotxt«

Derivation

└─⟦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⟧ 

TextFile

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◀