DataMuseum.dk

top - metrics - download

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

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦80900d603⟧ »giprocfile« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦80900d603⟧ »giprocfile« 
            └─⟦this⟧ 

TextFile

checkfpcall = set 1

checkfpcall=algol

external
boolean procedure check_fp_call(item);
integer item;   <*retur: Hvis fp_kaldet ikke har korrekt syntax, returneres
                  'false' i 'check_fp_call' og item vil da indeholde nr.
                  på det fejlbehæftede elem i kaldet.
                  Ellers returneres sand, og item vil da indeholde antal
                  elem i kaldet *>
begin
  integer sepleng, sep  ,leng,   i;
  array ar(1:2);

  procedure next;
  begin
    item:=item+1;
    sepleng:=system(4,item,ar);
    sep:=(extend sepleng) shift (-12) extract 24;
    leng:=sepleng extract 12;
  end;

  item:=-1;
  next;

  if -,((sep=2 ! sep=0) & leng=10) then
  begin
    check_fp_call:=false;
    goto ud;
  end;

  next;

  if sep=6 & leng=10 then
  begin

    <*item0 var resultfile, dette er prog.kald*>
    next;

    if sep=4 & leng=10 then goto lab1
    else
    begin
      check_fp_call:= sepleng=0;
      goto ud;
    end;
  end

  else if sep=4 & leng=10 then goto lab1

  else
  begin
    check_fp_call:= sepleng=0;
    goto ud;
  end;

lab1:
  next;

  if sep=4 & leng=10 then next

  else if sepleng=0 then
  begin
    check_fp_call:=true;
    goto ud;
  end;

lab2:
  if -,(sep=8 & (leng=10 ! leng=4)) then
  begin
    check_fp_call:=false;
    goto ud;
  end;

  for i:=1 while  sep=8 & (leng=10 ! leng=4) do next;

  if sep=4 & leng=10 then
  begin
    next;
    goto lab2;
  end;

  check_fp_call:= sepleng=0;

ud:
end;
end.
end
finis
▶EOF◀