DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »readnivsttx«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦bf33d74f6⟧ »iogeofile« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦bf33d74f6⟧ »iogeofile« 
            └─⟦this⟧ 

TextFile

;       read_niv_st_tx        * page 1   13 09 77, 10.28;  

;  read_niv_stn
;  ************

if listing.yes
char 10 12 10

read_niv_stn = set 1

read_niv_stn = algol

external boolean procedure read_niv_stn(z, stat);  
_________________________________________________
zone z;  long stat;  
begin
  comment progr.: Rene Forsberg;  
  ______________________________
  comment læser et nivellementstationsnummer og pakker nummeret
  i en long på følgende måde:

  bit 1-24: stationshovednummeret - for eksempel har
  317, 317.1 og 3170318.1 alle stat.h.nr = 317, 
  bit 24-41: bruges til anden halvdel af lange numre, 
  bit 42: er 1 ved ekstra, 0 ellers og endelig
  bit 43-48: indeholder et evt. stat.nr.index.

  Hvis nummeret ikke har mening antager stat værdien 0.
  Hvis terminatorerne EM eller 1z (eller -1z) mødes
  antager stat værdien -1.
  Hvis nummeret efterfølges af en karakter af klasse 8
  (NL, FF, EM) er read_nivstn true, ellers false;  

  integer klasse, tegn, i, ant_cifre, dec, nr, binr;  
  integer array ciffer (1:9);  
  boolean fejl, ekstra;  
  long array text(1:2);  

  stat:= 0;  dec:= nr:= binr:= 0;  
  ekstra:= fejl:= false;  

  for klasse:= readchar(z, tegn) while 
  klasse <> 2 and tegn <> 25 do ;  

  comment nummer før et evt punkt læses;  
  i:= 0;  
  for i:= i+1 while klasse = 2 and i < 10 do
  begin
    ciffer(i):= tegn-48;  
    if i = 1 and tegn = 48 then i:= 0;  
    klasse:= readchar(z, tegn)
  end;  
  ant_cifre:= i-1;  

  comment EM simuleres, hvis 1z mødes;  
  if ant_cifre = 1 and ciffer(1) = 1 and tegn = 122 then
  begin
    tegn:= 25;  klasse:= 8
  end;  

  comment et for langt nummer læses helt ud;  
  if ant_cifre = 9 and klasse = 2 then read(z, i);  

\f



comment read_niv_st_tx        * page 2   13 09 77, 10.28
0 1 2 3 4 5 6 7 8 9 ;  

  comment resten af nummeret læses;  
  if tegn = 46 then
  begin
    read(z, dec);  
    repeatchar(z);  klasse:= readchar(z, tegn);  
    if dec > 63 then fejl:= true
  end;  
  if tegn = 32 then 
  begin
    klasse:= readchar(z, tegn);  
    if tegn = 101 then
    begin
      ekstra:= true;  
      repeatchar(z);  
      readstring(z, text, 1);  
      if text(1) <> long <:ekstr:> add 97 and
      text(1) <> long <:extra:> or text(2) <> 0 then 
      fejl:= true;  
      repeatchar(z);  klasse:= readchar(z, tegn);  
    end else
    begin
      tegn:= 32;  
    end;  
  end;  
  comment karakteren 9 (HT) tillades af hensyn til de gamle
  GIER-strimler;  
  if tegn <> 32 and tegn <> 9 and klasse <> 8 then fejl:= true;  

  repeatchar(z);  

  if klasse = 8 then read_nivstn:= true else readnivstn:= false;  

\f



comment read_niv_st_tx        * page 3   13 09 77, 10.28
0 1 2 3 4 5 6 7 8 9 ;  

  comment de lange stationsnumre splittes op, alm. numre dannes;  
  if -, fejl then
  begin
    if ant_cifre < 5 then
    begin
      for i:= 1 step 1 until ant_cifre do nr:= nr*10+ciffer(i)
    end else
    if ant_cifre = 6 then
    begin
      nr:= ciffer(1)*10 + ciffer(2);  
      binr:= ciffer(4)*100 + ciffer(5)*10 + ciffer(6);  
      if ciffer(3) <> 0 then fejl:= true
    end else
    if ant_cifre = 7 then
    begin
      nr:= ciffer(1)*100 + ciffer(2)*10 + ciffer(3);  
      binr:= ciffer(5)*100 + ciffer(6)*10 + ciffer(7);  
      if ciffer(4) <> 0 then fejl:= true
    end else
    if ant_cifre = 9 then
    begin
      nr:= ciffer(1)*1000+ciffer(2)*100+ciffer(3)*10+ciffer(4);  
      binr:=ciffer(6)*1000+ciffer(7)*100+ciffer(8)*10+ciffer(9);  
      if ciffer(5) <> 0 then fejl:= true;  
    end else
    fejl:= true;  

    stat:= longzero add nr shift 17 add binr shift 1
    add (if ekstra then 1 else 0) shift 6 add dec;  
  end;  

  if tegn = 25 then stat:= -1;  

  if fejl then
  begin
    stat:= 0;  
    write(out, <:<10>statnr.illegalt:>)
  end;  
end;  
end

if warning.yes
(mode 0.yes
message read_niv_stn not ok
lookup read_niv_stn)
▶EOF◀