⟦6401cb959⟧

TextFile


\f


external
procedure protect_cf(z, action);
zone                 z;
integer                 action;
comment
    the procedure maintains short_clock and update_mark in
    tail(6) and tail(7) of the catalog entry.

    the procedure is also used for alarmprinting of zone and
    share-descriptors and current records and chainstates.

    parameters:

        z               (call value, zone) must be opened to the
                        file concerned.
        action          (call and return value, integer) defines
                        the call case.

    call-situations and actions:

    action              situation and action

        1               called from open_cf:
                        lookup catalog entry and check that no up-
                        datemark is present.

        2               called from update-all-cf or read-upd-cf 
                        before call of set-mode-n or update-i-proc,
                        if old mode was read-only.
                        reserve area process to prevent others from
                        changing  the catalog entry.
                        lookup catalog entry, check that no update-
                        mark is present.
                        insert shortclock in tail.
                        update-mark:= 1.

        3               called from read-only-cf or close-cf after
                        check of all transports back to the file, if
                        the state before was some update state.
                        lookup catalog entry, check that update-mark 
                        is present, and remove it.

      > 3               procno shift 12 add alarmno.
                        protectcf will print various states concerning
                        this zone and mothers and daughters if the current
                        pointers to such zones are set.
;
\f


begin

  integer
      b5,
      b9,
      b15,
      b19,
      b20,
      cfbufref,
      currdch,
      fileno,
      i,
      resultm;

  real  r;

  integer array
      tail(1:10),
      zonedescr(1:20);

  integer field
      shortclock,
      update_mark;

  long array field
      filename;

\f


    procedure alarm(n);
    integer         n;
    comment
        the procedure writes out a common headline, and jumps to
        the label general_alarm with the value of n assigned to i;
    begin
      write(out, <:<10><10>***protectcf  alarm:<10><10>file   ::>,
                 <<-ddddddd>, fileno, <:    :>,
                 zonedescr.filename,
                 <:        d.:>,
                 <<zddddd>,
                 systime(6, tail.shortclock, r),
                 <:.:>,<<zddd>, r/100,
                 <:<10>:>);
      i:= n;
      goto general_alarm;
    end alarm;
\f


  procedure  alarmprint;
  comment
    performs all the alarmprinting for normal cf errors;
  begin
    integer
      currmch,
      savecfbufref;

    write(out, << dddd>,
               <:<10><10>***cfsystem  alarm::>, action extract 12,
                <:    procno::>, action shift(-12));

    savecfbufref:= cfbufref;

  <* print this zone and its mothers *>

    repeat
      currdch := if word(b15) extract 1 = 0 <* master *> then  0
                else  word(b20);

      printcfzone;
      cfbufref:= if currdch > 0 then  word_abs(currdch + 2) else  0;
    until  cfbufref <= 0;

    cfbufref:= savecfbufref;

  <* print daughters *>

    for currmch:= word(b19) while currmch > 0 do
    begin
      currdch := word_abs(currmch);
      cfbufref:= word_abs(currmch + 2);
      if cfbufref <= 0 then  goto return;

      printcfzone;
    end  print daughters;

return:
    write(out, <:<10>:>);
  end  alarmprint;

\f


  procedure  printcfzone;
  comment
    the entry parameters for this procedure are the following global
    integer variables:
      cfbufref
      currdch
    they are used as entry to the printing of various interesting
    details.
  ;
  begin
    integer
      filenotype,
      i,
      recbase,
      recbaseadr,
      reclength;

    integer array
      ia(1:20), ia1(1:7);

    filenotype:= word(b15);
    recbaseadr:= word(b5 ); <* pointer to zone descriptor *>
    system(5, recbaseadr - 26, ia); <* pseudo getzone *>
    recbase   := ia(14);
    reclength := ia(16);

    write(out, <<-ddddddd>,
               <:<10><10>file   ::>, filenotype shift(-4),
               <:    :>, ia.filename);

    system(5, recbaseadr - 16, ia);
    system(5, recbaseadr - 36, ia1);
    ia(2):= cfbufref;
    ia(3):= recnocf ;
    for i:= 1 step 1 until 5 do  ia(11+i):= ia1(i);
    printint(<:zone:>, 32, ia);

  <*  print sharedescriptors *>
    for i:= ia(15) step 24 <* sh.descr.length *> until ia(16) do
    begin
      system(5, i, ia1);
      printint(<:share:>, 14, ia1);
    end  shares;
