⟦f99f6cc1d⟧

TextFile

r=edit tcf
l./page 0.1/, l1, i/
;
; release 12.1, 18.10.79
/,
l./page 0.14/, r/10.09.71/20.04.79/,
l./for simple address calc/,
d./;first line after copy./,
i/
æ12æ
; rc  10.09.79  rc8000  code procedure  connected files      page  0.15
;
;
b. i15
w.
;          isq version 12
;
i0=0
i1=i0+14
i2=i1+20
i10=18
i3=i2+26
i4=i3+i10
i5=i4+i10
/,
l./page 2.8/, r/28.10.74/20.04.79/,
l./al w1 -20/, g/20/14/,
l 2, d./this is not/,
d, r/20/14/,
l 1,
d./4<12+real/,
i/
      dl  w0  x1+14+12    ;   move formals.2
/,
l./a0: al w1 13/
d2
l./page 3.4/, r/18.10.78/20.04.79/,
l./a3:/, g/20/14/,
l 2, d 3, r/20/14/,
l 1, d./4<12+/,
i/
      dl  w0  x1+14+12    ;   move formals.2
/,
l./page 3.5/, r/26.09.72/20.04.79/,
l./c0: 4<12/, d,
l./page 4.1/, r/21.04.71/10.09.79/,
l./j150/, r/j150/j185/,
l./g2=/, i/
j185: f1 +85, 0           ; rs, current activity
/,
l./page 4.6/, r/02.08.72/10.09.79/,
l./jd 1<11+16/,
i/
      rl. w2 (j185.)      ;   w2:= rs_current_activity
/,
l./page 4.7/, r/02.08.72/18.10.79/
l./jd 1<11+16/,
i/
      rl. w2 (j185.)      ;   w2 := rs_current_activity
/,
l./page 14.1/, r/05.11.71/10.09.79/,
l./j150/, r/j150/j185/,
l./g2=/, i/
j185: f1+85, 0             ; rs current activity
/,
l./page 14.10/, r/05.11.71/10.09.79/,
l./jd 1<11+16/, 
i/
      rl. w2 (j185.)      ;   w2:= rs_current_activity
/,
l b
f
\f


rr=edit tdbcodes
l./des -2-/, r/76.10.04/79.04.20/,
l./m12/, r/m12/m13/,
l./length<>rec/, g 2/<>/=/,
d 1, i/
      jl.     m13.        ;   then goto take_indiv_class
; perhaps variable record length, inspect keys.
      rl  w3  x2+12       ;   w3:= keys(addr2)
      sz  w3  1<3         ;   if -, varlength
      sl. w0  (c6.)       ;   or indivlength >= reclength
      jl.     m9.         ;   then  goto length_error
m13:                      ; take_indiv_class:
/,
l./-4-/, r/75.04.11/79.04.20/,
l./if create and pro/, d./rl w3 x3+h3/,
r/zone/record/, i/
      se  w0  0           ;   if something prohibited then
      jl.     a2.         ;   goto alarm(-create or -transf)

      rl  w3  (x2+8)      ;   w3:= recordbase(param1)
/,
l./-5-/, r/76.10.04/79.04.20/,
l./w0:=indivclass/, r/w0/w3/,
l./w3:=param3/, d,
l 1, d./if new/,
i/
      al  w1  1           ;   w1:= 1 (first halfword of record)
      rl  w3  x2+16       ;   w3:= dope_address:=
      ba  w3  x2+14       ;        base_word_address + dope_rel
      sh  w0  (x3-2)      ;   if indivlength > upper
      sh  w1  (x3  )      ;   or 1 <= lower - k
/,
l./w3:=record/, r/x3     /(x2+16)/
l./loop:/,
i/
      sl  w2  x3+10       ;   if last >= 10 then
      rs  w0  x2          ;      record.last:= 0 (see doubleword loop below)
/,
l 2, r/m7/m5/,
l 3, r/m6/m5/,
l./m5:/, d 4,
i/
m5:                       ; end_loop:
/,
l./-6-/, r/75.04.11/79.04.20/,
l./:=add/, r/ad/old_ad/,
l./bl w0/, r/bl/bz/,
l 5, r/bl/bz/,
l./-7-/, r/75.04.11/79.04.20/,
l./a2:/,
r/a2:/   /,
i/
a2:                       ;   -create or -transf
      se  w0  1           ;   skip if transf
/,
l 2, r/a3:/   /,
l./c7:/, r/if ind/of old ind/,
l b
f


\f


