home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
ops.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
10KB
|
296 lines
Syntax24.Scn.Fnt
Syntax10.Scn.Fnt
(* Notify Ralf for maintenance of Non-FPU source *)
MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *)
IMPORT OPM;
CONST
MaxStrLen* = 256;
MaxIdLen = 24;
TYPE
Name* = ARRAY MaxIdLen OF CHAR;
String* = ARRAY MaxStrLen OF CHAR;
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
name*: Name;
str*: String;
numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
intval*: LONGINT; (* integer value or string length *)
realval*: REAL;
lrlval*: LONGREAL;
(*symbols:
| 0 1 2 3 4
---|--------------------------------------------------------
0 | null * / DIV MOD
5 | & + - OR =
10 | # < <= > >=
15 | IN IS ^ . ,
20 | : .. ) ] }
25 | OF THEN DO TO BY
30 | ( [ { ~ :=
35 | number NIL string ident ;
40 | | END ELSE ELSIF UNTIL
45 | IF CASE WHILE REPEAT FOR
50 | LOOP WITH EXIT RETURN ARRAY
55 | RECORD POINTER BEGIN CONST TYPE
60 | VAR PROCEDURE IMPORT MODULE eof *)
CONST
(* numtyp values *)
char = 1; integer = 2; real = 3; longreal = 4;
(*symbol values*)
null = 0; times = 1; slash = 2; div = 3; mod = 4;
and = 5; plus = 6; minus = 7; or = 8; eql = 9;
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
in = 15; is = 16; arrow = 17; period = 18; comma = 19;
colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
of = 25; then = 26; do = 27; to = 28; by = 29;
lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
bar = 40; end = 41; else = 42; elsif = 43; until = 44;
if = 45; case = 46; while = 47; repeat = 48; for = 49;
loop = 50; with = 51; exit = 52; return = 53; array = 54;
record = 55; pointer = 56; begin = 57; const = 58; type = 59;
var = 60; procedure = 61; import = 62; module = 63; eof = 64;
ch: CHAR; (*current character*)
PROCEDURE err(n: INTEGER);
BEGIN OPM.err(n)
END err;
PROCEDURE Str(VAR sym: SHORTINT);
VAR i: INTEGER; och: CHAR;
BEGIN i := 0; och := ch;
LOOP OPM.Get(ch);
IF ch = och THEN EXIT END ;
IF ch < " " THEN err(3); EXIT END ;
IF i = MaxStrLen-1 THEN err(241); EXIT END ;
str[i] := ch; INC(i)
END ;
OPM.Get(ch); str[i] := 0X; intval := i + 1;
IF intval = 2 THEN
sym := number; numtyp := 1; intval := ORD(str[0])
ELSE sym := string
END
END Str;
PROCEDURE Identifier(VAR sym: SHORTINT);
VAR i: INTEGER;
BEGIN i := 0;
REPEAT
name[i] := ch; INC(i); OPM.Get(ch)
UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
IF i = MaxIdLen THEN err(240); DEC(i) END ;
name[i] := 0X; sym := ident
END Identifier;
PROCEDURE Number;
VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
PROCEDURE Ten(e: INTEGER): LONGREAL;
VAR x, p: LONGREAL;
BEGIN x := 1; p := 10;
WHILE e > 0 DO
IF ODD(e) THEN x := x*p END;
e := e DIV 2;
IF e > 0 THEN p := p*p END (* prevent overflow *)
END;
RETURN x
END Ten;
PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
ELSE err(2); RETURN 0
END
END Ord;
BEGIN (* ("0" <= ch) & (ch <= "9") *)
i := 0; m := 0; n := 0; d := 0;
LOOP (* read mantissa *)
IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
INC(m)
END;
OPM.Get(ch); INC(i)
ELSIF ch = "." THEN OPM.Get(ch);
IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
ELSIF d = 0 THEN (* i > 0 *) d := i
ELSE err(2)
END
ELSE EXIT
END
END; (* 0 <= n <= m <= i, 0 <= d <= i *)
IF d = 0 THEN (* integer *)
IF n = m THEN intval := 0; i := 0;
IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
IF n <= 2 THEN
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
ELSE err(203)
END
ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
IF n <= OPM.MaxHDig THEN
IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
ELSE err(203)
END
ELSE (* decimal *) numtyp := integer;
WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
ELSE err(203)
END
END
END
ELSE err(203)
END
ELSE (* fraction *)
f := 0; e := 0; expCh := "E";
WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
ELSIF ch = "+" THEN OPM.Get(ch)
END;
IF ("0" <= ch) & (ch <= "9") THEN
REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
ELSE err(203)
END
UNTIL (ch < "0") OR ("9" < ch);
IF neg THEN e := -e END
ELSE err(2)
END
END;
DEC(e, i-d-m); (* decimal point shift *)
IF expCh = "E" THEN numtyp := real;
IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
IF e < 0 THEN realval := SHORT(f / Ten(-e))
ELSE realval := SHORT(f * Ten(e))
END
ELSE err(203)
END
ELSE numtyp := longreal;
IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
IF e < 0 THEN lrlval := f / Ten(-e)
ELSE lrlval := f * Ten(e)
END
ELSE err(203)
END
END
END
END Number;
PROCEDURE Get*(VAR sym: SHORTINT);
VAR s: SHORTINT;
PROCEDURE Comment; (* do not read after end of file *)
BEGIN OPM.Get(ch);
LOOP
LOOP
WHILE ch = "(" DO OPM.Get(ch);
IF ch = "*" THEN Comment END
END ;
IF ch = "*" THEN OPM.Get(ch); EXIT END ;
IF ch = OPM.Eot THEN EXIT END ;
OPM.Get(ch)
END ;
IF ch = ")" THEN OPM.Get(ch); EXIT END ;
IF ch = OPM.Eot THEN err(5); EXIT END
END
END Comment;
BEGIN
OPM.errpos := OPM.curpos-1;
WHILE ch <= " " DO (*ignore control characters*)
IF ch = OPM.Eot THEN sym := eof; RETURN
ELSE OPM.Get(ch)
END
END ;
CASE ch OF (* ch > " " *)
| 22X, 27X : Str(s)
| "#" : s := neq; OPM.Get(ch)
| "&" : s := and; OPM.Get(ch)
| "(" : OPM.Get(ch);
IF ch = "*" THEN Comment; Get(s)
ELSE s := lparen
END
| ")" : s := rparen; OPM.Get(ch)
| "*" : s := times; OPM.Get(ch)
| "+" : s := plus; OPM.Get(ch)
| "," : s := comma; OPM.Get(ch)
| "-" : s := minus; OPM.Get(ch)
| "." : OPM.Get(ch);
IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
| "/" : s := slash; OPM.Get(ch)
| "0".."9": Number; s := number
| ":" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
| ";" : s := semicolon; OPM.Get(ch)
| "<" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
| "=" : s := eql; OPM.Get(ch)
| ">" : OPM.Get(ch);
IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
| "A": Identifier(s); IF name = "ARRAY" THEN s := array END
| "B": Identifier(s);
IF name = "BEGIN" THEN s := begin
ELSIF name = "BY" THEN s := by
END
| "C": Identifier(s);
IF name = "CASE" THEN s := case
ELSIF name = "CONST" THEN s := const
END
| "D": Identifier(s);
IF name = "DO" THEN s := do
ELSIF name = "DIV" THEN s := div
END
| "E": Identifier(s);
IF name = "END" THEN s := end
ELSIF name = "ELSE" THEN s := else
ELSIF name = "ELSIF" THEN s := elsif
ELSIF name = "EXIT" THEN s := exit
END
| "F": Identifier(s); IF name = "FOR" THEN s := for END
| "I": Identifier(s);
IF name = "IF" THEN s := if
ELSIF name = "IN" THEN s := in
ELSIF name = "IS" THEN s := is
ELSIF name = "IMPORT" THEN s := import
END
| "L": Identifier(s); IF name = "LOOP" THEN s := loop END
| "M": Identifier(s);
IF name = "MOD" THEN s := mod
ELSIF name = "MODULE" THEN s := module
END
| "N": Identifier(s); IF name = "NIL" THEN s := nil END
| "O": Identifier(s);
IF name = "OR" THEN s := or
ELSIF name = "OF" THEN s := of
END
| "P": Identifier(s);
IF name = "PROCEDURE" THEN s := procedure
ELSIF name = "POINTER" THEN s := pointer
END
| "R": Identifier(s);
IF name = "RECORD" THEN s := record
ELSIF name = "REPEAT" THEN s := repeat
ELSIF name = "RETURN" THEN s := return
END
| "T": Identifier(s);
IF name = "THEN" THEN s := then
ELSIF name = "TO" THEN s := to
ELSIF name = "TYPE" THEN s := type
END
| "U": Identifier(s); IF name = "UNTIL" THEN s := until END
| "V": Identifier(s); IF name = "VAR" THEN s := var END
| "W": Identifier(s);
IF name = "WHILE" THEN s := while
ELSIF name = "WITH" THEN s := with
END
| "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
| "[" : s := lbrak; OPM.Get(ch)
| "]" : s := rbrak; OPM.Get(ch)
| "^" : s := arrow; OPM.Get(ch)
| "a".."z": Identifier(s)
| "{" : s := lbrace; OPM.Get(ch)
| "|" : s := bar; OPM.Get(ch)
| "}" : s := rbrace; OPM.Get(ch)
| "~" : s := not; OPM.Get(ch)
| 7FX : s := upto; OPM.Get(ch)
ELSE s := null; OPM.Get(ch)
END ;
sym := s
END Get;
PROCEDURE Init*;
BEGIN ch := " "
END Init;
END OPS.