\f


    if reclength > 1 then
    begin
      i:= if reclength > 80 then  80 else  reclength;
      begin
        integer array  rec(1:i shift(-1));
        system(5, recbase + 1, rec);
        printint(<:current:>, i, rec);
      end;

      i:= word(b9); <* chainpartsize *>
      if i > 1 then
      begin
        integer array chainpart(1:i shift(-1));
        system(5, recbase + reclength + 1, chainpart);
        printint(<:ch.part:>, i, chainpart);
      end;
    end  reclength > 0;

  <* print current daughterchain table, only listfile *>

    if currdch > 0 then
    begin
      system(5, currdch, ia);
      ia(4):= ia(4) shift(-12); <* chainnumber *>
      i:= ia(6) + 18;
      printint(<:ch.tab.:>, if i > 40 then  40 else  i, ia);
    end  currdch > 0;
  end  printcfzone;


\f


  procedure  printint(text, length, iarr);
  value  length; integer  length;
  string  text; integer array  iarr;
  comment
    prints the text on a new line, and after that the contents of
    iarr as integers;
  begin
    integer  pos;
    integer  field  ifld;

    pos:= write(out, <:<10>:>, text);
    write(out, false add 32, 8 - pos, <:::>);
    pos:= 9;
    for ifld:= 2 step 2 until length do
    begin
      if pos > 65 then
         pos:= write(out, <:<10>       ::>);
      pos:= pos + write(out, <<-ddddddd>, iarr.ifld);
    end;
  end  printint;



  integer procedure  word(reladr);
  value  reladr; integer  reladr;
  comment
    returns the value of the word of reladr to cfbufref;
  begin
    word:= word_abs(cfbufref + reladr);
  end  word;



  integer procedure  word_abs(absadr);
  value  absadr; integer  absadr;
  comment
    returns the value of the word of the absolute address absadr;
  begin
    integer array  core(1:1);
    system(5, absadr, core);
    word_abs:= core(1);
  end  word_abs;

\f



  procedure  call_monitor(n);
  value  n; integer  n;
  begin
    resultm:= monitor(n, z, 0, tail);
    if resultm <> 0 then
    begin
      if n >= 42 then  alarm(if n = 42 then  1 else  2);
    end  not ok;
  end  call_monitor;
\f


  comment
      initialize field-variables;

    shortclock      := 12;
    update_mark     := 14;

    filename        :=  2;

  comment
      init slang names, as in cf code;


    b5 := 14;
    b9 := 20;
    b15:= 24;
    b19:= 28;
    b20:= -2;

  comment
      getzone is always called;

    getzone6(z, zonedescr);
\f


    i:= zonedescr(13); <* zonestate *>
    if action < 1 or i < 16 or i > 24 then  goto return;

    i:= zonedescr(19); <* basebufferadr *>
    cfbufref:= i + word_abs(i + 3);

    if action > 3 then
    begin
      alarmprint;
      goto return;
    end  alarmprint;

    fileno:= word(b15) shift(-4);


    i:= 0;
    if action = 2 then
    begin
    comment  2, update, try to reserve area process to prevent others
                        from changing the entry;
      call_monitor(8); <* reserve process *>
      i:= resultm;
    end  2;

  comment  lookup entry;

    tail.shortclock:= 0;
  comment    0 is printed in alarm if lookup fails;

    call_monitor(42); <* lookup *>

  comment  check result of reservation above;
    if i<>0 then
    begin
      resultm:= i;
      alarm(3);
    end  reservation error;

\f


    case action of
    begin

    comment  1,  from open-cf;
      begin
        if tail.update_mark <> 0 then alarm(4);
      end  1;

    comment  2,  switch to update;
      begin
        if tail.update_mark <> 0 then alarm(4);
        tail.shortclock:= systime(7, 0, r);
        tail.update_mark:= 1;
        call_monitor(44); <* change entry *>
      end  2;

    comment  3,  switch to read_only;
      begin
        if tail.update_mark <> 1 then alarm(4);
        tail.update_mark:= 0;
        call_monitor(44); <* change entry *>
        call_monitor(10); <* release process = cancel reservation *>
      end  3
  
    end  case action;

    goto return;


general_alarm:
    system(9,
      if i < 4 then  resultm else  tail.update_mark,
      case i of (
        <:<10>lookup  :>,
        <:<10>change  :>,
        <:<10>reserve :>,
        <:<10>upd.mark:>));

return:
end protect_cf;
end
end

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦6401cb959⟧ TextFile

Derivation

TextFile
