<br><br><div class="gmail_quote">On Wed, Aug 10, 2011 at 5:57 AM, Mark Cave-Ayland <span dir="ltr"><<a href="mailto:mark.cave-ayland@siriusit.co.uk">mark.cave-ayland@siriusit.co.uk</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
<div><div></div><div class="h5">On 09/08/11 22:55, William Hahne wrote:<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
This is an implementation of Apple local variables which is required to<br>
execute the Forth scripts in BootX<br>
<br>
Index: forth/bootstrap/bootstrap.fs<br>
==============================<u></u>==============================<u></u>=======<br>
--- forth/bootstrap/bootstrap.fs (revision 1041)<br>
+++ forth/bootstrap/bootstrap.fs (working copy)<br>
@@ -1413,10 +1413,135 @@<br>
    here last @ , latest !            \ write backlink and set latest<br>
   ;<br>
+\<br>
+\ Defer required by BootX<br>
+\<br>
+defer spin<br>
+<br>
+\<br>
+\ Local Variables (Apple specific)<br>
+\<br>
+<br>
+\<br>
+: has-locals ( -- true/false )<br>
+  skipws<br>
+  ib >in @ + c@ 7b <><br>
+  if false exit then<br>
+  ib >in @ + 1+ c@ 20 ><br>
+  if false exit then<br>
+<br>
+  true<br>
+ ;<br>
+<br>
+: comp-str-char ( str len char -- true/false )<br>
+  swap 1 <> if 2drop false exit then<br>
+  swap c@ <> if false exit then<br>
+  true<br>
+ ;<br>
+<br>
+variable locals_wordlist<br>
+variable locals_state \ 0 - reading args<br>
+                      \ 1 - ;<br>
+                      \ 2 - reading vars<br>
+: read-locals ( -- addr0 .. addrN addrCount )<br>
+  has-locals<br>
+  not if 0 false exit then \ no locals<br>
+<br>
+  0 locals_state !<br>
+  0 >r<br>
+<br>
+  s" get-current" $find drop execute<br>
+  s" wordlist" $find drop execute<br>
+  dup locals_wordlist !<br>
+  s" set-current" $find drop execute<br>
+<br>
+  parse-word 2drop \ ditch the {<br>
+<br>
+  begin<br>
+    parse-word<br>
+<br>
+    2dup 3b comp-str-char \ check for ;<br>
+    if 1 locals_state ! then<br>
+<br>
+    2dup 7d comp-str-char \ check for }<br>
+    not<br>
+  while<br>
+    locals_state @ 1 <> if \ the ; is not a local variable so ignore it<br>
+      header<br>
+<br>
+      locals_state @ 0= if \ only save the address if it is an arg<br>
+        r><br>
+        here na1+ >r<br>
+        1+ >r<br>
+      then<br>
+<br>
+      3 , 0 ,<br>
+      reveal<br>
+    else \ if we hit a ; then move to next state<br>
+      2drop<br>
+      2 locals_state !<br>
+    then<br>
+  repeat<br>
+<br>
+  2drop<br>
+<br>
+  s" set-current" $find drop execute<br>
+<br>
+  r> 0<br>
+  begin<br>
+    2dup<br>
+ ><br>
+  while<br>
+    r> -rot<br>
+    1+<br>
+  repeat<br>
+<br>
+  drop<br>
+<br>
+  true<br>
+ ;<br>
+<br>
+: begin-locals ( addr0 .. addrN count hasLocals -- )<br>
+  not if drop exit then<br>
+<br>
+  dup 0> if<br>
+    0 do<br>
+      ['] (lit) , , ['] ! ,<br>
+    loop<br>
+  else drop then<br>
+<br>
+  s" get-order" $find drop execute<br>
+  locals_wordlist @<br>
+  swap 1+<br>
+  s" set-order" $find drop execute<br>
+ ;<br>
+<br>
+: end-locals ( -- )<br>
+  locals_wordlist @ 0= if exit then<br>
+<br>
+  0 locals_wordlist !<br>
+<br>
+  s" get-order" $find drop execute<br>
+  swap drop 1-<br>
+  s" set-order" $find drop execute<br>
+ ;<br>
+<br>
+: -> parse-word $find drop na1+<br>
+  ['] (lit) , , ['] ! ,<br>
+ ; immediate<br>
+<br>
+\<br>
+\ 7.3.9.1 Defining words<br>
+\<br>
+<br>
  : :<br>
-  parse-word header<br>
-  1 , ]<br>
+  parse-word >r >r<br>
+  read-locals<br>
+  r> r> header<br>
+  1 ,<br>
+  begin-locals<br>
+  ]<br>
    ;<br>
  : :noname<br>
@@ -1426,6 +1551,7 @@<br>
    ;<br>
  : ;<br>
+  end-locals<br>
    ['] (semis) , reveal ['] [ execute<br>
    ; immediate<br>
<br>
</blockquote>
<br></div></div>
Very interesting. I think this needs someone with quite strong Forth-fu (Stefan) to review this one. Also I can't see any related documentation with this patch related to locals support?<br>
<br></blockquote><div><br></div><div>This is an Apple specific thing. See <a href="http://www.openfirmware.info/How_Local_Variables_in_Forth_Work_---_Using_Apple%E2%80%99s_Open_Firmware_Implementation">http://www.openfirmware.info/How_Local_Variables_in_Forth_Work_---_Using_Apple%E2%80%99s_Open_Firmware_Implementation</a> </div>
<div> </div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
<br>
ATB,<br>
<br>
Mark.<br>
<br>
-- <br>
Mark Cave-Ayland - Senior Technical Architect<br>
PostgreSQL - PostGIS<br>
Sirius Corporation plc - control through freedom<br>
<a href="http://www.siriusit.co.uk" target="_blank">http://www.siriusit.co.uk</a><br>
t: <a href="tel:%2B44%20870%20608%200063" value="+448706080063" target="_blank">+44 870 608 0063</a><br>
<br>
Sirius Labs: <a href="http://www.siriusit.co.uk/labs" target="_blank">http://www.siriusit.co.uk/labs</a><br><font color="#888888">
<br>
-- <br>
OpenBIOS                 <a href="http://openbios.org/" target="_blank">http://openbios.org/</a><br>
Mailinglist:  <a href="http://lists.openbios.org/mailman/listinfo" target="_blank">http://lists.openbios.org/<u></u>mailman/listinfo</a><br>
Free your System - May the Forth be with you<br>
</font></blockquote></div><br><div>William Hahne</div>