theadm1=edit theadm theadf
l./dure head_file_i(/
d./end head_file_i;/
s 2
d
i/
æ12æ
/,
l./savekey,/, r/savekey,/<* savekey, *>/,
l./savekey:=2/, r/savekey:= 2;/<* savekey:= 2; *>/,
l./monres:=/, d./end/,
l 1, d
s 1, d./end head_file_i;/
l./open(z_head/, l 1, i/

  comment
    lookup the file before possible extension during outrec;
    tail(1):= 0;
    monitor(42, z_head, 0, tail); <* lookup *>
/,
l./outrec6(z_head,/,
d 2,
l./tail(1):=/, d 1,
l b
f


\f


r1=edit tprotectcf
l./version-numb/,
d 3,
i/
    the procedure maintains short_clock and update_mark in
    tail(6) and tail(7) of the catalog entry.
/,
l./own variab/,
d./descrname2/,
l./-1/, d./empty name./,
l./own long/, d 1,
l./if action <1/,
d./end action<1/,
l./i>24/, r/if/if action < 1 or/,
l b
f
\f


r2=edit textendcf
l./an error occurs/,
i/
    the file will, depending on type, be extended with an integral
    number of buckets or blocks, at least one.
/,
l./opencf,/, r/,opencf,getm,and getnumbl/ and opencf/,
l./saverecsize/, r/,saverecsize//,
l 1, r/saverecno, //,
r/;/, oldsegs, newsegs, increment,
    headsegs, i5, b52, b53, cfbufrefrel, ibufrefrel;/,
l 1, l./cfbufref/, r/,cfbufrefrel//,
l./cfbufrefrel:=/, d, i/

  i5 := 96;
  b52:= 34;
  b53:= 36;
/,
l./saverecsize:=/,
d./saverec.ifld/,
l./savelength:=/,
r/z.//,
i/

    ibufrefrel := z(1) shift (-24) extract 24 + 1;
    cfbufrefrel:= z(1)             extract 24 + 1;

comment    find headsegs and increment from file head;
    if filetype = 0 then
    begin
    comment    master;
      headsegs:= 0;
      ifld:= ibufrefrel + i5 + 16;
      increment:= z.ifld shift(-12); <* segsperbuck *>
    end  master
    else
    begin
    comment    list;
      ifld:= cfbufrefrel + b52;
      headsegs := z.ifld; <* segs in head *>
      ifld:= cfbufrefrel + b53;
      increment:= z.ifld; <* segs in block *>
    end  list;
/,
l./tail(1):=/,
d,
i Q

      oldsegs:= tail(1);
      newsegs:= headsegs + (oldsegs + extension - headsegs)
                           //increment * increment;
      if newsegs <= oldsegs then
         newsegs:=  newsegs + increment;
      if newsegs <= oldsegs then
      begin
      comment    error;
        saveresult:= 999999;
        goto reopen;
      end;

      tail(1):= newsegs;
Q,
l./if i>0/, d, i/

      if i > 0 then
      begin
error:
        saveresult:= i * 10000 + fnc;
      end  error;
/,
l./goto restorerec/,
d./getnumbl/,
r//  /, r/rec/tables/,
l b
f
\f


r3=edit tbuflength
l./stderror is/, l 1,
i/
    the parameter blocks_in_core has the meaning:
      extend_segments shift 6 add blocks_in_core
    where extend_segments is the number of segments with
    which it should be possible to extend the file.
      (-1) shift 6 add blocks_in_core means extension to the
    maximum size, a limit which is never exceeded in the buffer
    calculation.
/,
l./,b61/,
r/b61/b59, b61/,
l./i2,i3/,
i/
    extension, segments, bucktablesize, max_buck_table,
    blocks, max_blocks,
/,
l./system(9,/, r/sys/if int <> -123456 then  sys/,
l./***buf/, d 1,
i/
  alarm(-123456, <::>);
/,
l./b61:=/,
r/b61/b59:= 48; b61/,
l./i2:=/, d, i/

  i2:= 34; i3:= 60; i4:= 78; i5:= 96; i8:= 176;
/,
l./if blocks_in_core/,
d 1,
i/

  extension:= blocks_in_core shift(-6);
  blocks_in_core:= blocks_in_core extract 6;
  segments:= iarr(1) + extension;

  if blocks_in_core < 1 then  goto param_error;
/,
l./doublewords:=/,
d./word(b53)*512/,
i Q

  if ibufref_rel <> -1 then
  begin
  comment    master;
    max_buck_table:= word(i2+14) - 30 <* i8-i7 *>;
    buck_table_size:=
      if extension = (-1) shift (-6) then  max_buck_table
      else
      (segments//word(i2+2) <* segsperbuck *>
       + (if extension > 0 then  1 else  0))
       * word(i3 + 4) <* entrysize *>;

    i:=  i8 +
         (if   buck_table_size  <   max_buck_table
          then buck_table_size else max_buck_table)
          + word(i4) <* block table size *>
          + blocks_in_core * word(i5) <* block size *>;
  end  master
  else
  begin
  comment    list;
    max_blocks:= word(b59);
    blocks:=
      if extension = (-1) shift (-6) then  max_blocks
      else
      (segments - word(b52) <* segsinhead *>)
       // word(b53) <* segs in block *>
       + 1 <* safety *>;

    i:= b61 + 4 + f18 - 2
        + ((if   blocks  <   max_blocks
            then blocks else max_blocks) + 3)//4 * 2
        + blocks_in_core * (2 + word(b53) * 512);
  end  list;

  doublewords:= (bytes + i + 3)//4;
Q,
l./resultcf/, d,
l b
f
\f


r4=edit theadl
l./open(z_head/,
l 1, i/

comment
    lookup the file before possible extension during outrec;
  tail(1):= 0;
  monitor(42, z_head, 0, tail); <* lookup *>
/,
l./tail(1):=/, d 1,
l b
f
end
finis
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦f99f6cc1d⟧ TextFile

Derivation

TextFile
