<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>