DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »fpparamtx«

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

fp_param = set 1


fpparam=algol

external
boolean procedure fp_param(paramname,descriptor,result);
array paramname;         <*kald: navnet på den ønskede parameter*>
integer array descriptor; <*retur: se dokumentation *>
array result;             <*retur:       -''-       *>

begin
  integer sepleng,sep,leng,  item,  i,desc_i,res_i,
          low1,low2,high_desc,high_res;
  boolean found;
  array ar(1:2);
  boolean oneword; integer ws;

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

  if -,check_fp_call(i) then
  begin
    fp_param:=false;
    goto ud;
  end;

  oneword:= paramname(1) extract 8 = 0  or
     paramname(2) shift (-40) extract 8 = 0;
  for i:= -40 step 8 until 8 do
  if paramname(if oneword then 1 else 2) shift i extract 8 = 0 then
  begin
    ws:= i-8;
    i:=8;
  end;

  <*check array grænser*>
  low1:=system(3,high_desc,descriptor);
  low2:=system(3,high_res,result);
  if low1<>1 or low2<>1 then
  begin
    for i:=low1 step 1 until high_desc do descriptor(i):= 0;
    if low1<=1 then descriptor(1):=-1;
    goto grænsefejl;
  end;

  for i:=1 step 1 until high_desc do descriptor(i):= 0;




  item:=0; next; <*hent item nr 1*>

  if sepleng=0 then
  begin
    fp_param:=false;
    goto ud;
  end;

  if sep=6 & leng=10 then next;

  if sepleng=0 then
  begin
    fp_param:=false;
    goto ud;
  end;

  <*check om dette er 'current input' eller 1. param*>
  next;
  if sepleng=0 then
  begin
    fp_param:=false;
    goto ud;
  end;

  if sep=8 then
  begin
    item:=item-2;
    next;
  end;

  <*vi har nu 1. parameter i hånden*>
next_param:
  found:= if oneword
      then paramname(1) shift ws = ar(1) shift ws
      else paramname(1)=ar(1) & paramname(2) shift ws = ar(2) shift ws;
  if -, found then
  begin

    next;

    for i:=1 while sep=8 do next;

    if sepleng=0 then
    begin
      fp_param:=false;
      goto ud;
    end

    else goto next_param;
  end;

  <*den rigtige parameter er fundet*>

  desc_i:=2;  res_i:=1;
  descriptor(1):=0;

  next;

  for i:=1 while sep=8 do
  begin

    descriptor(1):=descriptor(1)+1;

    if desc_i>high_desc then
    begin
      descriptor(1):=-1;
      goto grænsefejl;
    end;

    descriptor(desc_i):= if leng=4 then 1 else
            if ar(1)=real<:yes:> or ar(1)=real<:no:> then 3 else 2;

    case descriptor(desc_i) of
    begin

      <*tal*>
      begin
        if res_i>high_res then
          begin descriptor(1):=-1; goto grænsefejl; end;
        result(res_i):=ar(1);
        res_i:=res_i+1;
      end;

      <*navn*>
      begin
        if res_i+1>high_res then
          begin descriptor(1):=-1; goto grænsefejl; end;
        result(res_i):=ar(1);
        result(res_i+1):=ar(2);
        res_i:=res_i+2;
      end;

      <*boolean*>
      begin
        if res_i>high_res then
          begin descriptor(1):=-1; goto grænsefejl; end;
        result(res_i):= 0.0 shift 48 add
          (if ar(1)=real<:yes:> then 1 else 0);
        res_i:=res_i+1;
      end;

     end case;

     desc_i:=desc_i+1;

    next;

  end;

grænsefejl:
  fp_param:= true;

ud:
end;
end.
end
finis
▶EOF◀