DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦0ad1a624a⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »readstnamtx«

Derivation

└─⟦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_st_nam_tx        * page 1   13 09 77, 10.22;  

;  read_st_name
;  ************

if listing.yes
char 10 12 10

read_st_name = set 1 disc

read_st_name = algol

external procedure read_st_name (z, a, term, type);  
___________________________________________________
value term;  
zone z;  array a;  integer term, type;  

comment progr.: Rene Forsberg;  

comment
reads a string of characters, terminated by a terminator, and 
packs the string in the array a. The procedure starts reading
after the first NL, and reads until a terminator is met. 
Only the first 11 characters are stored.

zone z
used for character input

array a  (return)
contains the characters in a(1) and a(2)

integer term  (call)
contains 3 possible terminators, packed as 
term:= term2 shift 8 add term1 shift 8 add term0

integer type  (return)
has the values:

type = 0:  terminated by term0
type = 1:       -     -  term1
type = 2:       -     -  term2
type = 3:  -1x following NL
type = 4:  -1z following NL or EM terminator

when -1x or -1z is read, a will only contain null characters;  

begin
  integer i, j, char, nonsp_count;  
  real first_chars;  

  for i:= readchar(z, char) while i < 8 or char = 32 do;  
  if char <> 25 then
  for i:= readchar(z, char) while i=8 and char <> 25 do;  

  nonsp_count:= i:= 0;  
  type:= -1;  
  j:= 1;  
  a(1):= a(2):= first_chars:= real longzero;  

\f



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

  for type:= (if char = 25 then 4 else
  _           if char = term extract 8 then 0 else
  _           if char = term shift (-8) extract 8 then 1 else
  _           if char = term shift (-16) extract 8 then 2 else
  _           type) while type = -1 do
  begin
    if char = 10 or char = 12 then system(9, 0, <:<10>st_name:>);  
    i:= i+1;  
    j:= (if i <= 6 then 1 else 2);  
    if i < 12 then a(j):= a(j) shift 8 add char;  
    if char <> 32 and nonsp_count < 3 then
    begin
      nonsp_count:= nonsp_count + 1;  
      firstchars:= firstchars shift 8 add char;  
      if nonsp_count = 3 then
      begin
        if firstchars shift 24 = real <:-1x:> then type := 3
        else
        if firstchars shift 24 = real <:-1z:> then type := 4
      end;  
    end;  
    if type = -1 then readchar(z, char);  
  end while;  

  if type = 3 or type = 4 then a(1):= a(2):= real longzero else
  if i < 12 then a(j):= a(j) shift (40 - 8*((i-1) mod 6)) else  
  a(j):= a(j) shift 8;  
end;  
end 

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