DataMuseum.dk

top - metrics - download

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

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

TextFile

;       set_adj_area_tx       * page 1    3 08 79, 15.14;  

;  set_adj_area
;  ************

if listing.yes
char 10 12 10

set_adj_area = set 1

set_adj_area = algol

external integer procedure set_adj_area
_______________________________________
_        (set, out, fnm_txt, adj_fnm, content);  
value     set,                        content;  
boolean   set;  
zone           out;  
string              fnm_txt;  
array                        adj_fnm;  
integer                               content;  

comment

set_adj_area       (call and return integer proc)
creates a file of 2 segments (or a full slice) on disc1
any document with scope lower than or including user
will be modified and used instead of the desired file.
The value of set_adj_file is the value of set_bs_area.
However if set is false, no file is generated, and the 
value is 0.

set               (call, boolean)
if true, a file is generated, otherwise not.

out                (call and return, zone)
the zone is used for text-output, must be open and
ready for char output.

fnm_txt            (call, string)
the text is output preceeded by a nl and followed by an =, 
an empty string suppresses all typed output from the
procedure.

adj_fnm            (call, array)
the desired name of the file

content            (call, integer)
the value is inserted as the content key of the file
descriptor (most signf byte of tail(9)).

ext proc used:
set_bs_area
lookup_proc

prog: Knud Poder, AUG 1979

;  

\f



comment set_adj_area_tx       * page 2    3 08 79, 15.14
0 1 2 3 4 5 6 7 8 9 ;  

begin

  long    array field   n_f, kit_f;  

  integer               result, t, i;  

  integer array         entry(1:10);  

  long   array          scope(1:2), kit(1:14);  

  _
  comment lookup;  
  _______________
  scope(1) :=
  scope(2) := 0;  
  n_f      := 0;  
  kit_f    := 2;
  result   := lookup_proc(scope, adj_fnm.n_f, entry);  

  _
  comment set entry;  
  __________________
  if set then
  begin

    _
    comment set params for create or change;  
    ________________________________________
    if result <> 0
    or  scope(1) = long <:syste:> add 109 <*m*>
    or (scope(1) = long <:proje:> add  99 <*c*> 
    and scope(2) = long <:t:>)        then
    begin
      scope(1)       := long <:user:>;  
      scope(2)       := 0;  
      entry.kit_f(1) := long <:disc5:>;  
      entry.kit_f(2) := 0;  
    end;  

kit(1) := entry.kit_f(1);
kit(2) := entry.kit_f(2);

i := 1;
for t := 1 step 1 until 7 do
begin
i := i + 2;
kit(i)   := long(case t of (
<:disc5:>,
<:disc4:>,
<:disc3:>,
<:disc2:>,
<:disc1:>,
<:disc:>,
<::>));
kit(i+1) := 0;
if kit(i) = kit(1) then i := i - 2;
end;
 
kit(13) :=
kit(14) := 0;

comment  * page ;
    _
    comment create or change file;  
    ______________________________
    set_adj_area := set_bs_area(adj_fnm.n_f, 
    _                           kit, 
    _                           scope, 
    _                           2, 
    _                           content shift 12 + 1 shift 2, 
    _                           true);  
    lookup_proc(scope, adj_fnm.n_f, entry);  
  end
  else
  set_adj_area := 0;  

  _
  comment file report;  
  ____________________
  if (if long fnm_txt <> 0 then (set or result = 0)
  else false) then
  write(out, sp, 15 - write(out, nl, 1, fnm_txt, <:_=_:>), 
  _     adj_fnm.n_f, <<dddddddd>, entry(1), <:_segm__:>, 
  _     entry.kit_f, <:_scope_:>, scope, nl, 1);  
end set_adj_area;  

end

\f




if ok.no
mode warning.yes

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

end

finis
▶EOF◀