DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »openentrytx«

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

;       open_entry_tx         * page 1    8 03 79,  9.23;  

if listing.yes
char 10 12 10
 

openentry=set 36
openentry=algol
external
  integer procedure open_entry(zn, name);  
  zone                         zn;  
  long array                       name;  
  begin

    comment

    open_entry  (return, integer)  The result from a lookup on
    _                              the specified entry.

    zn          (call, zone)       Zone to the specified entry.

    name        (call, long array) The name of the entry.

    The procedure performs a lookup on the specified entry
    <name> and determines a modekind and in case of a non-area
    entry the name of the document, for a later call of
    open(zn, modekind, ....).

    If the name is a non-area entry, file_nbr and block_nbr
    is generated for a later call of
    setposition(zn, file_nbr, block_nbr).

    If the return value of open_entry differ from 0 (zero) a
    warning is printed on current output, and the expected
    call of open(...) will not be executed.

    Programmer Erik Hansen, Topografisk Afdeling  06-03-79  ;  

\f



comment open_entry_tx         * page 2    8 03 79,  9.23
0 1 2 3 4 5 6 7 8 9 ;  

    integer i;
    integer array tail(1:10);  
    long array scope(1:2);  

    scope(1) := long<::>;  
    i := lookup_proc(scope, name, tail);  

    if i = 0 then
    begin
      integer modekind, fileno, blockno;
      long array la(1:2);  

      if tail(1) >= 0 then
      begin  <** area entry **>
        to_from(la, name, 8);  
        modekind := 4;  
        fileno   := 0;  
        blockno  := 0;  
      end
      else
      begin  <** non-area entry **>
        long array field laf;  
        laf := 2;  
        to_from(la, tail.laf, 8);  
        modekind := tail(1) shift 1 shift (-1);  
        fileno   := tail(7);  
        blockno  := tail(8);  
      end;  

      open(zn, modekind, la, 0);  
      setposition(zn, fileno, blockno);  
    end;  
    open_entry := i;  
    if i > 1 then
    write(out, nl, 1, <:**open<95>entry warning, :>, name, 
    case (i-1) of (<: cat i/o error:>, 
    _              <: not found:>, <::>, <::>, 
    _              <: name format illegal:>), <:, open skipped:>);  
  end;  
end;  
 
if ok.no
mode warning.yes

if warning.yes
(mode 0.yes
message openentry not ok
lookup openentry)

end

finis
▶EOF◀