<html><head><meta http-equiv="Content-Type" content="text/html charset=utf-8"></head><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;" class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">Just for the record: Below is a possible implementation of </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">the </span><span style="white-space: pre-wrap; font-family: monospace;" class="">Oberon-07</span><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">compiler </span><span style="white-space: pre-wrap; font-family: monospace;" class="">that </span><span style="white-space: pre-wrap; font-family: monospace;" class="">disallows access to ALL intermediate </span><span style="white-space: pre-wrap; font-family: monospace;" class="">objects, i.e. not just</span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">intermediate variables, </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">but also </span><span style="font-family: monospace; white-space: pre-wrap;" class="">intermediate types and constants. </span><span style="font-family: monospace; white-space: pre-wrap;" class="">Five</span></div><div class=""><span style="font-family: monospace; white-space: pre-wrap;" class="">lines </span><span style="font-family: monospace; white-space: pre-wrap;" class="">needed to be changed in the Oberon-07 compiler.</span></div><div class=""><div class=""><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class=""><br class=""></span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">This will now catch the type T in the following test </span><span style="white-space: pre-wrap; font-family: monospace;" class="">program provided </span><span style="font-family: monospace; white-space: pre-wrap;" class="">earlier:</span></div><div class=""><span style="font-family: monospace; white-space: pre-wrap;" class=""><br class=""></span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  MODULE Test;
<br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">    PROCEDURE P;
      TYPE T = INTEGER;</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class="Apple-interchange-newline">      PROCEDURE Q(x: T): T;   (* this is now caught -> “pos 78 must be strictly local or global" *)</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">        RETURN 0
      END Q;</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">
    END P;</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  END Test.</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  ORP.Compile Test.Mod ~</span></font></div></div><div class=""><br class=""></div><div class=""><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">Everything else stays the same, e.g. local procedures continue to be</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">allowed, all types of intermediate objects continue to be allowed (i.e.</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">constants, types, variables can all be declared as local objects inside</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">any procedure, whether global or local and at any nesting level). </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">It’s</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">just that the *access* for ALL intermediate objects is now </span><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">restricted</span></font></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">to either the strictly local </span><span style="font-family: monospace; white-space: pre-wrap;" class="">level or the strictly global (module) level.</span></div><div class=""><br class=""></div></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">Andreas</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">IMPLEMENTATION:  (see the output of the Unix diff command further down)</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">---------------</span></font><div class=""><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class=""><br class=""></span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">1. ORP.Declarations:</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class=""><br class=""></span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  PROCEDURE Declarations(VAR varsize: LONGINT);<br class="">    VAR obj, first: ORB.Object;<br class="">      x: ORG.Item; tp: ORB.Type; ptbase: PtrBase;<br class="">      expo: BOOLEAN; id: ORS.Ident;<br class="">  BEGIN (*sync*) pbsList := NIL;<br class="">    IF (sym < ORS.const) & (sym # ORS.end) & (sym # ORS.return) THEN ORS.Mark("declaration?");<br class="">      REPEAT ORS.Get(sym) UNTIL (sym >= ORS.const) OR (sym = ORS.end) OR (sym = ORS.return)<br class="">    END ;<br class="">    IF sym = ORS.const THEN<br class="">      ORS.Get(sym);<br class="">      WHILE sym = ORS.ident DO<br class="">        ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);<br class="">        IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("= ?") END;<br class="">        expression(x);<br class="">        IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END ;<br class="">        ORB.NewObj(obj, id, ORB.Const); obj.expo := expo; <b class="">obj.lev := level;</b><br class="">        <b class="">IF x.mode = ORB.Const THEN obj.type := x.type;<br class="">          IF x.type.form = ORB.String THEN obj.val := x.a + x.b*10000H ELSE obj.val := x.a END</b><br class="">        ELSE ORS.Mark("expression not constant"); obj.type := ORB.intType<br class="">        END;<br class="">        Check(ORS.semicolon, "; missing")<br class="">      END<br class="">    END ;</span></font><br class=""></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">    ...</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  END Declarations;</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">2. ORP.CheckLevel (new procedure inserted e.g. after ORP.Check)</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  <b class="">PROCEDURE CheckLevel(lev: INTEGER);</b></span></font></div><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><b class="">  BEGIN<br class="">    IF (lev > 0) & (lev # level) THEN ORS.Mark("must be strictly local or global") END<br class="">  END CheckLevel;</b><br class=""><br class=""></span></font><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">3. ORG.MakeItem:</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class=""><br class=""></span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">  PROCEDURE MakeItem*(VAR x: Item; y: ORB.Object; curlev: LONGINT);<br class="">  BEGIN x.mode := y.class; x.type := y.type; x.a := y.val; x.rdo := y.rdo;<br class="">    IF y.class = ORB.Par THEN x.b := 0<br class="">    ELSIF y.class = ORB.Typ THEN x.a := y.type.len; x.r := -y.lev<br class="">    ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">      <b class="">x.a := y.val MOD 10000H; (*strx*) x.b := y.val DIV 10000H (*len*)</b><br class="">    ELSE x.r := y.lev<br class="">    END ;<br class="">    IF <b class="">(y.lev > 0) & (y.lev # curlev) </b>THEN ORS.Mark("level error, not accessible") END<br class="">  END MakeItem;<br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">COMMENTS:</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">---------</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">1. ORP.Declarations: In essence one now sets obj.lev := level also for constants</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   (previously this was done only for types and variables, but not for constants)</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   I.e. the variable obj.lev is no longer “abused” to hold the length of a (string)</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   constant, </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">but to hold the scope level (this makes it possible to check for it in</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">   ORP.CheckLevel). </span><span style="white-space: pre-wrap; font-family: monospace;" class="">Instead both the address and the length of a string constant are</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">   now “encoded” (16 bits each) into a </span><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">single field (obj.val). This in turn </span></font><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">frees up</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   the obj.lev field </span></font><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">(which can now used to hold the actual scope level of the</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   constant). Note that </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">x.a and x.b are </span><span style="font-family: monospace; white-space: pre-wrap;" class="">themselves set by ORG.MakeStringItem</span></div><div class=""><span style="font-family: monospace; white-space: pre-wrap;" class="">   (see there; but it does not need to be changed)</span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">2. ORG. MakeItem: It simply performs the inverse operation as in ORP.Declarations.</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">   It </span></font><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">also removes the guard </span></font><span style="font-family: monospace; white-space: pre-wrap;" class="">(y.class # ORB.Const) in the last line of MakeItem that</span></div><div class=""><span style="font-family: monospace; white-space: pre-wrap;" class="">   used to be there for handle the special case of constants (..was kind of shady anyway).</span></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">3. This implementation makes </span></font><span style="white-space: pre-wrap; font-family: monospace;" class="">local procedures “self-contained”, i.e.</span></div><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">   one can move them around freely, make them global etc.</span></div><div class=""><br class=""></div><div class=""><br class=""></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">DIFFERENCES:</span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">-------------</span></font></div><div class=""><br class=""></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">Differences to the Original Oberon 2013 version </span></font><span style="font-family: monospace; white-space: pre-wrap;" class="">(as of Feb 10, 2018)</span></div><div class=""><div class=""><span style="white-space: pre-wrap; font-family: monospace;" class="">at <a href="https://www.inf.ethz.ch/personal/wirth" class="">https://www.inf.ethz.ch/personal/wirth</a> </span><span style="white-space: pre-wrap; font-family: monospace;" class="">are as follows:</span></div></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><b class="">$ diff ORP.Mod OriginalOberon2013/Sources/ORP.Mod</b></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">31,35d30<br class=""><   PROCEDURE CheckLevel(lev: INTEGER);<br class=""><   BEGIN<br class=""><     IF (lev > 0) & (lev # level) THEN ORS.Mark("must be strictly local or global") END<br class=""><   END CheckLevel;<br class="">< <br class="">45d39<br class=""><     ELSE CheckLevel(obj.lev)<br class="">803,805c797,798<br class=""><         ORB.NewObj(obj, id, ORB.Const); obj.expo := expo; obj.lev := level;<br class=""><         IF x.mode = ORB.Const THEN obj.type := x.type;<br class=""><           IF x.type.form = ORB.String THEN obj.val := x.a + x.b*10000H ELSE obj.val := x.a END<br class="">---<br class="">>         ORB.NewObj(obj, id, ORB.Const); obj.expo := expo;<br class="">>         IF x.mode = ORB.Const THEN obj.val := x.a; obj.lev := x.b; obj.type := x.type<br class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><b class="">$ diff ORG.Mod OriginalOberon2013/Sources/ORG.Mod </b></span></font></div><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">253c253<br class=""><     ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.a := y.val MOD 10000H; (*strx*) x.b := y.val DIV 10000H (*len*)<br class="">---<br class="">>     ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.b := y.lev  (*len*)<br class="">256c256<br class=""><     IF (y.lev > 0) & (y.lev # curlev) THEN ORS.Mark("level error, not accessible") END<br class="">---<br class=""></span></font><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class="">>     IF (y.lev > 0) & (y.lev # curlev) & (y.class # ORB.Const) THEN ORS.Mark("level error, not accessible") END </span></font></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div><div class=""><br class=""></div><div class=""><font face="monospace" class=""><span style="white-space: pre-wrap;" class=""><br class=""></span></font></div></div></div></div></body></html>