Start development on BSD 2

[unix-history] / .ref-BSD-1 / pcs / scanner.i

procedure nextch;   (*read next character; process line end*) 
begin if cc = ll then 
     begin if eof(input) then
           begin writeln;
              writeln(' program incomplete');
              errormsg; goto 99
           end ;
        if errpos <> 0 then  
           begin writeln; errpos := 0 
           end ;
        write(lc:6, '  ');
        ll := 0; cc := 0;
        while not eoln(input) do
           begin ll := ll+1; read(ch); write(ch); line[ll] := ch 
           end ;
        writeln; ll := ll+1; read(line[ll])
     end ; 
  cc := cc+1; ch := line[cc];
end (*nextch*) ;
 
procedure insymbol;           (*reads next symbol*) 
  label 1,2,3; 
  var i,j,k,e: integer;
 
  procedure readscale; 
     var s, sign: integer;
  begin nextch; sign := 1; s := 0; 
     if ch = '+' then nextch else
     if ch = '-' then begin nextch; sign := -1 end ; 
     while ch in ['0'..'9'] do 
        begin s := 10*s + ord(ch) - ord('0'); nextch 
        end ;
     e := s*sign + e 
  end (*readscale*) ;
 
  procedure adjustscale; 
     var s: integer; d,t: real;
  begin if k+e > emax then error(21) else
        if k+e < emin then rnum := 0 else
    begin s := abs(e); t := 1.0; d := 10.0;
      repeat 
        while not odd(s) do  
           begin s := s div 2; d := sqr(d) 
           end ;
        s := s-1; t := d*t
      until s = 0; 
      if e >= 0 then rnum := rnum*t else rnum := rnum/t
    end 
  end (*adjustscale*) ;
 
begin (*insymbol*) 
1: while (ch = ' ') or (ch = TAB) do nextch; 
  if ch in ['a'..'z'] then
  begin (*identifier or wordsymbol*)  k := 0; id := '          ';
     repeat if k < alng then 
            begin k := k+1; id[k] := ch
            end ; 
        nextch 
     until not (ch in ['a'..'z','0'..'9']); 
     i := 1; j := nkw;   (*binary search*) 
     repeat k := (i+j) div 2;
        if id <= key[k] then j := k-1; 
        if id >= key[k] then i := k+1  
     until i > j; 
     if i-1 > j then sy := ksy[k] else sy := ident 
  end else 
  if ch in ['0'..'9'] then
  begin (*number*) k := 0; inum := 0; sy := intcon;
     repeat inum := inum*10 + ord(ch) - ord('0');
        k := k+1; nextch 
     until not (ch in ['0'..'9']);
     if (k > kmax) or (inum > nmax) then 
       begin error(21); inum := 0; k := 0
       end ; 
     if ch = '.' then
     begin nextch; 
        if ch = '.' then ch := ':' else
           begin sy := realcon; rnum := inum; e := 0;
              while ch in ['0'..'9'] do
              begin e := e-1;
                 rnum := 10.0*rnum + (ord(ch)-ord('0')); nextch
              end ;
              if ch = 'e' then readscale;
              if e <> 0 then adjustscale
           end 
     end else
     if ch = 'e' then
     begin sy := realcon; rnum := inum; e := 0; 
        readscale; if e <> 0 then adjustscale 
     end ; 
  end else
  case ch of 
':' : begin nextch; 
         if ch = '=' then
           begin sy := becomes; nextch 
           end  else sy := colon 
     end ; 
'<' : begin nextch; 
        if ch = '=' then begin sy := leq; nextch end else 
        if ch = '>' then begin sy := neq; nextch end else sy := lss 
     end ; 
'>' : begin nextch; 
        if ch = '=' then begin sy := geq; nextch end else sy := gtr 
     end ; 
'.' : begin nextch; 
        if ch = '.' then 
           begin sy := colon; nextch
           end  else sy := period
     end ; 
'''': begin k := 0; 
   2:  nextch; 
       if ch = '''' then 
         begin nextch; if ch <> '''' then goto 3 
         end ; 
       if sx+k = smax then fatal(7);
       stab[sx+k] := ch; k := k+1; 
       if cc = 1 then
         begin (*end of line*) k := 0; 
         end 
       else goto 2;
   3:  if k = 1 then 
          begin sy := charcon; inum := ord(stab[sx]) 
          end else 
       if k = 0 then 
          begin error(38); sy := charcon; inum := 0
          end else 
          begin sy := string; inum := sx; sleng := k; sx := sx+k 
          end
     end ; 
'(' : begin nextch; 
        if ch <> '*' then sy := lparent else
        begin (*comment*) nextch;
           repeat 
              while ch <> '*' do nextch;
              nextch 
           until ch = ')';
           nextch; goto 1
        end
     end ; 
'+', '-', '*', '/', ')', '=', ',', '[', ']', '#', '&', ';' :
     begin sy := sps[ch]; nextch 
     end ; 
'$', '\', '!', '?', '@', '_', '"', '^' :
     begin error(24); nextch; goto 1
     end 
  end;
end (*insymbol*) ;