Very interesting, thank you Cees. Note that a problem will occur when
using destroy[] in a callback. During a callback, by default, the
search order is undefined and usually results in an Access Violation.
One could set the search order during every callback. A better
solution would be to compile the xt of the instance instead of a text
string followed by search-wordlist. Maybe something like the
following (untested and simplified, i.e. not state smart):

: (destroy[]) ( xt -- )
 \ OLD get-current search-wordlist 0= throw ( -- xt )
   dup>r execute ( -- allocAddr+12 )
   ... etc

: destroy[] ( <name> -- )
  postpone ['] postpone (destroy[]) ; immediate

Mike

-----Original Message-----
From: sftalk-bounce_at_forth.com [mailto:sftalk-bounce_at_forth.com]On
Behalf
Of Cees van Zeeland
Sent: Friday, September 03, 2004 6:48 AM
To: SF Talk
Subject: [sftalk] Re: Indexed Dynamic Object

Hi,

I hope this comes near.

Cees

package oop

public

: New[] ( n class -- addr )
    dup sizeof ( ... -- n class Objectsize )
    third * ( ... -- n class indexedObjectsize )
    3 cells + ( ... -- n class indexedObjectsize+Info )
    allocate throw ( ... -- n class allocAddr )
    objtag !+ ( ... -- n class allocAddr+4 )
    over !+ ( ... -- n class allocAddr+8 )
    rot !+ ( ... -- class allocAddr+12 )
    tuck ( a c a) [member] construct broadcast ( ... -- allocAddr+12
) ;

private

: <Data[] ( n Addr -- OffsetAddr )
    2 cells - ( ... -- n allocAddr+4 )
    @+ dup ( ... -- n allocAddr+8 class class )
>classtag @ classtag <> abort" USING[] must be preceded by an
indexed object Address" ( ... -- n allocAddr+8 class )
    sizeof >r ( ... -- n allocAddr+8 )
    @+ 1- ( ... -- n allocAddr+12 index )
    rot 0 max min ( ... -- allocAddr+12 indexChecked )
    r> * + ( ... -- OffsetAddr ) ;

: (using[]) ( n allocAddr+12 -- )
    <data[] ( ... -- OffsetAddr )
    ' dup >classtag @ classtag <> abort" class name must follow
USING[]"
>this +members ;

public

: using[] ( n allocAddr+12 -- )
    state @
    if postpone <data[]
            ' dup >classtag @ classtag <> abort" class name must
follow USING[]"
>this +members
    else (using[])
    then ; immediate

private

: (destroy[]) ( addr len -- )
    get-current search-wordlist 0= throw ( -- xt )
    dup>r execute ( -- allocAddr+12 )
    dup 2 cells - @ ( -- allocAddr+12 class )
    over ( -- allocAddr+12 class allocAddr+12 )
    [member] destruct broadcast ( -- allocAddr+12 )
    3 cells - ( -- allocAddr )
    free throw
    0 r> >body ! ; \ Initialize Value

public

: destroy[] ( <name> -- )
    state @
    if postpone (s") bl string
            postpone (destroy[])
    else bl word count (destroy[])
    then ; immediate

end-package

CLASS WIDGETS
    VARIABLE Height
    VARIABLE Width
END-CLASS

0 value DynamicObject

: FOO ( -- )
    10 ( #widgets ) WIDGETS NEW[] ( allocated memory address ) to
DynamicObject

    10 0 DO I DynamicObject using[] WIDGETS Height @ . LOOP

    Destroy[] DynamicObject ;

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and
bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Fri Sep 03 2004 - 10:44:55 PDT