| 1 | procedure nextch; (*read next character; process line end*) |
| 2 | begin if cc = ll then |
| 3 | begin if eof(input) then |
| 4 | begin writeln; |
| 5 | writeln(' program incomplete'); |
| 6 | errormsg; goto 99 |
| 7 | end ; |
| 8 | if errpos <> 0 then |
| 9 | begin writeln; errpos := 0 |
| 10 | end ; |
| 11 | write(lc:6, ' '); |
| 12 | ll := 0; cc := 0; |
| 13 | while not eoln(input) do |
| 14 | begin ll := ll+1; read(ch); write(ch); line[ll] := ch |
| 15 | end ; |
| 16 | writeln; ll := ll+1; read(line[ll]) |
| 17 | end ; |
| 18 | cc := cc+1; ch := line[cc]; |
| 19 | end (*nextch*) ; |
| 20 | |
| 21 | procedure insymbol; (*reads next symbol*) |
| 22 | label 1,2,3; |
| 23 | var i,j,k,e: integer; |
| 24 | |
| 25 | procedure readscale; |
| 26 | var s, sign: integer; |
| 27 | begin nextch; sign := 1; s := 0; |
| 28 | if ch = '+' then nextch else |
| 29 | if ch = '-' then begin nextch; sign := -1 end ; |
| 30 | while ch in ['0'..'9'] do |
| 31 | begin s := 10*s + ord(ch) - ord('0'); nextch |
| 32 | end ; |
| 33 | e := s*sign + e |
| 34 | end (*readscale*) ; |
| 35 | |
| 36 | procedure adjustscale; |
| 37 | var s: integer; d,t: real; |
| 38 | begin if k+e > emax then error(21) else |
| 39 | if k+e < emin then rnum := 0 else |
| 40 | begin s := abs(e); t := 1.0; d := 10.0; |
| 41 | repeat |
| 42 | while not odd(s) do |
| 43 | begin s := s div 2; d := sqr(d) |
| 44 | end ; |
| 45 | s := s-1; t := d*t |
| 46 | until s = 0; |
| 47 | if e >= 0 then rnum := rnum*t else rnum := rnum/t |
| 48 | end |
| 49 | end (*adjustscale*) ; |
| 50 | |
| 51 | begin (*insymbol*) |
| 52 | 1: while (ch = ' ') or (ch = TAB) do nextch; |
| 53 | if ch in ['a'..'z'] then |
| 54 | begin (*identifier or wordsymbol*) k := 0; id := ' '; |
| 55 | repeat if k < alng then |
| 56 | begin k := k+1; id[k] := ch |
| 57 | end ; |
| 58 | nextch |
| 59 | until not (ch in ['a'..'z','0'..'9']); |
| 60 | i := 1; j := nkw; (*binary search*) |
| 61 | repeat k := (i+j) div 2; |
| 62 | if id <= key[k] then j := k-1; |
| 63 | if id >= key[k] then i := k+1 |
| 64 | until i > j; |
| 65 | if i-1 > j then sy := ksy[k] else sy := ident |
| 66 | end else |
| 67 | if ch in ['0'..'9'] then |
| 68 | begin (*number*) k := 0; inum := 0; sy := intcon; |
| 69 | repeat inum := inum*10 + ord(ch) - ord('0'); |
| 70 | k := k+1; nextch |
| 71 | until not (ch in ['0'..'9']); |
| 72 | if (k > kmax) or (inum > nmax) then |
| 73 | begin error(21); inum := 0; k := 0 |
| 74 | end ; |
| 75 | if ch = '.' then |
| 76 | begin nextch; |
| 77 | if ch = '.' then ch := ':' else |
| 78 | begin sy := realcon; rnum := inum; e := 0; |
| 79 | while ch in ['0'..'9'] do |
| 80 | begin e := e-1; |
| 81 | rnum := 10.0*rnum + (ord(ch)-ord('0')); nextch |
| 82 | end ; |
| 83 | if ch = 'e' then readscale; |
| 84 | if e <> 0 then adjustscale |
| 85 | end |
| 86 | end else |
| 87 | if ch = 'e' then |
| 88 | begin sy := realcon; rnum := inum; e := 0; |
| 89 | readscale; if e <> 0 then adjustscale |
| 90 | end ; |
| 91 | end else |
| 92 | case ch of |
| 93 | ':' : begin nextch; |
| 94 | if ch = '=' then |
| 95 | begin sy := becomes; nextch |
| 96 | end else sy := colon |
| 97 | end ; |
| 98 | '<' : begin nextch; |
| 99 | if ch = '=' then begin sy := leq; nextch end else |
| 100 | if ch = '>' then begin sy := neq; nextch end else sy := lss |
| 101 | end ; |
| 102 | '>' : begin nextch; |
| 103 | if ch = '=' then begin sy := geq; nextch end else sy := gtr |
| 104 | end ; |
| 105 | '.' : begin nextch; |
| 106 | if ch = '.' then |
| 107 | begin sy := colon; nextch |
| 108 | end else sy := period |
| 109 | end ; |
| 110 | '''': begin k := 0; |
| 111 | 2: nextch; |
| 112 | if ch = '''' then |
| 113 | begin nextch; if ch <> '''' then goto 3 |
| 114 | end ; |
| 115 | if sx+k = smax then fatal(7); |
| 116 | stab[sx+k] := ch; k := k+1; |
| 117 | if cc = 1 then |
| 118 | begin (*end of line*) k := 0; |
| 119 | end |
| 120 | else goto 2; |
| 121 | 3: if k = 1 then |
| 122 | begin sy := charcon; inum := ord(stab[sx]) |
| 123 | end else |
| 124 | if k = 0 then |
| 125 | begin error(38); sy := charcon; inum := 0 |
| 126 | end else |
| 127 | begin sy := string; inum := sx; sleng := k; sx := sx+k |
| 128 | end |
| 129 | end ; |
| 130 | '(' : begin nextch; |
| 131 | if ch <> '*' then sy := lparent else |
| 132 | begin (*comment*) nextch; |
| 133 | repeat |
| 134 | while ch <> '*' do nextch; |
| 135 | nextch |
| 136 | until ch = ')'; |
| 137 | nextch; goto 1 |
| 138 | end |
| 139 | end ; |
| 140 | '+', '-', '*', '/', ')', '=', ',', '[', ']', '#', '&', ';' : |
| 141 | begin sy := sps[ch]; nextch |
| 142 | end ; |
| 143 | '$', '\', '!', '?', '@', '_', '"', '^' : |
| 144 | begin error(24); nextch; goto 1 |
| 145 | end |
| 146 | end; |
| 147 | end (*insymbol*) ; |
| 148 | |