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