DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »fttx1       «

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »fttx1       « 

TextFile

mode list.yes
ft=algol survey.yes
begin
  boolean             med_kopi;
  integer             i, j, k ;
  integer array       zd, zd_org, zd_kopi (1:20);
  long    array field docname;
  zone                z (128, 1, kopiproc);

  integer
  procedure outchar (z, i);
  zone               z    ;
  integer               i ;

    write (z, false add (i extract 12), 1);

  procedure tøm_zone (z);
  zone                z ;
  begin
    integer array       zd (1:20);

    getzone6    (z,  zd );
    outchar     (z, 'em');
    writezone   (z, <:tømzone, før setposition:>);
    setposition (z, 0, 0);

    setzone6    (z,  zd );
  end tøm_zone;

  procedure kopi_proc (z, s, b);
  zone                 z       ;
  integer                 s, b ;
  begin
    integer             i;
    integer array       zd (1:20);

    if s extract 1 = 1 then
      stderror (z, s, b);

    if s shift (-5) extract 1 = 1 then
    begin <*does not exist*>
      getzone6 (z, zd);

      if zd.docname (1) = long <:e :> then
      begin <*kopi*>
        zd (9) := zd (9) - 1; <*decrease segm count*>

        writezone   (z, <:kopizone, ved indhop:>);

        <*skriv i kopiareal*>
        for i := 7 step 1 until 20 do
          zd_kopi (i) := zd (i);

        setzone6    (z, zd_kopi);
        writezone   (z, <:kopiareal, før setposition:>);
        setposition (z, 0, 0   );
        writezone   (z, <:kopiareal, efter setposition:>);

        <*skriv i dataareal*>
        for i := 7 step 1 until 20 do
          zd_org (i) := zd (i);

        setzone6    (z, zd_org);
        writezone   (z, <:origareal, før setposition:>);
        setposition (z, 0, 0  );
        writezone   (z, <:origareal, efter setposition:>);

        getzone6 (z, zd);
        zd_org (6) := zd (6);  <*nta*>

        zd (9) := zd_org (9) + 1;
        zd.docname (1) := long <:e :>;

        setzone6 (z, zd);
        writezone   (z, <:kopiproc, før udhop:>);
      end else
        stderror (z, s, b) <*not hard error, not nonexist*>
    end else
      stderror (z, s, b);

  end kopi_proc;

  med_kopi := fp_mode (1);                                      
  docname  := 2;                                                
                                                                
  if med_kopi then                                              
  begin                                                         
    open        (z,  4, <:kopifil:>, 0);                        
    monitor (52, z,  i, zd); <*create area process*>            
    inrec6      (z,  0); <*name table address*>                 
    setposition (z,  0, 0);                                     
    getzone6    (z,  zd_kopi);                                  
                                                                
    close (z, false);                                           
  end med_kopi;                                                 
                                                                
  open        (z, 4, <:datafil:>, 0);                           
  outrec6     (z, 512); <*name table address*>                  
  setposition (z, 0, 0);                                        
  monitor  (8, z, i, zd);                                       
                                                                
  if med_kopi then                                              
  begin                                                         
    getzone6   (z, zd_org);                                     
    zd_org     (10) := 1 shift 5; <*give up mask := not exist*>  
                                                                
    getzone6   (z, zd    );                                     
    zd.docname (1) := long <:e :>;                              
    zd (10)        := 1 shift 5; <*give up mask := not exist*>  
                                                                
    setzone6 (z, zd);                                           
  end;                                                          
                                                                
  for i := 1 step 1 until 7 do                                  
  begin                                                         
    write (z, <:<10>< start transaction<10>:>);                 
                                                                
    for j := 11, 12, 13, 14 do                                  
      write (z, false add ('a' + i + j - 11), j, "nl", 1);      
                                                                
    write (z, <:end transaction<10>:>, ">", 1, "nl", 1);        
                                                                
    tøm_zone (z);                                               
    writezone   (z, <:efter tømzone:>);
  end;                                                          
                                                                
  if med_kopi then                                              
  begin                                                         
    getzone6 (z, zd);                                           
    for i := 1 step 1 until 20 do                               
      zd (i) := zd_org (i);                                     
                                                                
    setzone6 (z, zd);                                           
  end;                                                          
                                                                
  writezone   (z, <:før sidste outchar:>);
  outchar (z, 'em');                                            
  writezone   (z, <:før close:>);
  close   (z, true);                                            
end;                                                             

end
▶EOF◀