DataMuseum.dk

top - metrics - download

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

└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
    └─⟦f546e193b⟧ 
        └─⟦this⟧ »tsystest1   « 

TextFile

  message diverse datatest procedurer (tsystest1);

  <* opbygning af filen systestdata
     segm.0 : opfattes som integers numereret fra 0 til 255,
              integr nr "no" indeholder segmentnr for starten
              på data tilhørende test nr "no"
  *>

  zone d_zone (128, 1, xstderror);

  procedure d_init (no);
  integer no;
  begin
    <* åbner d_zone og positionerer på relevente segment for det givne no
       zd (11) peger på segmentet
    *>
    own integer seg; <* hvis nul og datawrite startes forfra i filen *>
    integer array ia, zd (1 : 20);
    integer field inf;

    inf := no * 2 + 2;

    close (d_zone, false); <* for hvis nu den sidste fejlede *>

    open (d_zone, 4, <:systestdata:>, 0);
    inrec6 (d_zone, 512); <* hent katalog *>
    getzone6 (d_zone, zd);

    if datawrite then
    begin <* opdater katalog *>
      if seg = 0 then
      begin
        xnulstil (d_zone);
        seg := 1;
      end
      else seg := zd (11);

      monitor (42, d_zone, 0, ia); <* lookup *>
      ia (1) := seg + 1;
      ia (6) := systime (7, 0, 0.0);
      monitor (44, d_zone,0, ia); <* changeentry *>

      setposition (d_zone, 0, 0);
      outrec6 (d_zone, 512);
      d_zone.inf := seg; <* først ledige segm *>
      setposition (d_zone, 0, 0);
      inrec6 (d_zone, 512);
    end datawrite;

    zd (11) := d_zone.inf; <* først ledige segm for data *>
    setzone6 (d_zone, zd);

    setposition (d_zone, 0, d_zone.inf); <* positioner på relevante segm *>

    if test then write (out, "nl", 1, <<d>, <:testno.:>, testno,
      <: d-init (:>, no, <:), startseg=:>, zd (11));
  end procedure d_init;

  procedure d_exit;
  begin
    <* lukker d_zone
       hvis datawrite opdateres zd (11) til næste ledige segment
    *>
    integer seg;
    integer array ia, zd (1 : 20);

    getposition (d_zone, 0, seg);
    close (d_zone, true);
    getzone6 (d_zone, zd);

    if test then write (out, "nl", 1, <<d>, <:testno.:>, testno,
      <: d-exit, startseg=:>, zd (11), <: slutseg=:>, seg);

    if datawrite then
    begin <* optag data *>
      monitor (42, d_zone, 0, ia); <* lookup *>
      zd (11) := ia (1) := seg + 1;
      ia (6) := systime (7, 0, 0.0);
      monitor (44, d_zone, 0, ia); <* changeentry *>
      setzone6 (d_zone, zd); <* opdater zd med første ledige seg *>
    end datawrite;
  end procedure d_exit;

  integer procedure d_iread;
  begin
    <* læs næste integer fra d_zone *>
    integer field d_i;

    inrec6 (d_zone, 2);
    d_i := 2;
    d_iread := d_zone.d_i;
  end procedure d_iread;

  long procedure d_lread;
  begin
    <* læs næste long fra d_zone *>
    long field d_l;

    inrec6 (d_zone, 4);
    d_l := 4;
    d_lread := d_zone.d_l;
  end procedure d_lread;

  real procedure d_rread;
  begin
    <* læs næste real fra d_zone *>
    real field d_r;

    inrec6 (d_zone, 4);
    d_r := 4;
    d_rread := d_zone.d_r;
  end procedure d_rread;

  procedure d_iwrite (i);
  integer i;
  begin
    <* skriv næste integer i d_zone *>
    integer field d_i;

    d_i := 2;
    outrec6 (d_zone, 2);
    d_zone.d_i := i;
  end procedure d_iwrite;

  procedure d_lwrite (l);
  long l;
  begin
    <* skriv næste long i d_zone *>
    long field d_l;

    d_l := 4;
    outrec6 (d_zone, 4);
    d_zone.d_l := l;
  end procedure d_lwrite;

  procedure d_rwrite (r);
  real r;
  begin
    <* skriv næste real i d_zone *>
    real field d_r;

    d_r := 4;
    outrec6 (d_zone, 4);
    d_zone.d_r := r;
  end procedure d_rwrite;

▶EOF◀