[OpenBIOS] [PATCH 7/10] Apple local variables implementation in Forth

[William Hahne]

On Wed, Aug 10, 2011 at 5:57 AM, Mark Cave-Ayland <
mark.cave-ayland at siriusit.co.uk> wrote:

> On 09/08/11 22:55, William Hahne wrote:
>
>  This is an implementation of Apple local variables which is required to
>> execute the Forth scripts in BootX
>>
>> Index: forth/bootstrap/bootstrap.fs
>> ==============================**==============================**=======
>> --- forth/bootstrap/bootstrap.fs (revision 1041)
>> +++ forth/bootstrap/bootstrap.fs (working copy)
>> @@ -1413,10 +1413,135 @@
>>    here last @ , latest !            \ write backlink and set latest
>>   ;
>> +\
>> +\ Defer required by BootX
>> +\
>> +defer spin
>> +
>> +\
>> +\ Local Variables (Apple specific)
>> +\
>> +
>> +\
>> +: has-locals ( -- true/false )
>> +  skipws
>> +  ib >in @ + c@ 7b <>
>> +  if false exit then
>> +  ib >in @ + 1+ c@ 20 >
>> +  if false exit then
>> +
>> +  true
>> + ;
>> +
>> +: comp-str-char ( str len char -- true/false )
>> +  swap 1 <> if 2drop false exit then
>> +  swap c@ <> if false exit then
>> +  true
>> + ;
>> +
>> +variable locals_wordlist
>> +variable locals_state \ 0 - reading args
>> +                      \ 1 - ;
>> +                      \ 2 - reading vars
>> +: read-locals ( -- addr0 .. addrN addrCount )
>> +  has-locals
>> +  not if 0 false exit then \ no locals
>> +
>> +  0 locals_state !
>> +  0 >r
>> +
>> +  s" get-current" $find drop execute
>> +  s" wordlist" $find drop execute
>> +  dup locals_wordlist !
>> +  s" set-current" $find drop execute
>> +
>> +  parse-word 2drop \ ditch the {
>> +
>> +  begin
>> +    parse-word
>> +
>> +    2dup 3b comp-str-char \ check for ;
>> +    if 1 locals_state ! then
>> +
>> +    2dup 7d comp-str-char \ check for }
>> +    not
>> +  while
>> +    locals_state @ 1 <> if \ the ; is not a local variable so ignore it
>> +      header
>> +
>> +      locals_state @ 0= if \ only save the address if it is an arg
>> +        r>
>> +        here na1+ >r
>> +        1+ >r
>> +      then
>> +
>> +      3 , 0 ,
>> +      reveal
>> +    else \ if we hit a ; then move to next state
>> +      2drop
>> +      2 locals_state !
>> +    then
>> +  repeat
>> +
>> +  2drop
>> +
>> +  s" set-current" $find drop execute
>> +
>> +  r> 0
>> +  begin
>> +    2dup
>> + >
>> +  while
>> +    r> -rot
>> +    1+
>> +  repeat
>> +
>> +  drop
>> +
>> +  true
>> + ;
>> +
>> +: begin-locals ( addr0 .. addrN count hasLocals -- )
>> +  not if drop exit then
>> +
>> +  dup 0> if
>> +    0 do
>> +      ['] (lit) , , ['] ! ,
>> +    loop
>> +  else drop then
>> +
>> +  s" get-order" $find drop execute
>> +  locals_wordlist @
>> +  swap 1+
>> +  s" set-order" $find drop execute
>> + ;
>> +
>> +: end-locals ( -- )
>> +  locals_wordlist @ 0= if exit then
>> +
>> +  0 locals_wordlist !
>> +
>> +  s" get-order" $find drop execute
>> +  swap drop 1-
>> +  s" set-order" $find drop execute
>> + ;
>> +
>> +: -> parse-word $find drop na1+
>> +  ['] (lit) , , ['] ! ,
>> + ; immediate
>> +
>> +\
>> +\ 7.3.9.1 Defining words
>> +\
>> +
>>  : :
>> -  parse-word header
>> -  1 , ]
>> +  parse-word >r >r
>> +  read-locals
>> +  r> r> header
>> +  1 ,
>> +  begin-locals
>> +  ]
>>    ;
>>  : :noname
>> @@ -1426,6 +1551,7 @@
>>    ;
>>  : ;
>> +  end-locals
>>    ['] (semis) , reveal ['] [ execute
>>    ; immediate
>>
>>
> 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?
>
>
This is an Apple specific thing. See
http://www.openfirmware.info/How_Local_Variables_in_Forth_Work_---_Using_Apple%E2%80%99s_Open_Firmware_Implementation



>
> ATB,
>
> Mark.
>
> --
> Mark Cave-Ayland - Senior Technical Architect
> PostgreSQL - PostGIS
> Sirius Corporation plc - control through freedom
> http://www.siriusit.co.uk
> t: +44 870 608 0063
>
> Sirius Labs: http://www.siriusit.co.uk/labs
>
> --
> OpenBIOS                 http://openbios.org/
> Mailinglist:  http://lists.openbios.org/**mailman/listinfo<http://lists.openbios.org/mailman/listinfo>
> Free your System - May the Forth be with you
>

William Hahne
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.openbios.org/pipermail/openbios/attachments/20110810/0b63f441/attachment.html>