home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / oc / ocs.mod < prev    next >
Encoding:
Text File  |  1995-07-02  |  33.8 KB  |  1,262 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCS.mod $
  4.   Description: Implements the lexical scanner and error reporting
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.16 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/15 18:10:46 $
  10.  
  11.   Copyright © 1990-1993, ETH Zuerich
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OC program
  14.   See OC.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *> <* MAIN- *>
  21.  
  22. MODULE OCS;
  23.  
  24. IMPORT
  25.   SYS := SYSTEM, Kernel, Files, Str := Strings, OCRev, s := OCStrings,
  26.   OCM, OCOut;
  27.  
  28. (* --- Exported objects ----------------------------------------------- *)
  29.  
  30. (* Symbols *)
  31.  
  32. CONST
  33.   null * =  0;  times * =  1;  slash * =  2;  div * =  3;  mod * =  4;
  34.   and * =  5;  plus * =  6;  minus * =  7;  or * =  8;  eql * =  9;
  35.   neq * = 10; lss * = 11;  leq * = 12;  gtr * = 13;  geq * = 14; in * = 15;
  36.   is * = 16; arrow * = 17;  period * = 18;  comma * = 19; colon * = 20;
  37.   upto * = 21; rparen * = 22;  rbrak * = 23;  rbrace * = 24; of * = 25;
  38.   then * = 26; do * = 27;  to * = 28;  lparen * = 29; lbrak * = 30;
  39.   lbrace * = 31;  not * = 32;  becomes * = 33;  number * = 34; nil * = 35;
  40.   string * = 36; ident * = 37;  semicolon * = 38;  bar * = 39; end * = 40;
  41.   else * = 41; elsif * = 42;  until * = 43;  if * = 44; case * = 45;
  42.   while * = 46; repeat * = 47; loop * = 48;  with * = 49; exit * = 50;
  43.   return * = 51; array * = 52; record * = 53;  pointer * = 54;
  44.   begin * = 57; const * = 58; type * = 59; var * = 60; procedure * = 61;
  45.   import * = 62; module * = 63; eof * = 65; by * = 66; for * = 67;
  46.   endCmd = 68; new = 69; revert = 70; stack = lss; unstack = gtr;
  47.  
  48. CONST
  49.   maxStrLen = 256;
  50.  
  51. (* name, numtyp, intval, realval, lrlval are implicit results of Get () *)
  52.  
  53. VAR
  54.   numtyp *  : INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
  55.   intval *  : LONGINT;
  56.   realval * : REAL;
  57.   lrlval *  : LONGREAL;
  58.   name *    : ARRAY maxStrLen OF CHAR;
  59.  
  60. (* Pragmas *)
  61.  
  62. CONST
  63.  
  64.   typeChk * = 0; ovflChk * = 1; indexChk * = 2; rangeChk * = 3;
  65.   caseChk * = 4; nilChk * = 5; returnChk * = 6; stackChk * = 7;
  66.   longVars * = 8; clearVars * = 9; assertChk * = 10; copyArrays * = 11;
  67.   saveRegs * = 12; saveAllRegs * = 13; entryExitCode * = 14;
  68.   deallocPars * = 15;
  69.  
  70.   lastStacked = assertChk; numPragmas  = 16; pragmaCode = 100;
  71.  
  72. TYPE
  73.  
  74.   PragmaArray = ARRAY numPragmas OF BOOLEAN;
  75.   PragmaPtr = POINTER TO PragmaRec;
  76.   PragmaRec = RECORD
  77.     next : PragmaPtr;
  78.     pragma : ARRAY lastStacked + 1 OF BOOLEAN;
  79.   END;
  80.  
  81. VAR
  82.   pragma *, defaultPragma * : PragmaArray;
  83.   pragmaStk : PragmaPtr;
  84.  
  85. (* Options *)
  86.  
  87. CONST
  88.  
  89.   standard * = 0; initialise * = 1; main * = 2; warnings * = 3;
  90.   register * = 4; debug = 5; smallcode = 6; smalldata = 7; resident = 8;
  91.  
  92.   numOptions = 9; rdOnlyOptions = debug; optionCode = 200;
  93.  
  94. VAR
  95.  
  96.   allowOptions * : BOOLEAN;
  97.   option *, defaultOption * : ARRAY numOptions OF BOOLEAN;
  98.  
  99. (* Source control *)
  100.  
  101. CONST
  102.  
  103.   selectorLen = 32;
  104.  
  105. TYPE
  106.  
  107.   SelectionPtr = POINTER TO SelectionRec;
  108.   SelectionRec = RECORD
  109.     next : SelectionPtr;
  110.     scan, inSelection, selected : BOOLEAN;
  111.   END;
  112.  
  113.   Selector = POINTER TO SelectorRec;
  114.   SelectorRec = RECORD
  115.     next : Selector;
  116.     name : ARRAY selectorLen OF CHAR;
  117.     value : BOOLEAN;
  118.   END;
  119.  
  120. VAR
  121.  
  122.   scan, inSelection, selected : BOOLEAN;
  123.   selectionStk : SelectionPtr;
  124.   selectors, OberonA : Selector;
  125.  
  126. (* Errors and warnings *)
  127.  
  128. VAR
  129.  
  130.   scanerr *, warned * : BOOLEAN;
  131.  
  132.  
  133. (* --- Local objects ---------------------------------------------------- *)
  134.  
  135. CONST
  136.   hashSize = 43; (* size of hash table *)
  137.   maxDig = 32;
  138.   DigitString = "0123456789ABCDEF";
  139.  
  140. TYPE
  141.   HashTab = ARRAY hashSize OF RECORD
  142.     symb, alt, alt2  : INTEGER;
  143.     id   : ARRAY 16 OF CHAR;
  144.   END; (* HashTab *)
  145.  
  146. VAR
  147.   R         : Files.Rider;
  148.   W         : Files.Rider;
  149.   ch        : CHAR; (* current character *)
  150.   lastpos   : LONGINT; (* error position in file *)
  151.   i         : INTEGER;
  152.   keyTab, cmdTab : HashTab;
  153.   errorFile : Files.File;
  154.   Digit : ARRAY 17 OF CHAR;
  155.   line *, col * : INTEGER;
  156.   bumpLine : BOOLEAN;
  157.   errorFileName : ARRAY 256 OF CHAR;
  158.  
  159.  
  160. (*------------------------------------*)
  161. PROCEDURE Search ( VAR hashTab : HashTab; name : ARRAY OF CHAR ) : INTEGER;
  162.  
  163.   VAR i, k, sym : INTEGER;
  164.  
  165. <*$CopyArrays-*>
  166. BEGIN (* Search *)
  167.   i := 0; k := 0; sym := -1;
  168.  
  169.   <*$ < OvflChk- *>
  170.   REPEAT INC (k, ORD (name [i])); INC (i)
  171.   UNTIL name [i] = 0X;
  172.   k := (k + i) MOD hashSize; (* hash function *)
  173.   <*$ > *>
  174.  
  175.   IF (hashTab [k].symb # 0) & (hashTab [k].id = name) THEN
  176.     sym := hashTab [k].symb;
  177.   ELSE
  178.     i := k; k := hashTab [i].alt;
  179.     IF (hashTab [k].symb # 0) & (hashTab [k].id = name) THEN
  180.       sym := hashTab [k].symb;
  181.     ELSE
  182.       k := hashTab [i].alt2;
  183.       IF (hashTab [k].symb # 0) & (hashTab [k].id = name) THEN
  184.         sym := hashTab [k].symb;
  185.       END
  186.     END
  187.   END;
  188.   RETURN sym
  189. END Search;
  190.  
  191. (*------------------------------------*)
  192. PROCEDURE WriteStr (s : ARRAY OF CHAR);
  193.  
  194. <*$CopyArrays-*>
  195. BEGIN (* WriteStr *)
  196.   Files.WriteBytes (W, s, SYS.STRLEN (s));
  197. END WriteStr;
  198.  
  199. (*------------------------------------*)
  200. PROCEDURE WriteInt (i : LONGINT);
  201.  
  202.   (*------------------------------------*)
  203.   PROCEDURE WriteDigit (i : LONGINT);
  204.  
  205.   BEGIN (* WriteDigit *)
  206.     IF i > 0 THEN
  207.       WriteDigit (i DIV 10);
  208.       Files.Write (W, Digit [i MOD 10]);
  209.     END; (* IF *)
  210.   END WriteDigit;
  211.  
  212. BEGIN (* WriteInt *)
  213.   IF i = 0 THEN
  214.     Files.Write (W, "0");
  215.   ELSE
  216.     IF i < 0 THEN
  217.       Files.Write (W, "-");
  218.     END; (* IF *)
  219.     WriteDigit (ABS (i));
  220.   END; (* ELSE *)
  221. END WriteInt;
  222.  
  223. (*------------------------------------*)
  224. PROCEDURE WriteErr (error : BOOLEAN; n : INTEGER);
  225.  
  226.   VAR pos : LONGINT; string : ARRAY 256 OF CHAR;
  227.  
  228. BEGIN (* WriteErr *)
  229.   pos := Files.Pos (R);
  230.   IF (pos > (lastpos + 10)) THEN
  231.     IF errorFile # NIL THEN
  232.       Files.WriteBytes (W, line, 2);
  233.       Files.WriteBytes (W, col, 2);
  234.       Files.WriteBytes (W, n, 2);
  235.     ELSE
  236.       IF error THEN OCOut.Int3 (s.OCS2, n, line, col)
  237.       ELSE OCOut.Int3 (s.OCS3, n, line, col)
  238.       END
  239.     END;
  240.     lastpos := pos
  241.   END
  242. END WriteErr;
  243.  
  244. (*------------------------------------*)
  245. PROCEDURE Mark * (n : INTEGER);
  246.  
  247. BEGIN (* Mark *)
  248.   IF scan THEN scanerr := TRUE; WriteErr (TRUE, n) END
  249. END Mark;
  250.  
  251. (*------------------------------------*)
  252. PROCEDURE Warn * (n : INTEGER);
  253.  
  254. BEGIN (* Warn *)
  255.   IF scan & option [warnings] THEN warned := TRUE; WriteErr (FALSE, n) END
  256. END Warn;
  257.  
  258. (*------------------------------------*)
  259. PROCEDURE GetCh ();
  260.  
  261. BEGIN (* GetCh *)
  262.   IF bumpLine THEN
  263.     INC (line); col := 0; bumpLine := FALSE;
  264.     IF OCM.Verbose & ((line MOD 10) = 0) THEN
  265.       OCOut.Int (line); OCOut.Char (0DX)
  266.     END
  267.   END;
  268.  
  269.   Files.Read (R, ch);
  270.  
  271.   IF ch = 0AX THEN bumpLine := TRUE
  272.   ELSIF ch = 09X THEN INC (col, 8)
  273.   ELSE INC (col)
  274.   END
  275. END GetCh;
  276.  
  277. (*------------------------------------*)
  278. PROCEDURE Hval (ch : CHAR) : INTEGER;
  279.  
  280.   VAR d : INTEGER;
  281.  
  282. BEGIN (* Hval *)
  283.   d := ORD (ch) - 30H; (* d >= 0 *)
  284.   IF d >= 10 THEN
  285.     IF (d >= 17) & (d < 23) THEN DEC (d, 7);
  286.     ELSE d := 0; Mark (2)
  287.     END
  288.   END;
  289.   RETURN d
  290. END Hval;
  291.  
  292. (*------------------------------------*)
  293. PROCEDURE String (VAR sym : INTEGER; startCh : CHAR);
  294.  
  295.   VAR i, j, val : INTEGER;
  296.  
  297. BEGIN (* String *)
  298.   i := 0;
  299.   LOOP
  300.     GetCh ();
  301.     IF ch = startCh THEN EXIT
  302.     ELSIF ch < " " THEN Mark (3); EXIT
  303.     END;
  304.  
  305.     IF ~option [standard] THEN (* process escaped chars in string or char *)
  306.       IF ch = 5CX THEN
  307.         GetCh (); IF ch < " " THEN Mark (3); EXIT END;
  308.         CASE ch OF
  309.           "b" : ch := 08X | (* BS *)
  310.           "e" : ch := 1BX | (* ESC *)
  311.           "f" : ch := 0CX | (* FF *)
  312.           "n" : ch := 0AX | (* LF *)
  313.           "0", "o" : ch := 00X | (* NUL*)
  314.           "r" : ch := 0DX | (* CR *)
  315.           "t" : ch := 09X | (* HT *)
  316.           "v" : ch := 0BX | (* VT *)
  317.           "x" : (* hexadecimal value *)
  318.             GetCh (); IF ch < " " THEN Mark (3); EXIT END;
  319.             val := Hval (ch) * 16;
  320.             GetCh (); IF ch < " " THEN Mark (3); EXIT END;
  321.             val := val + Hval (ch);
  322.             ch := CHR (val);
  323.           |
  324.         ELSE (* insert following character = do nothing *)
  325.         END;
  326.       END;
  327.     END; (* IF *)
  328.  
  329.     IF i < maxStrLen - 1 THEN
  330.       name [i] := ch;
  331.       INC (i)
  332.     ELSE
  333.       Mark (212); i := 0
  334.     END;
  335.   END; (* LOOP *)
  336.   GetCh ();
  337.   sym := string;
  338.   name [i] := 0X;
  339.   intval := i
  340. END String;
  341.  
  342. (*------------------------------------*)
  343. PROCEDURE Identifier (VAR sym : INTEGER);
  344.  
  345.   VAR i : INTEGER; underscore : BOOLEAN;
  346.  
  347. BEGIN (* Identifier *)
  348.   underscore := FALSE; i := 0;
  349.   REPEAT
  350.     underscore := underscore OR (ch = "_");
  351.     IF i < (maxStrLen - 1) THEN name [i] := ch; INC (i) END;
  352.     GetCh ();
  353.   UNTIL
  354.     (ch < "0") OR (ch > "9")
  355.     & (CAP (ch) < "A") OR (CAP (ch) > "Z")
  356.     & (ch # "_");
  357.  
  358.   IF underscore & option [standard] THEN Mark (924) END;
  359.  
  360.   name [i] := 0X;
  361.   sym := Search (keyTab, name);
  362.   IF sym < 0 THEN sym := ident END
  363. END Identifier;
  364.  
  365. (*------------------------------------*)
  366. PROCEDURE TenL (e : INTEGER) : LONGREAL;
  367.  
  368.   VAR result : LONGREAL;
  369.  
  370. BEGIN (* TenL *)
  371.   result := 1;
  372.   WHILE e > 0 DO result := result * 10; DEC (e) END;
  373.   RETURN result
  374. END TenL;
  375.  
  376. (*------------------------------------*)
  377. PROCEDURE Ten (e : INTEGER) : REAL;
  378.  
  379.   VAR result : REAL;
  380.  
  381. BEGIN (* Ten *)
  382.   result := 1;
  383.   WHILE e > 0 DO result := result * 10; DEC (e) END;
  384.   RETURN result
  385. END Ten;
  386.  
  387. (*------------------------------------*)
  388. PROCEDURE Number;
  389.  
  390.   CONST MaxExp = 38; MaxLExp = 38;
  391.  
  392.   VAR
  393.     i, j, h, d, e, n : INTEGER;
  394.     x, f : REAL;
  395.     y, g : LONGREAL;
  396.     lastCh : CHAR;
  397.     neg : BOOLEAN;
  398.     dig : ARRAY maxDig OF CHAR;
  399.  
  400.   (*------------------------------------*)
  401.   PROCEDURE ReadScaleFactor ();
  402.  
  403.   BEGIN (* ReadScaleFactor *)
  404.     GetCh ();
  405.     IF ch = "-" THEN neg := TRUE; GetCh ()
  406.     ELSE neg := FALSE; IF ch = "+" THEN GetCh () END
  407.     END;
  408.     IF ("0" <= ch) & (ch <= "9") THEN
  409.       REPEAT e := e * 10 + ORD (ch) - 30H; GetCh ()
  410.       UNTIL (ch < "0") OR ("9" < ch);
  411.     ELSE Mark (2);
  412.     END
  413.   END ReadScaleFactor;
  414.  
  415. BEGIN (* Number *)
  416.   i := 0;
  417.   REPEAT
  418.     dig [i] := ch; INC (i); GetCh ();
  419.   UNTIL (ch < "0") OR ("9" < ch) & (CAP (ch) < "A") OR ("Z" < CAP (ch));
  420.   lastCh := ch; j := 0;
  421.   WHILE (j < i - 1) & (dig [j] = "0") DO INC (j) END;
  422.   IF ch = "." THEN
  423.     GetCh ();
  424.     IF ch = "." THEN lastCh := 0X; ch := 7FX; END;
  425.   END; (* IF *)
  426.   IF lastCh = "." THEN (* decimal point *)
  427.     h := i;
  428.     WHILE ("0" <= ch) & (ch <= "9") DO (* read fraction *)
  429.       IF i < maxDig THEN dig [i] := ch; INC (i) END;
  430.       GetCh ();
  431.     END; (* WHILE *)
  432.     IF ch = "D" THEN (* LONGREAL *)
  433.       y := 0; g := 1; e := 0;
  434.       WHILE j < h DO y := y * 10 + (ORD (dig [j]) - 30H); INC (j) END;
  435.       WHILE j < i DO
  436.         g := g / 10; y := (ORD (dig [j]) - 30H) * g + y; INC (j)
  437.       END;
  438.       ReadScaleFactor ();
  439.       IF neg THEN
  440.         IF e <= MaxLExp THEN y := y / TenL (e) ELSE y := 0 END;
  441.       ELSIF e > 0 THEN
  442.         IF e <= MaxLExp THEN y := TenL (e) * y
  443.         ELSE y := 0; Mark (203)
  444.         END
  445.       END; (* ELSE *)
  446.       numtyp := 4; lrlval := y;
  447.     ELSE
  448.       x := 0; f := 1; e := 0;
  449.       WHILE j < h DO x := x * 10 + (ORD (dig [j]) - 30H); INC (j) END;
  450.       WHILE j < i DO
  451.         f := f / 10; x := (ORD (dig [j]) - 30H) * f + x; INC (j)
  452.       END;
  453.       IF ch = "E" THEN ReadScaleFactor() END;
  454.       IF neg THEN
  455.         IF e <= MaxExp THEN x := x / Ten (e) ELSE x := 0 END;
  456.       ELSE
  457.         IF e <= MaxExp THEN x := Ten (e) * x
  458.         ELSE x := 0; Mark (203)
  459.         END;
  460.       END; (* ELSE *)
  461.       numtyp := 3; realval := x;
  462.     END; (* ELSE *)
  463.   ELSE (* Integer *)
  464.     lastCh := dig [i - 1]; intval := 0;
  465.     IF lastCh = "H" THEN (* hex number *)
  466.       IF j < (i - 1) THEN
  467.         DEC (i); intval := Hval (dig [j]); INC (j);
  468.         IF i - j <= 7 THEN
  469.           IF (i - j = 7) & (intval >= 8) THEN DEC (intval, 16) END;
  470.           WHILE j < i DO
  471.             intval := Hval (dig [j]) + intval * 10H; INC (j)
  472.           END;
  473.         ELSE
  474.           Mark (203)
  475.         END; (* ELSE *)
  476.       END; (* IF *)
  477.     ELSIF lastCh = "X" THEN (* character code in hex *)
  478.       DEC (i);
  479.       WHILE j < i DO
  480.         intval := Hval (dig [j]) + intval * 10H; INC (j);
  481.         IF intval > OCM.MaxChar THEN Mark (203); intval := 0 END;
  482.       END; (* WHILE *)
  483.     ELSE (* decimal *)
  484.       WHILE j < i DO
  485.         d := ORD (dig [j]) - 30H;
  486.         IF d < 10 THEN
  487.           IF intval <= (MAX (LONGINT) - d) DIV 10 THEN
  488.             intval := intval * 10 + d;
  489.           ELSE
  490.             Mark (203); intval := 0;
  491.           END;
  492.         ELSE
  493.           Mark (2); intval := 0;
  494.         END; (* ELSE *)
  495.         INC (j);
  496.       END; (* WHILE *)
  497.     END; (* ELSE *)
  498.     IF lastCh = "X" THEN numtyp := 1 ELSE numtyp := 2 END;
  499.   END; (* ELSE *)
  500. END Number;
  501.  
  502. (*------------------------------------*)
  503. PROCEDURE SkipWhitespace ();
  504. BEGIN (* SkipWhitespace *)
  505.   LOOP (* ignore control characters (and spaces) *)
  506.     IF ch <= " " THEN IF ch = 0X THEN ch := " "; EXIT ELSE GetCh () END
  507.     ELSIF ch > 7FX THEN GetCh ();
  508.     ELSE EXIT
  509.     END
  510.   END;
  511. END SkipWhitespace;
  512.  
  513. (*------------------------------------*)
  514. PROCEDURE InlineCommand ();
  515.  
  516.   VAR sym, cline, ccol : INTEGER;
  517.  
  518.   (*------------------------------------*)
  519.   PROCEDURE GetSym ();
  520.  
  521.     VAR s : INTEGER;
  522.  
  523.     (*------------------------------------*)
  524.     PROCEDURE Identifier;
  525.  
  526.       VAR i : INTEGER;
  527.  
  528.     BEGIN (* Identifier *)
  529.       i := 0;
  530.       REPEAT
  531.         IF i < (maxStrLen - 1) THEN name [i] := ch; INC (i) END;
  532.         GetCh ();
  533.       UNTIL (ch < "0") OR (ch > "9") & (CAP (ch) < "A") OR (CAP (ch) > "Z");
  534.  
  535.       name [i] := 0X;
  536.       s := Search (cmdTab, name);
  537.       IF s < 0 THEN s := ident END
  538.     END Identifier;
  539.  
  540.   BEGIN (* GetSym *)
  541.     SkipWhitespace ();
  542.     CASE ch OF (* " " <= ch <= 7FX *)
  543.       " " : s := eof
  544.       |
  545.       "A" .. "Z", "a" .. "z", "_" : Identifier ()
  546.       |
  547.       "+" : s := plus; GetCh ()
  548.       |
  549.       "-" : s := minus; GetCh ()
  550.       |
  551.       "&" : s := and; GetCh ()
  552.       |
  553.       "(" : s := lparen; GetCh ()
  554.       |
  555.       ")" : s := rparen; GetCh ()
  556.       |
  557.       "<" : s := stack; GetCh ()
  558.       |
  559.       ">" : s := unstack; GetCh ()
  560.       |
  561.       "!" : s := revert; GetCh ()
  562.       |
  563.       "*" :
  564.         GetCh ();
  565.         IF ch = ">" THEN GetCh (); s := endCmd ELSE s := null END
  566.       |
  567.       "~" : s := not; GetCh ()
  568.       |
  569.     ELSE s := null; GetCh ()
  570.     END; (* CASE ch *)
  571.     sym := s;
  572.   END GetSym;
  573.  
  574.   (*------------------------------------*)
  575.   PROCEDURE Pragma ();
  576.  
  577.     VAR i : INTEGER;
  578.  
  579.     (*------------------------------------*)
  580.     PROCEDURE StackPragmas ();
  581.  
  582.       VAR p : PragmaPtr; i : INTEGER;
  583.  
  584.     BEGIN (* StackPragmas *)
  585.       IF scan THEN
  586.         NEW (p);
  587.         p.next := pragmaStk; pragmaStk := p;
  588.         FOR i := 0 TO lastStacked DO
  589.           p.pragma [i] := pragma [i]
  590.         END
  591.       END
  592.     END StackPragmas;
  593.  
  594.     (*------------------------------------*)
  595.     PROCEDURE UnstackPragmas ();
  596.  
  597.       VAR i : INTEGER;
  598.  
  599.     BEGIN (* UnstackPragmas *)
  600.       IF scan THEN
  601.         IF pragmaStk # NIL THEN
  602.           FOR i := 0 TO lastStacked DO
  603.             pragma [i] := pragmaStk.pragma [i]
  604.           END;
  605.           pragmaStk := pragmaStk.next
  606.         ELSE Mark (349)
  607.         END
  608.       END
  609.     END UnstackPragmas;
  610.  
  611.   BEGIN (* Pragma *)
  612.     LOOP
  613.       GetSym ();
  614.       CASE sym OF
  615.         pragmaCode .. (pragmaCode + numPragmas - 1) :
  616.           i := sym - pragmaCode; GetSym();
  617.           IF sym = plus THEN IF scan THEN pragma [i] := TRUE END
  618.           ELSIF sym = minus THEN IF scan THEN pragma [i] := FALSE END
  619.           ELSE Mark (348); EXIT
  620.           END;
  621.         |
  622.         optionCode .. (optionCode + numOptions - 1) :
  623.           Warn (351); GetSym();
  624.           IF (sym # plus) & (sym # minus) THEN Mark (348); EXIT END
  625.         |
  626.         ident : Warn (0); EXIT
  627.         |
  628.         stack : StackPragmas ()
  629.         |
  630.         unstack : UnstackPragmas ()
  631.         |
  632.         revert : IF scan THEN pragma := defaultPragma END
  633.         |
  634.         endCmd : EXIT
  635.         |
  636.       ELSE Mark (359); EXIT
  637.       END
  638.     END;
  639.   END Pragma;
  640.  
  641.   (*------------------------------------*)
  642.   PROCEDURE Control ();
  643.  
  644.     VAR i : INTEGER; x : BOOLEAN; sel : Selector;
  645.  
  646.     (*------------------------------------*)
  647.     PROCEDURE Lookup () : Selector;
  648.       VAR sel : Selector;
  649.     BEGIN (* Lookup *)
  650.       sel := selectors;
  651.       WHILE (sel # NIL) & (sel.name # name) DO sel := sel.next END;
  652.       RETURN sel
  653.     END Lookup;
  654.  
  655.     (*------------------------------------*)
  656.     PROCEDURE Expression () : BOOLEAN;
  657.  
  658.       VAR e, rhs : BOOLEAN;
  659.  
  660.       (*------------------------------------*)
  661.       PROCEDURE Factor () : BOOLEAN;
  662.  
  663.         VAR f : BOOLEAN; sel : Selector;
  664.  
  665.       BEGIN (* Factor *)
  666.         IF sym < lparen THEN
  667.           Mark (13);
  668.           REPEAT GetSym() UNTIL sym >= lparen
  669.         END;
  670.         IF (sym >= optionCode) & (sym < optionCode + numOptions) THEN
  671.           f := option [sym - optionCode]; GetSym()
  672.         ELSIF (sym >= pragmaCode) & (sym < pragmaCode + numPragmas) THEN
  673.           Warn (351); GetSym(); f := FALSE
  674.         ELSIF sym = ident THEN
  675.           sel := Lookup();
  676.           IF sel # NIL THEN f := sel.value
  677.           ELSE Warn (0); f := FALSE
  678.           END;
  679.           GetSym()
  680.         ELSIF sym = lparen THEN
  681.           GetSym(); f := Expression();
  682.           IF sym = rparen THEN GetSym() ELSE Mark (rparen) END;
  683.         ELSIF sym = not THEN
  684.           GetSym(); f := ~Factor()
  685.         ELSE
  686.           Mark (13); GetSym(); f := FALSE
  687.         END;
  688.         RETURN f
  689.       END Factor;
  690.  
  691.       (*------------------------------------*)
  692.       PROCEDURE Term () : BOOLEAN;
  693.  
  694.         VAR t, rhs : BOOLEAN;
  695.  
  696.       BEGIN (* Term *)
  697.         t := Factor ();
  698.         WHILE sym = and DO GetSym(); rhs := Factor(); t := t & rhs END;
  699.         RETURN t
  700.       END Term;
  701.  
  702.     BEGIN (* Expression *)
  703.       e := Term ();
  704.       WHILE sym = or DO GetSym(); rhs := Term(); e := e OR rhs END;
  705.       RETURN e
  706.     END Expression;
  707.  
  708.     (*------------------------------------*)
  709.     PROCEDURE StackSelection ();
  710.       VAR s : SelectionPtr;
  711.     BEGIN (* StackSelection *)
  712.       NEW (s); s.next := selectionStk; selectionStk := s;
  713.       s.scan := scan; s.inSelection := inSelection;
  714.       s.selected := selected;
  715.       scan := FALSE; selected := FALSE; inSelection := TRUE
  716.     END StackSelection;
  717.  
  718.     (*------------------------------------*)
  719.     PROCEDURE UnstackSelection ();
  720.     BEGIN (* UnstackSelection *)
  721.       scan := selectionStk.scan; inSelection := selectionStk.inSelection;
  722.       selected := selectionStk.selected; selectionStk := selectionStk.next
  723.     END UnstackSelection;
  724.  
  725.   BEGIN (* Control *)
  726.     GetSym ();
  727.     CASE sym OF
  728.       optionCode .. (optionCode + numOptions - 1) :
  729.         IF ~allowOptions THEN Mark (357) END;
  730.         i := sym - optionCode; GetSym();
  731.         IF sym = plus THEN
  732.           IF i < rdOnlyOptions THEN IF scan THEN option [i] := TRUE END
  733.           ELSE Warn (325)
  734.           END;
  735.           GetSym()
  736.         ELSIF sym = minus THEN
  737.           IF i < rdOnlyOptions THEN IF scan THEN option [i] := FALSE END
  738.           ELSE Warn (325)
  739.           END;
  740.           GetSym()
  741.         ELSE Mark (348)
  742.         END
  743.       |
  744.       pragmaCode .. (pragmaCode + numPragmas - 1) :
  745.         Warn (351); GetSym();
  746.         IF (sym = plus) OR (sym = minus) THEN GetSym() END
  747.       |
  748.       ident :
  749.         sel := Lookup();
  750.         IF sel # NIL THEN
  751.           GetSym();
  752.           IF sym = plus THEN
  753.             IF scan THEN sel.value := TRUE END; GetSym()
  754.           ELSIF sym = minus THEN
  755.             IF scan THEN sel.value := FALSE END; GetSym()
  756.           ELSE Mark (348)
  757.           END
  758.         ELSE
  759.           Warn (0); GetSym();
  760.           IF (sym = plus) OR (sym = minus) THEN GetSym() END
  761.         END
  762.       |
  763.       if :
  764.         StackSelection ();
  765.         GetSym(); x := Expression ();
  766.         scan := selectionStk.scan & x; selected := x;
  767.         IF sym = then THEN GetSym() ELSE Mark (then) END;
  768.       |
  769.       elsif :
  770.         IF ~inSelection THEN Mark (350); StackSelection () END;
  771.         GetSym(); x := Expression ();
  772.         scan := x & ~selected & selectionStk.scan;
  773.         selected := selected OR x;
  774.         IF sym = then THEN GetSym() ELSE Mark (then) END;
  775.       |
  776.       else :
  777.         IF ~inSelection THEN Mark (350); StackSelection () END;
  778.         scan := selectionStk.scan & ~selected; selected := scan;
  779.         GetSym()
  780.       |
  781.       end :
  782.         IF selectionStk = NIL THEN Mark (350)
  783.         ELSE UnstackSelection ()
  784.         END;
  785.         GetSym()
  786.       |
  787.       new :
  788.         GetSym();
  789.         IF sym = ident THEN
  790.           IF Lookup() = NIL THEN
  791.             IF scan THEN
  792.               NEW (sel); sel.next := selectors; selectors := sel;
  793.               COPY (name, sel.name); sel.value := FALSE
  794.             END
  795.           ELSE Warn (1)
  796.           END;
  797.           GetSym()
  798.         ELSIF sym >= pragmaCode THEN Warn (1)
  799.         END
  800.       |
  801.       endCmd : (* Do nothing *)
  802.       |
  803.     ELSE Mark (359)
  804.     END
  805.   END Control;
  806.  
  807. BEGIN (* InlineCommand *)
  808.   (* ch = "*" *)
  809.   cline := line; ccol := col - 1; (* Remember start of comment *)
  810.   GetCh ();
  811.   IF ch = "$" THEN GetCh(); Pragma ()
  812.   ELSE
  813.     SkipWhitespace();
  814.     IF ch = "$" THEN Mark (358); GetCh(); Pragma ()
  815.     ELSE Control ()
  816.     END
  817.   END;
  818.   IF (sym # endCmd) & (sym # eof) THEN
  819.     Mark (347); WHILE (sym # eof) & (sym # endCmd) DO GetSym() END
  820.   END;
  821.   IF sym = eof THEN line := cline; col := ccol; Mark (5) END
  822. END InlineCommand;
  823.  
  824. (*------------------------------------*)
  825. PROCEDURE Get * (VAR sym : INTEGER);
  826.  
  827.   VAR
  828.     s : INTEGER;
  829.  
  830.   (*------------------------------------*)
  831.   PROCEDURE Comment (); (* do not read after end of file *)
  832.  
  833.     VAR swCh : CHAR; sw : BOOLEAN; cline, ccol : INTEGER;
  834.  
  835.   BEGIN (* Comment *)
  836.     cline := line; ccol := col - 1; (* Remember start of comment *)
  837.     GetCh ();
  838.     LOOP
  839.       LOOP
  840.         WHILE ch = "(" DO
  841.           GetCh ();
  842.           IF ch = "*" THEN Comment () END
  843.         END;
  844.         WHILE ch = "<" DO
  845.           GetCh ();
  846.           IF ch = "*" THEN InlineCommand () END
  847.         END;
  848.         IF ch = "*" THEN GetCh (); EXIT END;
  849.         IF ch = 0X THEN EXIT END;
  850.         GetCh ()
  851.       END;
  852.       IF ch = ")" THEN GetCh (); EXIT END;
  853.       IF ch = 0X THEN line := cline; col := ccol; Mark (5); EXIT END
  854.     END
  855.   END Comment;
  856.  
  857. BEGIN (* Get *)
  858.   REPEAT
  859.     SkipWhitespace ();
  860.     CASE ch OF (* " " <= ch <= 7FX *)
  861.       " " : s := eof; ch := 0X;
  862.       |
  863.       5CX, "!", "$", "%", "?", "@", "`" : s := null; GetCh ();
  864.       |
  865.       22X, "'" : String (s, ch);
  866.       |
  867.       "#" : s := neq; GetCh ();
  868.       |
  869.       "&" : s := and; GetCh ();
  870.       |
  871.       "(" :
  872.         GetCh ();
  873.         IF ch = "*" THEN Comment (); Get (s) ELSE s := lparen; END;
  874.       |
  875.       ")" : s := rparen; GetCh ();
  876.       |
  877.       "*" : s := times; GetCh ();
  878.       |
  879.       "+" : s := plus; GetCh ();
  880.       |
  881.       "," : s := comma; GetCh ();
  882.       |
  883.       "-" : s := minus; GetCh ();
  884.       |
  885.       "." :
  886.         GetCh ();
  887.         IF ch = "." THEN GetCh (); s := upto; ELSE s := period; END;
  888.       |
  889.       "/" : s := slash; GetCh ();
  890.       |
  891.       "0" .. "9" : Number (); s := number;
  892.       |
  893.       ":" :
  894.         GetCh ();
  895.         IF ch = "=" THEN GetCh (); s := becomes ELSE s := colon END;
  896.       |
  897.       ";" : s := semicolon; GetCh ();
  898.       |
  899.       "<" :
  900.         GetCh ();
  901.         IF ch = "=" THEN GetCh (); s := leq
  902.         ELSIF ch = "*" THEN InlineCommand (); Get (s)
  903.         ELSE s := lss
  904.         END;
  905.       |
  906.       "=" : s := eql; GetCh ();
  907.       |
  908.       ">" :
  909.         GetCh ();
  910.         IF ch = "=" THEN GetCh (); s := geq; ELSE s := gtr; END;
  911.       |
  912.       "A" .. "Z", "a" .. "z", "_" : Identifier (s);
  913.       |
  914.       |
  915.       "[" : s := lbrak; GetCh ();
  916.       |
  917.       "]" : s := rbrak; GetCh ();
  918.       |
  919.       "^" : s := arrow; GetCh ();
  920.       |
  921.       "{" : s := lbrace; GetCh ();
  922.       |
  923.       "}" : s := rbrace; GetCh ();
  924.       |
  925.       "|" : s := bar; GetCh ();
  926.       |
  927.       "~" : s := not; GetCh ();
  928.       |
  929.       7FX : s := upto; GetCh ();
  930.       |
  931.     ELSE
  932.       Mark (1001); Mark (ORD (ch)); s := null
  933.     END; (* CASE ch *)
  934.   UNTIL scan OR (s = eof);
  935.   sym := s;
  936. END Get;
  937.  
  938. (*------------------------------------*)
  939. PROCEDURE New ( name : ARRAY OF CHAR ) : Selector;
  940.  
  941.   VAR sel : Selector;
  942.  
  943. <*$ CopyArrays- *>
  944. BEGIN (* New *)
  945.   NEW (sel); sel.next := OberonA.next; OberonA.next := sel;
  946.   COPY (name, sel.name); sel.value := FALSE;
  947.   RETURN sel
  948. END New;
  949.  
  950. (*------------------------------------*)
  951. PROCEDURE Set* ( name : ARRAY OF CHAR );
  952.  
  953.   VAR sel : Selector; sym : INTEGER;
  954.  
  955. <*$ CopyArrays- *>
  956. BEGIN (* Set *)
  957.   sym := Search (cmdTab, name);
  958.   IF sym < 0 THEN
  959.     sel := OberonA;
  960.     WHILE (sel # NIL) & (sel.name # name) DO sel := sel.next END;
  961.     IF sel = NIL THEN sel := New (name) END;
  962.     sel.value := TRUE
  963.   ELSE
  964.     OCOut.Str1 (s.OCS6, name);
  965.     HALT (5)
  966.   END
  967. END Set;
  968.  
  969. (*------------------------------------*)
  970. PROCEDURE Clear* ( name : ARRAY OF CHAR );
  971.  
  972.   VAR sel : Selector; sym : INTEGER;
  973.  
  974. <*$ CopyArrays- *>
  975. BEGIN (* Clear *)
  976.   sym := Search (cmdTab, name);
  977.   IF sym < 0 THEN
  978.     sel := OberonA;
  979.     WHILE (sel # NIL) & (sel.name # name) DO sel := sel.next END;
  980.     IF sel = NIL THEN sel := New (name) END;
  981.     sel.value := FALSE
  982.   ELSE
  983.     OCOut.Str1 (s.OCS7, name);
  984.     HALT (5)
  985.   END
  986. END Clear;
  987.  
  988. (*------------------------------------*)
  989. PROCEDURE Init * (source : Files.File);
  990.  
  991. BEGIN (* Init *)
  992.   ch := " "; scanerr := FALSE; warned := FALSE; lastpos := -1;
  993.   Files.Set (R, source, 0);
  994.   line := 1; col := 0; bumpLine := FALSE;
  995.  
  996.   defaultOption [standard] := OCM.Standard;
  997.   defaultOption [initialise] := OCM.Initialise;
  998.   defaultOption [main] := OCM.Main;
  999.   defaultOption [warnings] := OCM.Warnings;
  1000.   defaultOption [debug] := OCM.Debug;
  1001.   defaultOption [smallcode] := OCM.SmallCode;
  1002.   defaultOption [smalldata] := OCM.SmallData;
  1003.   defaultOption [register] := OCM.Register;
  1004.   defaultOption [resident] := OCM.Resident;
  1005.  
  1006.   defaultPragma [typeChk] := OCM.TypeChk;
  1007.   defaultPragma [ovflChk] := OCM.OvflChk;
  1008.   defaultPragma [indexChk] := OCM.IndexChk;
  1009.   defaultPragma [rangeChk] := OCM.RangeChk;
  1010.   defaultPragma [caseChk] := OCM.CaseChk;
  1011.   defaultPragma [nilChk] := OCM.NilChk;
  1012.   defaultPragma [returnChk] := OCM.ReturnChk;
  1013.   defaultPragma [stackChk] := OCM.StackChk;
  1014.   defaultPragma [longVars] := OCM.LongVars;
  1015.   defaultPragma [clearVars] := OCM.ClearVars;
  1016.   defaultPragma [assertChk] := OCM.AssertChk;
  1017.   defaultPragma [copyArrays] := TRUE;
  1018.   defaultPragma [saveRegs] := FALSE;
  1019.   defaultPragma [saveAllRegs] := FALSE;
  1020.   defaultPragma [entryExitCode] := TRUE;
  1021.   defaultPragma [deallocPars] := TRUE;
  1022.  
  1023.   pragma := defaultPragma;
  1024.   option := defaultOption; allowOptions := TRUE;
  1025.   scan := TRUE; inSelection := FALSE; selected := FALSE;
  1026. END Init;
  1027.  
  1028. (*------------------------------------*)
  1029. PROCEDURE StartModule * (name : ARRAY OF CHAR);
  1030.  
  1031.   VAR
  1032.     res : INTEGER; tag : ARRAY 5 OF CHAR;
  1033.     errorFileIcon : ARRAY 256 OF CHAR;
  1034.  
  1035. <*$CopyArrays-*>
  1036. BEGIN (* StartModule *)
  1037.   OCM.ErrorFileName (name, errorFileName);
  1038.   Files.Delete (errorFileName, res);
  1039.   COPY (errorFileName, errorFileIcon); Str.Append (".info", errorFileIcon);
  1040.   Files.Delete (errorFileIcon, res);
  1041.   errorFile := Files.New (errorFileName);
  1042.   IF errorFile = NIL THEN
  1043.     OCOut.Str1 (s.OCS8, errorFileName);
  1044.     HALT (20)
  1045.   END;
  1046.   Files.Set (W, errorFile, 0);
  1047.   (* Output error file tag 'OAER' *)
  1048.   tag := "OAER"; Files.WriteBytes (W, tag, 4)
  1049. END StartModule;
  1050.  
  1051. (*------------------------------------*)
  1052. PROCEDURE ResetProcSwitches * ();
  1053.  
  1054. BEGIN (* ResetProcSwitches *)
  1055.   pragma [copyArrays] := TRUE; pragma [saveRegs] := FALSE;
  1056.   pragma [saveAllRegs] := FALSE; pragma [entryExitCode] := TRUE;
  1057.   pragma [deallocPars] := TRUE;
  1058. END ResetProcSwitches;
  1059.  
  1060. (*------------------------------------*)
  1061. PROCEDURE EndModule * ();
  1062.  
  1063. BEGIN (* EndModule *)
  1064.   Files.Set (R, NIL, 0); Files.Set (W, NIL, 0);
  1065.   IF scanerr THEN
  1066.     OCOut.Str1 (s.OCS11, errorFileName);
  1067.     Files.Register (errorFile);
  1068.     OCM.MakeIcon (errorFileName, OCM.iconErr)
  1069.   ELSIF warned THEN
  1070.     OCOut.Str1 (s.OCS12, errorFileName);
  1071.     Files.Register (errorFile);
  1072.     OCM.MakeIcon (errorFileName, OCM.iconErr)
  1073.   ELSE Files.Purge (errorFile)
  1074.   END;
  1075.   errorFile := NIL; errorFileName := "";
  1076.  
  1077.   pragmaStk := NIL; selectionStk := NIL; selectors := OberonA
  1078. END EndModule;
  1079.  
  1080. (*------------------------------------*)
  1081. PROCEDURE Enter
  1082.   ( VAR hashTab : HashTab;
  1083.     sym         : INTEGER;
  1084.     name        : ARRAY OF CHAR );
  1085.  
  1086.   VAR j, k : INTEGER;
  1087.  
  1088. <*$CopyArrays-*>
  1089. BEGIN (* Enter *)
  1090.   j := 0; k := 0;
  1091.  
  1092.   <*$ < OvflChk- *>
  1093.   REPEAT INC (k, ORD (name [j])); INC (j)
  1094.   UNTIL name [j] = 0X;
  1095.   k := (k + j) MOD hashSize; (* hash function *)
  1096.   <*$ > *>
  1097.  
  1098.   IF hashTab [k].symb # 0 THEN
  1099.     j := k; k := -1;
  1100.     REPEAT INC (k) UNTIL hashTab [k].symb = 0;
  1101.     IF hashTab [j].alt = 0 THEN
  1102.       hashTab [j].alt := k
  1103.     ELSIF hashTab [j].alt2 = 0 THEN
  1104.       hashTab [j].alt2 := k
  1105.     ELSE
  1106.       OCOut.Str0 (s.OCS13);
  1107.       HALT (20)
  1108.     END
  1109.   END;
  1110.  
  1111.   hashTab [k].symb := sym; COPY (name, hashTab [k].id)
  1112. END Enter;
  1113.  
  1114. (*------------------------------------*)
  1115. PROCEDURE* CloseErrorFile (VAR rc : LONGINT);
  1116.  
  1117. BEGIN (* CloseErrorFile *)
  1118.   IF errorFile # NIL THEN
  1119.     Files.Set (W, NIL, 0); Files.Purge (errorFile); errorFile := NIL
  1120.   END;
  1121. END CloseErrorFile;
  1122.  
  1123. BEGIN (* OCS *)
  1124.   Digit := DigitString; errorFile := NIL; errorFileName := "";
  1125.   Kernel.SetCleanup (CloseErrorFile);
  1126.  
  1127.   FOR i := 0 TO hashSize - 1 DO
  1128.     keyTab [i].symb := 0; keyTab [i].alt := 0; keyTab [i].alt2 := 0;
  1129.     cmdTab [i].symb := 0; cmdTab [i].alt := 0; cmdTab [i].alt2 := 0
  1130.   END;
  1131.  
  1132.   Enter (keyTab, do, "DO"); Enter (keyTab, if, "IF");
  1133.   Enter (keyTab, in, "IN"); Enter (keyTab, is, "IS");
  1134.   Enter (keyTab, of, "OF"); Enter (keyTab, or, "OR");
  1135.   Enter (keyTab, end, "END"); Enter (keyTab, mod, "MOD");
  1136.   Enter (keyTab, nil, "NIL"); Enter (keyTab, var, "VAR");
  1137.   Enter (keyTab, else, "ELSE"); Enter (keyTab, exit, "EXIT");
  1138.   Enter (keyTab, then, "THEN"); Enter (keyTab, with, "WITH");
  1139.   Enter (keyTab, array, "ARRAY"); Enter (keyTab, begin, "BEGIN");
  1140.   Enter (keyTab, const, "CONST"); Enter (keyTab, elsif, "ELSIF");
  1141.   Enter (keyTab, until, "UNTIL"); Enter (keyTab, while, "WHILE");
  1142.   Enter (keyTab, record, "RECORD"); Enter (keyTab, repeat, "REPEAT");
  1143.   Enter (keyTab, return, "RETURN"); Enter (keyTab, procedure, "PROCEDURE");
  1144.   Enter (keyTab, to, "TO"); Enter (keyTab, div, "DIV");
  1145.   Enter (keyTab, loop, "LOOP"); Enter (keyTab, type, "TYPE");
  1146.   Enter (keyTab, import, "IMPORT"); Enter (keyTab, module, "MODULE");
  1147.   Enter (keyTab, pointer, "POINTER"); Enter (keyTab, case, "CASE");
  1148.   Enter (keyTab, by, "BY"); Enter (keyTab, for, "FOR");
  1149.  
  1150.   Enter (cmdTab, if, "IF");
  1151.   Enter (cmdTab, then, "THEN");
  1152.   Enter (cmdTab, elsif, "ELSIF");
  1153.   Enter (cmdTab, else, "ELSE");
  1154.   Enter (cmdTab, end, "END");
  1155.   Enter (cmdTab, new, "NEW");
  1156.   Enter (cmdTab, or, "OR");
  1157.   Enter (cmdTab, pragmaCode + copyArrays, "CopyArrays");
  1158.   Enter (cmdTab, pragmaCode + typeChk, "TypeChk");
  1159.   Enter (cmdTab, pragmaCode + ovflChk, "OvflChk");
  1160.   Enter (cmdTab, pragmaCode + indexChk, "IndexChk");
  1161.   Enter (cmdTab, pragmaCode + rangeChk, "RangeChk");
  1162.   Enter (cmdTab, pragmaCode + caseChk, "CaseChk");
  1163.   Enter (cmdTab, pragmaCode + nilChk, "NilChk");
  1164.   Enter (cmdTab, pragmaCode + returnChk, "ReturnChk");
  1165.   Enter (cmdTab, pragmaCode + stackChk, "StackChk");
  1166.   Enter (cmdTab, pragmaCode + longVars, "LongVars");
  1167.   Enter (cmdTab, pragmaCode + clearVars, "ClearVars");
  1168.   Enter (cmdTab, pragmaCode + saveRegs, "SaveRegs");
  1169.   Enter (cmdTab, pragmaCode + saveAllRegs, "SaveAllRegs");
  1170.   Enter (cmdTab, pragmaCode + entryExitCode, "EntryExitCode");
  1171.   Enter (cmdTab, pragmaCode + deallocPars, "DeallocPars");
  1172.   Enter (cmdTab, pragmaCode + assertChk, "AssertChk");
  1173.   Enter (cmdTab, optionCode + standard, "STANDARD");
  1174.   Enter (cmdTab, optionCode + initialise, "INITIALISE");
  1175.   Enter (cmdTab, optionCode + main, "MAIN");
  1176.   Enter (cmdTab, optionCode + warnings, "WARNINGS");
  1177.   Enter (cmdTab, optionCode + debug, "DEBUG");
  1178.   Enter (cmdTab, optionCode + smallcode, "SMALLCODE");
  1179.   Enter (cmdTab, optionCode + smalldata, "SMALLDATA");
  1180.   Enter (cmdTab, optionCode + register, "REGISTER");
  1181.   Enter (cmdTab, optionCode + resident, "RESIDENT");
  1182.  
  1183.   pragmaStk := NIL;
  1184.   NEW (OberonA);
  1185.   OberonA.next := NIL; OberonA.name := "OberonA"; OberonA.value := TRUE;
  1186.   selectionStk := NIL; selectors := OberonA;
  1187.  
  1188. END OCS.
  1189.  
  1190. (***************************************************************************
  1191.  
  1192.   $Log: OCS.mod $
  1193.   Revision 5.16  1995/06/15  18:10:46  fjc
  1194.   - Added RESIDENT to inline command identifier table.
  1195.  
  1196.   Revision 5.15  1995/06/02  18:32:25  fjc
  1197.   - Added AssertChk macro.
  1198.   - defaultOption and defaultPragma are now initialised from
  1199.     the settings exported by OCM.
  1200.   - Fixed some problems with parsing inline commands.
  1201.   - Removed option to generate text error files.
  1202.  
  1203.   Revision 5.15  1995/05/29  21:15:49  fjc
  1204.   - Added AssertChk pragma.
  1205.   - Minor fixes in parsing of inline commands and pragmas.
  1206.  
  1207.   Revision 5.14  1995/05/19  16:00:11  fjc
  1208.   - Uses OCOut for console IO.
  1209.  
  1210.   Revision 5.13  1995/03/23  17:58:17  fjc
  1211.   - Fixed pragma.
  1212.  
  1213.   Revision 5.12  1995/02/27  16:50:50  fjc
  1214.   - Removed trace code.
  1215.   - Implemented DEBUG, SMALLCODE, SMALLDATA and REGISTER as
  1216.     read-only options.
  1217.  
  1218.   Revision 5.11  1995/01/26  00:17:17  fjc
  1219.   - Release 1.5
  1220.  
  1221.   Revision 5.10  1995/01/09  13:47:10  fjc
  1222.   - Added calls to OCM.MakeIcon.
  1223.   - Changed output depending on OCM.Verbose.
  1224.  
  1225.   Revision 5.9  1995/01/03  21:04:01  fjc
  1226.   - Changed OCG to OCM.
  1227.   - Changed to use catalogs:
  1228.     - Uses OCM for console I/O instead of Out.
  1229.     - Gets text from OCStrings instead of hard-coding it.
  1230.  
  1231.   Revision 5.8  1994/12/16  17:01:51  fjc
  1232.   - Changed Identifier() to allow underscores.
  1233.   - Uses procedures in OCG to construct error file names.
  1234.  
  1235.   Revision 5.7  1994/11/13  11:15:29  fjc
  1236.   - Consolidated writing to the error file in WriteErr().
  1237.  
  1238.   Revision 5.6  1994/10/23  15:31:37  fjc
  1239.   - Replaced StdIO with Out for console IO.
  1240.   - Implemented 'DeallocPars' pragma.
  1241.   - Scan() now allows for IEEE REALs.
  1242.  
  1243.   Revision 5.5  1994/09/25  17:33:31  fjc
  1244.   - Deleted CPOINTER, BPOINTER and LIBCALL keywords.
  1245.   - Uncommented trace code in Mark() and Warn().
  1246.  
  1247.   Revision 5.4  1994/09/16  17:31:03  fjc
  1248.   - Implemented source control.
  1249.   - Added Warn(), Set() and Clear().
  1250.  
  1251.   Revision 5.3  1994/09/15  10:12:46  fjc
  1252.   - Replaced switches with pragmas.
  1253.   - Used Kernel instead of SYSTEM.
  1254.  
  1255.   Revision 5.2  1994/09/08  10:43:54  fjc
  1256.   - Actually got pragmas and options to work.
  1257.  
  1258.   Revision 5.1  1994/09/03  20:20:12  fjc
  1259.   - Bumped version number
  1260.  
  1261. ***************************************************************************)
  1262.