DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »extformat«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦58ca399f1⟧ »extbib« 
            └─⟦this⟧ 

TextFile

format=algol list.yes index.no
external
real procedure format(length,digits,a,lda);
value a; integer length,digits; real a,lda;
begin
integer b,d,h,fn,fe,s,ex,i,sp; real man,y; boolean rl;
if a=0 then begin
  h:= b:= 1; d:= s:= fe:= fn:= 0; sp:= length;
end else begin
ex:= entier(ln(abs a)/ln10);
rl:= length>0 or ex=0; length:= abs length;
man:= abs a*10**(-ex);
if digits=0 then begin
  y:= man - round man; b:= 0;
  for b:=b+1 while abs y>10**(b-10) do begin
    man:= (man-entier man)*10; y:= man - round man
end end else b:= digits;
h:= if ex<0 then 1 else ex+1;
d:= if ex<0 then b-ex-1 else if h>b then 0 else b-h;
fn:= if a<0 then 1 else 0;
sp:= h+d+fn; if d=0 then sp:= sp-1;
if rl and sp+3<=length then begin
  sp:= length-sp;
  s:= fe:= 0
end else begin
  s:= if abs ex>9 then 2 else 1;
  fe:= if ex<0 then 1 else 0;
  i:= b+fn+s+fe+1;
  if -,rl or sp>i then begin
    if i+3>length then length:= i+3;
    h:= 1; d:= b-1; sp:= length-i
  end else begin
    fe:= s:= 0; length:= sp+3; sp:= 3
end end end;
for i:=1 step 1 until sp do y:= y shift 1 add 1;
i:= if sp<5 then 0 else 4;
lda:= y shift (-i) shift (30+i-sp) add 2 shift 4 add (h+i+fn)
        shift 4 add d shift 10;
y  := y shift (30-sp) add b shift 4 add h shift 4
        add d shift 4 add fn;
if s>0 then begin
  format:= y shift 2 add s shift 4 add fe;
  digits:= ex
end else begin
  format:= y shift 6;
  digits:= 0
end end;
end
ftest=algol list.yes

begin
integer l,l1,ex; real a,da,lda;
igen:
read(in,l); l1:= abs l;
if l>0 then begin
  read(in,ex,a,da);
  write(out,<:<10>:>,false add 33,l1,<:<10>:>,
        string format(l,ex,a,lda),a,<:a<10>:>);
write(out,string lda,da*10**(-ex));
if ex<>0 then write(out,<:':>,<<d>,ex);
write(out,<:da<10>:>,false add 33,l);
  setposition(out,0,0);
  goto igen
end end;

ftest
5 2 12 12345
5 5 12345 12
10 2 12 123456789
10 5 12345 123456
16 5 12345 12
16 5 12345 123456789
16 5 12345 12345678
16 5 12345 1234567
16 5 12345 123456
0
▶EOF◀