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

⟦7fcdce39a⟧ TextFile

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

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_text_tx          * page 1   13 09 77, 10.35;  

;  read_text
;  *********

if listing.yes
char 10 12 10

read_text = set 1

read_text = algol

external integer procedure read_text
____________________________________
_       (z, a, pointer, qnl, term);  
value                        term;  
zone     z;  
array       a;  
integer        pointer, qnl, term;  

comment  read_text inputs a text string until one of the 3
terminators packed in term is met.   the string is packed
in array a from the integer pointer and onwards in integer
words.input is via the zone z. qnl signals the number of
crnl after edition as follows:
_   (1) one nl is inserted in front of the text
_   (2) only one  nl between 2 lines
_   (3) no nl is stored after the last graphic character
the value  of the  procedure is the number  of  integer
words used for  storage including the null(s) terminat-   
ing the text;  

begin
  real array field     p;  
  integer              class, state, char, q, t, s, 
  _                    term1, term2, term3, qnl1;  
  real                 r;  
  boolean array        state_a(0:7);  

  comment decision table for input

  _            0     1     2
  state       init after after
  _                 nl   text
  _
  class        action / next state

  0=nl        3/0   3/1   3/1
  1=sp        3/0   3/1   1/2
  2=txt       2/2   2/2   1/2
  3=term      3/3   3/3   3/3

  state=3 => exit

  actions
  1=include textchar
  2=include nl and textchar
  3=no action;  

\f



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

  for class := 0 step 1 until 7 do
  state_a(class) := false  add (case class + 1 of (

  3 + (3 shift 2) + (3 shift 4), 
  3 + (3 shift 2) + (1 shift 4), 
  2 + (2 shift 2) + (1 shift 4), 
  3 + (3 shift 2) + (3 shift 4), 

  0 + (1 shift 2) + (1 shift 4), 
  0 + (1 shift 2) + (2 shift 4), 
  2 + (2 shift 2) + (2 shift 4), 
  3 + (3 shift 2) + (3 shift 4)));  

  term1 := term extract 8;  
  term2 := (term shift (-8)) extract 8;  
  term3 := (term shift (-16)) extract 8;  
  s := 6;  q := 0;  p := 4*pointer;  qnl1 := 0;  
  class := state := 0;  r := real longzero;  

  for state := -2*((state_a(class + 4) shift state) 
  extract 2)  while  state > -6 do

  begin comment input and action loop;  
    read_char(z, char);  
    class := if char=10 or char=12 then 0
    else if char=32 then 1
    else
    if char<>term1 and char<>term2 and char<>term3 then 2
    else 3;  

    case (state_a(class) shift state) extract 2 of

    begin comment action cases;  

      begin comment action1, include char;  
        r := r add char;  s := s - 1;  
        if s>0 then  r := r shift 8
        else
        begin
          a.p(q) := r;  r := real longzero;  
          q := q + 1;  s := 6;  
        end;  
      end action1;  

      begin comment action2,  include nl and char;  
        for t := 10, char do
        begin
          r := r add t;  s := s - 1;  
          if s>0 then  r := r shift 8
          else 
          begin
            a.p(q) := r;  r := real longzero;  
            q := q + 1;  s := 6;  
          end;  
        end;  
        qnl1 := qnl1 + 1;  
      end action2;  

      comment action3,  no action;  ;  

    end actions;  

  end input loop;  

\f



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

  s := if s<>6 then (s-1) else 0;  
  a.p(q) := r shift (8*s);  

  qnl := qnl1;  read_text := q + 1;  

end read_text;  

end

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