\ inifini 05.2.27 NAB
\ original 2001May10 JCF
\ Tools for QF library code that
\ requires initialization and
\ finalization, just once each (at
\ program startup and switch-away).
\ Eg. MathLib needs to open a library
\ before use, but mustn't forget to
\ close it. inifini saves the day by
\ calling all known finalizers whenever
\ (bye) is called.
\ Must distinguish running at QF
\ console from standalone app. What
\ is initialized in console session at
\ the time MakePRC is called still
\ must be initialized anew in the
\ compiled app. BUT must not
\ multiply init even if developer tests
\ "go" many times in one console
\ session. Solution: call do-ini from
\ "go" but it's a noop unless running
\ standalone. At console, library files
\ execute their own inits when
\ included, and "needs" ensures it
\ happens but once. At the same time
\ the inits are added to a vector
\ made with literalxt and friends
\ (from xts) so it is still valid after
\ relocation. The vector, in the order
\ included, is used by do-ini when the
\ compiled app runs. Each init must
\ call add-fini if it does anything that
\ must be undone. The fini vector is in
\ dynamic memory (the one from
\ console session is useless to the
\ app) and executed LIFO.
\ What it all means: an app needs:
\    needs inifini
\    : go do-ini ... ;
\ A library module needs:
\    needs inifini
\    :NONAME
\    ...any needed cleanup... ;
\    :NONAME
\    ...any needed initialization...
\    [ SWAP ] literalxt add-fini ;
\    DUP add-ini EXECUTE
\ Note how the init word is both
\ passed to add-ini (for standalone)
\ and immediately executed (for
\ console). That's it! (If app switches
\ away using explicit PalmOS API
\ instead of (bye)/appStopEvent,
\ then call do-fini explicitly).
\ 2142 codespace, including "xts" &
\ "dspaces".

needs core-ext
needs xts

module inifini

: standalone?
    ['] (bye) 6 -
    DUP CELL+ cs@ SWAP cs@
    [ ' (bye) 6 -
    DUP CELL+ cs@ SWAP cs@ ] 2literal
    D= 0= ;

:NONAME ; xtvalue inivec

: corou [
    (hex) 205F cs, \ move.l (rp)+,a0
    (hex) 4E90 cs, \ jsr (a0)
] ; inline

public:

: add-ini ( xt -- )  ['] inivec xtfifo ;

HERE FALSE , \ already init'd?
: do-ini
    standalone? IF
        [ ROT ] LITERAL DUP @
        0= DUP IF
            SWAP !
            inivec EXECUTE
            corou (bye)
        ELSE
            2DROP
        THEN
    THEN
;

needs dspaces \ after corou

private:

dspace :init constant finivec

public:

: add-fini ( xt -- )
    finivec :,
;

: do-fini
    finivec :lock 2DUP
    2DUP @a 2 2OVER !a M+
    BEGIN
        -1 CELLS M+
        2OVER 2OVER DU< WHILE
        sp@ 2>R
            2DUP @a EXECUTE
        2R> sp!
    REPEAT 2DROP 2DROP
    finivec 2@ MemHandleUnlock
    DROP \ dare not THROW, here
;

private:

:NONAME
  do-fini
  [ action-of (bye) compile, ]
; is (bye)

dspace constant premakevec
dspace constant postmakevec
: pre-make premakevec :, ;
: post-make postmakevec :, ;
' noop post-make \ sop for ?DO

:NONAME
( xt crtr. inc vec do1 do2 -- xt crtr. )
    ?DO
        I (2>r) R@ :@
        EXECUTE 2R>
    OVER +LOOP 2DROP
;
:NONAME ( as MakePRC )
    2 premakevec DUP :here 2
    [ OVER COMPILE, ]
    DUP 2OVER 2OVER DROP
    MakePRC DROP
    2>R >R
    0. DmNextOpenResDatabase
    R> 2R>
    -2 postmakevec 2 OVER :here 2 -
    [ SWAP COMPILE, ]
    2DROP DROP 2DROP
;

public:
false warnings
: MakePRC
    postmakevec :here >R
    [ SWAP ] literalxt CATCH
    postmakevec R> OVER :here -
    SWAP :allot THROW ;
warnings drop

: marker' ( -- xt )
    S" MARKER ‡ ' ‡" EVALUATE
;

end-module
