DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »gonimfit2«

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

TextFile

;gosav time.200
gopr=set 50
permanent gopr.17
o gopr
s=edit gonimfit
d,g1/funclinda/nimlinda/,l./algol/,s,f
i s
nimlinda=algol fittt index.no list.yes
r=edit algfuncfit
l./list./,r/t.no/t.yes/,
l./B, nl/,i/
real timebase, time, stoptime;
/,l./outmed/,d,i/
read(in,time);
if time>0 then begin /,l1,r/;  n/ end
else begin
  open(res,4,<:nimtrack:>,0); inrec(res,128);
  N:= res(1) shift (-24) extract 24; p:= res(1) extract 24;
  nt:= res(2) shift (-12) extract 12;
  nf:= res(2) extract 12;
  for i:=1 step 1 until 12 do head(i):= res(i+2)
end;
n/,l./write/,d,l./read/,i/
if time>0 then begin
closeres:= outmedium(res);
/,l./127 else 124/,r/127/112/
l3,i?
end else begin
B:= false add (res(2) shift (-36) extract 12);
continue:= false add (res(2) shift (-24) extract 12);
yzero:= false;
S:= Sold:= res(15);
i:= nt+nt+p+2; k:= (i+3)//4; m:= k*4-i; j:= k+15;
if m<>0 then begin m:= -m*12; res(j):= res(j) shift (-m) end;
for i:=p+2 step -1 until 1 do begin
  space(i):= res(j) shift m extract 12; m:= m-12;
  if m<-36 then begin j:= j-1; m:= 0 end end;
for i:=nt step -1 until 1 do begin
  cif(i):= res(j) shift m extract 12; m:= m-12;
  if m<-36 then begin j:= j-1; m:= 0 end end;
for i:=nt step -1 until 1 do begin
  no(i):= res(j) shift m extract 12; m:= m-12;
  if m<-36 then begin j:= j-1; m:= 0 end end;
k:= k+15;
for i:=p+2 step -1 until 1 do layout(i):= res(k+i);
k:= k+p+2;
for i:=1 step 1 until nt do pm(i):= res(k+i);
k:= k+nt;
for i:=1 step 1 until n do
for j:=1 step 1 until n do begin
  if k=128 then begin k:= 0; inrec(res,128) end;
  k:= k+1; A(i,j):= res(k)
end;
for i:=1 step 1 until N do
for j:=1 step 1 until p+2 do begin
  if k=128 then begin k:= 0; inrec(res,128) end;
  k:= k+1; point(i,j):= res(k)
end;
close(res,true);
closeres:= outmedium(res);
end;
i:= 1;
if continue then
  write(res,<:<12>:>,nl,3,string head(increase(i)),nl,3);
systime(1,0,timebase); stoptime:= abs time; time:= 0;
?,l./<:Error/,l-2,d3,i/
   forceout(res);
/,l./Cor/,r/nl,1/nl,2/,
l./:x:/,r/<:x:>,<<d>,j/case j of (<:m :>,<:J":>,<:k":>,<:J':>,<:k':>)/,
l./<:obs/,r/+2/-2/,l3,r/-6/-10/
l2,i/
forceout(res);
/,l./funclinda/,r/func/nim/,l./+-:>/,r/4/0/,l./pm(k)+A/,i/
    if k=4 and A(j,n+1)>10 then begin
      zone z(128,1,stderror); integer array tail(1:10);
      open(z,4,<:nimev:>,0);
      monitor(42,z,0,tail); tail(10):= 0;
      monitor(44,z,0,tail)
    end;
/,l-5,d5,l./Sold>S/,r/S or/S*1.01 or/,
l2,i?
  y:= time; systime(1,timebase,time);
  write(res,<<   dddd>,time-y,stoptime-time,nl,4);
  if time-y>stoptime-time or -,continue then begin
    zone z(128,1,stderror);
    integer array tail(1:10);
    open(z,4,<:nimtrack:>,0);
    l:= 17+(nt+nt+p+5)//4+p+nt+n*n+N*(p+2);
    j:= (l+127)//128;
    i:= monitor(42,z,0,tail);
    if i=0 and j<>tail(1) then begin
      monitor(48,z,0,tail); i:= 2 end;
    if i<>0 then begin
      for i:=2 step 1 until 10 do tail(i):= 0;
      tail(1):= j; monitor(40,z,0,tail); monitor(50,z,17,tail);
    end;
    outrec(z,128); z(1):= 0.0 shift 24 add N shift 24 add p;
    z(2):= 0.0 shift 12 add (if B then 1 else 0) shift 12 add
     (if continue then 1 else 0) shift 12 add nt shift 12 add nf;
    z(15):= S;
    for i:= 1 step 1 until 12 do z(i+2):= head(i);
    j:= 0; k:= 16;
    for i:=1 step 1 until nt do begin
      if j=4 then begin j:= 0; k:= k+1 end;
      z(k):= z(k) shift 12 add no(i); j:= j+1
    end;
    for i:=1 step 1 until nt do begin
      if j=4 then begin j:= 0; k:= k+1 end;
      z(k):= z(k) shift 12 add cif(i); j:= j+1
    end;
    for i:=1 step 1 until p+2 do begin
      if j=4 then begin j:= 0; k:= k+1 end;
      z(k):= z(k) shift 12 add space(i); j:= j+1
    end;
    for i:=p+2 step -1 until 1 do z(k+i):= layout(i);
    k:= k+p+2;
    for i:=1 step 1 until nt do z(k+i):= pm(i);
    k:= k+nt;
    for i:=1 step 1 until n do
    for j:=1 step 1 until n do begin
      if k=128 then begin k:=0; outrec(z,128) end;
      k:= k+1; z(k):= A(i,j)
    end;
    for i:=1 step 1 until N do
    for j:=1 step 1 until p+2 do begin
      if k=128 then begin k:= 0; outrec(z,128) end;
      k:= k+1; z(k):= point(i,j)
    end;
    close(z,true);
    if time-y>stoptime-time then begin
      l:= 0; k:= psubmit(<:gocont:>,l);
      if k=0 then write(res,<:Continued in job nr. :>,<<dddd>,l,nl,1);
      closeout; goto slut end
  end;
?,l./l:= 14+nt/,r/14+/1+/,r/+(p+1)*N//,l10,d3,i/
res(1):= 0.0 shift 12 add n;
/,l2,r/+14/+1/
l./A(/,r/i,j)/i,j)*S;/,l2,d7,f
i r
rename funcfit.nimfit
permanent nimfit.17
▶EOF◀