DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »lookupprotx«, »lookupprotx «

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »lookupprotx « 
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦592c22808⟧ »proctxpack  « 
            └─⟦c7b1c7cfc⟧ 
                └─⟦this⟧ »lookupprotx« 

TextFile

;       lookup_proc            * page 1   19 01 82, 12.54;  

;  ***********

if listing.yes
char 10 12 10

lookup_proc = set 1 0

lookup_proc = algol

external integer procedure lookup_proc(scope, name, tail);  
  _________________________________________________________
  long array scope, name;  
  integer array tail;  
  <*
  lookupproc  (return, integer)  0  found
  _                              1  the call param scope does not
  _                                 contain a legal scope name
  _                              2  cat i/o error
  _                              3  not found
  _                              6  name format illegal

  scope       (call, long array)  contains the name of a scope or <::>
  _                              if scope(1)=long<::> then scope will be
  _                              a return parameter, which may be <:***:>

  name        (call, long array)  contains the name of the entry

  tail        (return, integer array)
  _                              contains tail of the entry
  _                              1     size or modekind
  _                              2:5   docname
  _                              6     shortclock, in case shortclock
  _                                    is found in the entry
  _                              7:10  remaining tail
  *>
  begin integer scopeno, i;  
    long l1, l2;  
    integer array bases(1:8), ba(1:2), head_and_tail(1:17);  
    zone zhelp(1, 1, stderror);  
    lookupproc:=0;  
    scopeno:=if scope(1)=long<::>      then 0 else
    if scope(1)=long<:temp:>  then 1 else
    if scope(1)=long<:login:> then 2 else
    if scope(1)=long<:user:>  then 3 else
    if scope(1)=long<:proje:> add 99 and
    scope(2)=long<:t:> then 4 else
    if scope(1)=long<:syste:> add 109 then 5 else 6;  
    if scopeno=6 then
    begin
      lookupproc:=1;  
      goto zeros
    end;  
    system(11, i, bases);  
    open(zhelp, 0, <::>, 0);  close(zhelp, true);  
    i:=if scopeno<3 then 3 else if scopeno=3 then 5 else 7;  
    ba(1):=bases(i);  ba(2):=bases(i+1);  
    monitor(72<*set cat base*>, zhelp, 0, ba);  
    i:=1;  open(zhelp, 0, string name(increase(i)), 0);  

\f



comment lookup_proc            * page 2   19 01 82, 12.54;  

    i:=monitor(76<*head and tail*>, zhelp, 0, head_and_tail);  
    if i<>0 then
    begin
      lookupproc:=i;  
      goto zeros
    end;  
    if scopeno>0 and scopeno<5 and (
    extend head_and_tail(2)<>extend ba(1) or
    extend head_and_tail(3)<>extend ba(2)) then goto lookup_not_found;  

    i:=head_and_tail(1) extract 3;  
    if scopeno=1 and i<>0 or
    scopeno=2 and i<>2 or
    scopeno>2 and i<>3 then goto lookup_not_found;  
    if scopeno=5 then
    begin
      if -, (extend head_and_tail(2)<extend ba(1) or
      extend head_and_tail(3)>extend ba(2)) then
      goto lookup_not_found
    end;  
    if false then
    begin
      lookup_not_found:
      lookupproc:=3;  
      zeros:
      for i:=1 step 1 until 10 do tail(i):=0;  
      goto if scopeno=6 then exit_lookupproc else reset_base;  
    end;  
    if scopeno=0 then
    begin
      case i+1 of
      begin

        comment key 0, maybe temp;  
        if extend head_and_tail(2)=extend bases(3) and
        extend head_and_tail(3)=extend bases(4)
        then scopeno:=1 else scopeno:=6;  

        comment key 1;  scopeno:=6;  

        comment key 2, maybe login;  
        if extend head_and_tail(2)=extend bases(3) and
        extend head_and_tail(3)=extend bases(4)
        then scopeno:=2 else scopeno:=6;  

        comment key 3, user, project, system;  
        begin
          l1:=head_and_tail(2);  
          l2:=head_and_tail(3);  
          if l1=extend bases(5) and
          l2=extend bases(6) then scopeno:=3
          else
          if l1=extend bases(7) and
          l2=extend bases(8) then scopeno:=4
          else
          if l1<=extend bases(7) and
          l2>=extend bases(8) then scopeno:=5
          else scopeno:=6
        end key 3;  
      end cases;  
      scope(1):=long(case scopeno of (<:temp:>, <:login:>, <:user:>, 
      <:proje:> add 99, <:syste:> add 109, <:***:>));  
      scope(2):=if scopeno=4 then long<:t:> else long<::>;  
    end;  

\f



comment lookup_proc            * page 3   19 01 82, 12.54;  

    monitor(42<*lookup*>, zhelp, 0, tail);  
    reset_base:
    close(zhelp, false);  
    open(zhelp, 0, <::>, 0);  
    monitor(72<*set cat bases*>, zhelp, 0, bases);  
    exit_lookupproc:
  end lookup_proc;  

end

if ok.no
mode warning.yes

if warning.yes
(mode 0.yes
message lookup_proc not ok
lookup lookup_proc)
▶EOF◀