DataMuseum.dk

top - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »autofiltx   «

└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
    └─⟦6a563b143⟧ 
        └─ ⟦this⟧ »autofiltx   « 
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─ ⟦this⟧ »autofiltx   « 

TextFile

begin
  integer array field iaf;
  integer array linie(1:28),tail(1:10),param(1:7),keydescr(1:1,1:2);
  real array names(1:6),filnavn(1:2);
  zone z(128,1,stderror);
  integer akt,id1,id2,tid,pos,tegn,val,sep,bogst,komm_nr,postnr,i,j;

  integer procedure læslinie;
  begin
    integer pos,tegn,c;

    pos:= 1;
    repeatchar(in);
    for c:= readchar(in,tegn) while tegn='nl' do ;
    repeatchar(in);
    while tegn='sp' do readchar(in,tegn);
    repeatchar(in);
    repeat
      readchar(in,tegn);
     skriv_tegn(linie,pos,tegn);
    until tegn='nl' or tegn='em' or pos>80;
    if tegn<>'nl' then skrivtegn(linie,pos,'nl');
    while tegn<>'nl' and tegn<>'em' do readchar(in,tegn);
    læslinie:= pos-1;
    afslut_text(linie,pos);
  end;

  procedure syntaks(n);
    value n; integer n;
  begin
    long array field laf;

    laf:= 0;

    write(out,case n of (<:*** SYNTAKS:>,<:*** LINIENR:>,
      <:*** LØBNR:>,<:*** KLOKKESLET:>),<< ddd>,komm_nr,<:: :>,linie.laf);
    ud(out);
    goto næste_linie;
  end;

  iaf:= 0;
  komm_nr:= postnr:= 0;
  fpoutput(i,filnavn.iaf);
  if i<>4 then
  begin
    write(out,<:*** fejl i filnavn<10>:>);
    goto slut;
  end;
  open(z,4,<:førsort:>,0);
  tail(1):= tail(2):= 1;
  for i:= 3 step 1 until 10 do tail(i):= 0;
  monitor(40)create entry:(z,0,tail);

næste_linie:
  i:= læslinie;
  komm_nr:= komm_nr+1;
  pos:= 1;
  if læstegn(linie,pos,tegn)='em' then goto inddata_slut;
  if tegn='A' or tegn='a' then
  begin <* måske ANN *>
    if extend linie(1) <> long<:ANN:> shift (-24) and
       extend linie(1) <> long<:ann:> shift (-24) then syntaks(1);
    akt:= tid:= id1:= id2:= 0;
  end
  else
  if tegn='S' or tegn='s' then
  begin <* SLET *>
    akt:= 12;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>999 then syntaks(2);
    if sep='/' or sep='.' then
      bogst:= 0
    else
    if 'A'<=sep and sep<='Å' or 'a'<=sep and sep<='å' then
    begin
      if sep>'Å' then sep:= sep - 'a' + 'A';
      bogst:= sep - 'A' + 1;
      if læstegn(linie,pos,tegn)<>'/' and tegn<>'.' then syntaks(2);
    end
    else syntaks(2);
    id1:= 1 shift 22 + val shift 12 + bogst shift 7;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>99 or sep<>'sp' then
      syntaks(3);
    id1:= id1 add val;
    id2:= 0;
    if læsheltal(linie,pos,val,sep)<>0 or sep<>'nl' and sep<>'em' or
       val<0 or val>9999 then syntaks(4);
    if val mod 100 > 59 or val//100 > 29 then syntaks(4);
    if val >= 2400 then val:= val - 2400;
    tid:= val*100;
  end
  else
  if tegn='O' or tegn='o' then
  begin <* OMKOD *>
    akt:= 13;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>999 then syntaks(2);
    if sep='/' or sep='.' then bogst:= 0 else
    if 'A'<=sep and sep<='Å' or 'a'<=sep and sep<='å' then
    begin
      if sep>'Å' then sep:= sep - 'a' + 'A';
      bogst:= sep - 'A' + 1;
      if læstegn(linie,pos,tegn)<>'/' and tegn<>'.' then syntaks(2);
    end
    else syntaks(2);
    id1:= 1 shift 22 + val shift 12 + bogst shift 7;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>99
      or sep<>'sp' then syntaks(3);
    id1:= id1 add val;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>999 then syntaks(2);
    if sep='/' or sep='.' then bogst:= 0 else
    if 'A' <= sep and sep <='Å' or 'a'<=sep and sep<='å' then
    begin
      if sep>'Å' then sep:= sep - 'a' + 'A';
      bogst:= sep - 'A' + 1;
      if læstegn(linie,pos,tegn)<>'/' and tegn<>'.' then syntaks(2);
    end
    else syntaks(2);
    id2:= 1 shift 22 + val shift 12 + bogst shift 7;
    if læsheltal(linie,pos,val,sep)<>0 or val<=0 or val>99
      or sep<>'sp' then syntaks(3);
    id2:= id2 add val;
    if læsheltal(linie,pos,val,sep)<>0 or sep<>'nl' and sep<>'em'
      or val < 0 or val > 9999 then syntaks(4);
    if val mod 100 > 59 or val//100 > 29 then syntaks(4);
    if val >= 2400 then val:= val - 2400;
    tid:= val*100;
  end
  else
    syntaks(1);
  if akt=0 then goto næste_linie;
  outrec6(z,8);
  z.iaf(1):= akt;
  z.iaf(2):= tid;
  z.iaf(3):= id1;
  z.iaf(4):= id2;
  postnr:= postnr+1;
  goto næste_linie;
inddata_slut:
  close(z,true);
  write(out,"nl",2,<:!!! autofilen sorteres kronologisk !!!<10>:>); ud(out);
  for i:= 1 step 1 until 7 do param(i):= 1;
  param(5):= 8;
  keydescr(1,1):= 2; keydescr(1,2):= 4;
  movestring(names,1,<:førsort:>);
  names(3):= filnavn(1);
  names(4):= filnavn(2);
  names(5):= names(6):= real<::>;
  mdsortproc(param,keydescr,names,0.0,postnr,i,j);
  open(z,4,filnavn,0);
  monitor(42)lookup entry:(z,0,tail);
  tail(6):= systime(7,0.0,0.0);
  tail(7):= 4;
  tail(9):= 30 shift 12;
  tail(10):= postnr;
  monitor(44)change entry:(z,0,tail);
slut:
end
▶EOF◀