|
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◀