various PETTIL design considerations

[chitselb]

I wrote <BUILDS DOES> , a little differently than I expected to. It works with these trivial examples and I expect it to work in most other situations. The design goals were

• separate compile time code from run time code
• small
• fast
• actually works
• use the <BUILDS DOES> syntax, which I have an aesthetic preference for
• might become a basis for more general-purpose objects later

Example usage:

Code: Select all

: konst  <builds , does> @ ;
15 konst fifteen

: kkonst <builds , , does> 2@ ;
3.1415926 kkonst pi

here's what gets stored in the core dictionary

Code: Select all

(konst)
	jsr dodoes
	.word fetch
	.word exit

fifteen
	jsr (konst)
	.word 15

(kkonst)
	jsr dodoes
	.word twofetch
	.word exit

pi
	jsr (kkonst)
	.byt df, 01, 75, 5e  ; 31415926 as 32 bits

and here's what goes in the transient dictionary

Code: Select all

konst
	jsr enter
	.word plit
	.word (konst)
	.word (create)       ; like CREATE, but takes a stack argument of the CFA to use
	.word comma
	.word exit

kkonst
	jsr enter
	.word plit
	.word (kkonst)
	.word (create)
	.word comma
	.word comma
	.word exit

The magic is in dodoes, which I wrote first. It extracts the parameter field (PFA) from the return stack to TOS, sets up the return stack EXIT, then fakes a call to ENTER. The code might seem a little strange due to the split return stack with separate TOS I'm using. EDIT: cleaner, 9 bytes shorter

Code: Select all

dodoes
    jsr slip        ; slip something onto the stack
    stx xsave
    pla
    tax
    pla
    tay
    pla
    sta tos
    pla
    sta tos+1       ; PFA to TOS
    jsr inctos      ; PFA was off by one because of what JSR pushes
    lda ip+1
    pha
    lda ip
    pha             ; IP to return stack (for EXIT)
    stx ip
    sty ip+1        ; set IP from calling child word
    ldx xsave
    jmp next1       ; this entry point into NEXT only single-increments IP

I realize this post is already a little bloaty, but here's the high-level code for <BUILDS DOES>

Code: Select all

: @swap!   ( a b -- )
    2dup 2>r
    @ swap @
    r> ! r> ! ;

: dpswap   ( -- )
    dp tdp @swap! ;

: <builds   ( == ; "name" -- )
    compiling?
    if
        dp tdp latest   ( b c f )
        bishwhet   ( a a c b-a )
        cmove  
        compile plit , compile (create)
    then ; immediate

: does>
    compiling?
    if
        compile exit
        dp @ tdp @ >  
        if
            dpswap
        then
        ['] dodoes cfa,
    then ; immediate

bishwhet is a no-symbol Sweet16 code word used by <BUILDS to keep the code volume down. It juggles the stack and sets the DP and TDP pointers

Code: Select all

core                    tdict             symnew
----+----+---           ----+----*-       ----.-+-------
    ^A   ^B                 ^C   ^D           ^E^F
A = DP before this definition was created
B = DP when <BUILDS is encountered
C = TDP before this definition was created
D = TDP after moving this definition to TDICT
E = CFA of LATEST definition
F = LATEST
bishwhet
    ldy #4
    jsr locals
    brk
    .byt popd | TOS
    .byt st | N2        ; A
    .byt ldd | N0       ; @dp
    .byt popd | N0      ; reget B
    .byt sub | N2       ; size
    .byt st | N3        ; B-A
    .byt ldd | N1       ; @tdp
    .byt popd | N1      ; reget C
    .byt st | N4
    .byt std | TOS      ; set latest E = C
    .byt add | N3
    .byt std | N0       ; set DP = C+X
    .byt ld | N2
    .byt std | N1
    .byt st | TOS       ; ( a )
    .byt push           ; ( a a )
    .byt ld | N4
    .byt push           ; ( a a c )
    .byt ld | N3
    .byt push           ; ( a a c b-a )
    .byt nxt

[chitselb]

Having implemented a working <BUILDS DOES> system, I'm working on ;CODE now. This is what I've got so far:

• uses CREATE ... ;CODE syntax to define children (where `CREATE` is a generic creator)
• slightly more raw, primitive interface than <BUILDS ... DOES> (does not retrieve PFA to TOS and increment it);
• Assembly code between ;CODE ... END-CODE will derive PFA contents from the JSR call on the return stack
• does not split parent/child between transient and core dictionary spaces
• ;CODE will compile a word (;CODE) that replaces the CFA of the LATEST definition with a JSR to the common child runtime code

Here's my test case, a rewrite of USER , which creates user variables (such as DP and BLK)

Code: Select all

: luser cconstant ;code
        pla,   \ <-- Point A
n       sta,
        pla,
n 1+    sta,   \ uses N scratch area instead of TOS to access PFA
1 #     ldy,   \ uses Y offset of +1 instead of incrementing PFA
        clc,
n )y    lda,
up      adc,
up 1+   ldy,   \ carry ignored because userarea fits inside one page
pushya  jmp,   \ push the address of the luservariable to the data stack
end-code

10 luser clonedp  ( overlaps `dp` in userarea )
clonedp @  here  -  .  0  ok   ( because `clonedp` is same as `dp` )

Best I can come up with is to have (;CODE) (aka dosemicode) replace the CFA of the child with `JSR PointA`. The assembly code at PointA would not need to be page-aligned to get around the JMP ($xxFF) bug, but it would lose its former identity when (;CODE) overwrites its CFA. Internally, this would look something like:

Code: Select all

luser
        jsr enter
        .word cconstant     \ high level code to define a child
        .word dosemicode    \ replaces child CFA with `(luser)` then parent exits

(luser)    ( <-- Point A )  \ common child runtime code, always begins at
        pla                 \ the address immediately following (;CODE)
        sta n
        pla
        sta n+1
        etc...

clonedp
        jsr docconstant
        .byt 10

Which would be transformed by (;CODE) into:

Code: Select all

clonedp
        jsr (luser)
        .byt 10

But then the child loses all sense of what it was ever like to be a CCONSTANT. Should this be implemented in a way that completely invokes the original child (in this case, a byte constant which leaves a '10' on the data stack) before calling the common runtime code between ;CODE and END-CODE? Things begin to feel very CORBAesque. I feel like I've painted myself into a corner here.

In the high level version, `<BUILDS`took care of child creation for me, and all children inherited specific traits of the parent (jsr doparent) as well as common traits of generic DOERs (jsr dodoes). With `;CODE` the child word could have been created by just about any defining word. Does this simple approach to ;CODE lack any essential elements?

Also, is there a shorthand term for common child runtime code? Would CCR work?

[chitselb]

Here's working code for CREATE ... ;CODE ... END-CODE words

Code: Select all

\ part of what `;` does, refactored to share among `;` `;CODE` and `END-CODE`
: close-definition   ( -- )
    ?csp  latest unsmudge  redefined dup @ dup
    ?: smudge drop  off  [ ;

\ enables assembler vocabulary; sets base to hex; saves copy of stack pointer for END-CODE's ?CSP
: code-fixup   ( -- )
    hex !csp assembler mem ;

\ replaces the CFA of the LATEST definition with the address following ;CODE
: (;code)
    r> 2+  latest name> 1+  ! ;

\ finishes the definition segment of CREATE ... ;CODE ... END-CODE words, begins runtime segment
: ;code 
    ?comp  compile (;code)  close-definition  code-fixup ; immediate

[chitselb]

Another weekend, another opportunity to endanger future weekends!

Objects In PETTIL

The idea here is to do some form of lightweight objects, to be invoked like:

Code: Select all

[parameter...] verb noun
e.g.   13 DRAW PLAYER

might draw the player at horizontal position 13. In this case, PLAYER might be an instance of ACTOR, and ACTORs all would share a DRAW method that takes a column number as a parameter. Properties like "what shape is the player now?" and "what is the PLAYER's current position so DRAW can erase it?" would be on the Object (instance). I'm thinking something halfway between pared-down Java, and CREATE ... DOES> on steroids. Multiple CFAs and shared code are the main objectives.

I realize that things like this have been done before (MOPS, Yerks), this is overkill for Forth, and I probably should let it rest. The project wouldn't be as much fun if I didn't get to have these arguments with myself in public.

[chitselb]

There are no headers in the PETTIL dictionary, it's just code, so falling through to the next word, denser code = more local branching, and intertwingling things just works a lot better. I just played a bunch of code golf with the words: 0 FALSE -1 TRUE 0= 0<> 0< and squeezed 41 bytes down to 38, a whopping three bytes! It was fun and confusing to come up with this code, presented here side by side for your enjoyment and critique.

Code: Select all

After                           Before
de0       18 29 38 a9 0a a0     dd8 a9 ff a8 4c e8 0a a9 00
de8 e7 48 98 48 a0 00 90 01     de0 f0 f8 a0 00 a5 02 05 03
df0 88 98 60 18 29 38 a5 02     de8 d0 01 88 98 4c 06 09 a0
df8 05 03 d0 06 c6 03 b0 f3     df0 00 24 03 30 f5 10 f4 a0
de0 06 03 a9 09 a0 05 d0 e1     df8 00 a5 02 05 03 d0 eb f0
                                e00 ea

0 FALSE -1 TRUE 0= 0<> 0<       -1 TRUE 0 FALSE 0= 0< 0<>

                                minusone         ; -1
zero          ; 0               true             ; TRUE
false         ; FALSE               lda #$ff
    clc                         true01
    .byt $29      ;[A]              tay
minusone      ; -1                  jmp pushya
true          ; TRUE            zero             ; 0
    sec                         false            ; FALSE
pushc                               lda #0
    lda #>(pushya-1)                beq true01
    ldy #<(pushya-1)            zeq              ; 0=
rightchere        ;[B]              ldy #$00
    pha                             lda tos
    tya                             ora tos+1
    pha                             bne zeq02
ctoyarts          ;[C]          zeq01
    ldy #0                          dey
    bcc yyrts                   zeq02
    dey                             tya
yyrts                               jmp put
    tya                         zlt              ; 0<
    rts                             ldy #0
zeq           ; 0=                  bit tos+1
    clc                             bmi zeq01          ;[Z]
    .byt $29       ;[A]             bpl zeq02
zne           ; 0<>             zne              ; 0<>
    sec                             ldy #0
    lda tos                         lda tos
    ora tos+1                       ora tos+1
    bne putc      ;[D]              bne zeq01          ;[Z]
    dec tos+1                       beq zeq02
    bcs zeq
zlt           ; 0<
    asl tos+1
putc              ;[E]
    lda #>(put-1)
    ldy #<(put-1)
    bne rightchere

`pushya` pushes YA registers to the data stack, then NEXT
`put` replaces TOS with YA registers, then NEXT

[A] 'AND # as NOP' trick saves a byte vs a branch instruction to skip past the next instruction (in this case SEC). The BIT opcodes are pretty useful for this too.

{B} 'PHA PHA RTS' trick to effect branching, in this case to the address passed in AY

[C] Turns the carry flag into TRUE or FALSE and branch to the address in AY. Just about all of the boolean conditional tests should wind up finishing here.

[D] 0= and 0<> either clear or set carry. Then LDA/ORA is performed and nonzero results are handled. Otherwise the 0 is turned into -1 and sent back through to invert the carry flag. Sort of. This is the confusing part.

[E] Is the entry point, given C and AY will transform the carry flag into TRUE or FALSE in AY, the address passed in by RTS. Just about all of the boolean conditional tests should wind up finishing here.

[Z] This is the antipattern of two consecutive branches performing identical tests. To be avoided.

edit: I spotted it after I posted the code and looked at it in the browser, always the way. Same size, slightly faster, less convoluted

Code: Select all

replace:
    bne putc
    dec tos+1                   ; toggle C flag, then putc
    bcs zeq

with:
    bne putc
    bcs zlt
    dec tos+1                   ; toggle C flag, then putc

[chitselb]

Here's a link to an article I put in comp.lang.forth

https://groups.google.com/d/msg/comp.la ... vpOloiDAAJ

[chitselb]

Things are progressing with PETTIL in spurts and starts, working toward a 1.0 release with a huge project coming in right behind it.

What would you call it? I am in need of a decent name for something case-like, and contemplating a design like this:

Code: Select all

somewhere in the middle of some user code secondary word...
45F3 04 42    ; `helicopter`
45F5 E0 0F    ; `@`
45F7 80 1A    ; `+@EXECUTE`
              ; +@EXECUTE gets its arguments inline
45F9 05       ; number of cases
45FA E2 44    ; <-- 0/default   various things that happen 
45FC F6 44    ; <-- 1           for values 0..4 (CFA table)
45FE 03 45    ; <-- 2           
4600 18 45    ; <-- 3           
4602 C6 45    ; <-- 4 
4604 B6 09    ; `dup`     execution resumes here at NEXT

code for +@EXECUTE
1A80 20 F4 10   ; jsr enter    
1A82 40 0B      ; `2*` cfa
1A84 ... add tos*2 to ip, fetch the CFA there, execute that word,  
add (2 * number of cases + 1) to IP and resume execution.  

The IP trace at NEXT for the above example would look like:
45F3 45F5 45F7 
4518 (assumes there was `3` stored in `helicopter` variable)
4604 4606  <-- we arrive here after `dup` executes

I dislike calling it `+@execute` but haven't come up with something better, or found a similar thing. PETTIL does have `?:` which works like IF/ELSE/THEN but only takes up 6 bytes per use, with the restriction that true/false options are limited to executing a CFA. This word does a thing like that, but with potentially more than two branches.

[GARTHWILSON]

I don't have an idea for a name yet, except to point out that @EXECUTE has a slightly shorter name: PERFORM. So, +PERFORM ? Your word is doing different stuff though. It's interesting. How do you plan to use it? As I understand it, it's related to CASE but more efficient in certain situations it can be used in, like also your ?: .

[chitselb]

GARTHWILSON wrote:

I don't have an idea for a name yet, except to point out that @EXECUTE has a slightly shorter name: PERFORM. So, +PERFORM ? Your word is doing different stuff though. It's interesting. How do you plan to use it? As I understand it, it's related to CASE but more efficient in certain situations it can be used in, like also your ?: .

It's really most closely related to BASIC's ON-GOSUB

[JimBoyd]

chitselb wrote:

Things are progressing with PETTIL in spurts and starts, working toward a 1.0 release with a huge project coming in right behind it.

What would you call it? I am in need of a decent name for something case-like, and contemplating a design like this:

Code: Select all

somewhere in the middle of some user code secondary word...
45F3 04 42    ; `helicopter`
45F5 E0 0F    ; `@`
45F7 80 1A    ; `+@EXECUTE`
              ; +@EXECUTE gets its arguments inline
45F9 05       ; number of cases
45FA E2 44    ; <-- 0/default   various things that happen 
45FC F6 44    ; <-- 1           for values 0..4 (CFA table)
45FE 03 45    ; <-- 2           
4600 18 45    ; <-- 3           
4602 C6 45    ; <-- 4 
4604 B6 09    ; `dup`     execution resumes here at NEXT

code for +@EXECUTE
1A80 20 F4 10   ; jsr enter    
1A82 40 0B      ; `2*` cfa
1A84 ... add tos*2 to ip, fetch the CFA there, execute that word,  
add (2 * number of cases + 1) to IP and resume execution.  

The IP trace at NEXT for the above example would look like:
45F3 45F5 45F7 
4518 (assumes there was `3` stored in `helicopter` variable)
4604 4606  <-- we arrive here after `dup` executes

I dislike calling it `+@execute` but haven't come up with something better, or found a similar thing. PETTIL does have `?:` which works like IF/ELSE/THEN but only takes up 6 bytes per use, with the restriction that true/false options are limited to executing a CFA. This word does a thing like that, but with potentially more than two branches.

Since it looks like a mini case statement, you could call it CASE# ( or #CASE ), but how did you plan to use it? Like this?

Code: Select all

... HEICOPTER @ CASE# [ 5 C, ] WORD0 WORD1 WORD2 WORD3 WORD4 DUP ...

If that's the case, ( no pun intended ) here is a suggestion. You could name it (CASE#) or something you find more suitable and define some high level helper words CASE[ and ]END-CASE. CASE[ would compile (CASE#) and reserve one byte of memory for the number of cases, leaving the address to be patched on the data stack. ]END-CASE would count the number of words compiled after (CASE#) and do the patching. NOTE: I'm away from my desktop computer, which has the VICE Commodore simulator, so I haven't been able to test this yet.

Code: Select all

// FOR SYSTEM WITH 16 BIT ADDRESSES LIKE PET AND C64
: CASE[  ( -- ADR )  COMPILE (CASE#)  HERE 0 C, ; IMMEDIATE
: ]END-CASE  ( ADR -- )  HERE OVER - 1- 2/ SWAP C! ; IMMEDIATE

The intervening words would be compiled normally so it would be used like this:

Code: Select all

... HELICOPTER @ CASE[ WORD0 WORD1 WORD2 WORD3 WORD4 ]END-CASE DUP ...

Hope this helps.

BTW If you change (CASE#) so instead of an inline count, it uses an inline address to branch past the different cases, CASE[ and ]END-CASE become easier to define:

Code: Select all

: CASE[  ( -- ADR )  COMPILE (CASE#)  HERE 0 , ; IMMEDIATE
: ]END-CASE  ( ADR -- )  HERE SWAP ! ; IMMEDIATE

Or with a little compiler security ( just to make sure STATE is compiling ).

Code: Select all

: CASE[  ( -- ADR CS.NUMBER )  COMPILE (CASE#) >MARK ; IMMEDIATE
: ]END-CASE  ( ADR CS.NUMBER -- ) >RESOLVE ; IMMEDIATE

]END-CASE becomes an alias for THEN in this last example. IIRC you were trying to keep the size down. To define fewer words:

Code: Select all

: CASE#  ( -- ADR CS.NUMBER )  COMPILE (CASE#) >MARK ; IMMEDIATE

And it would use THEN to resolve the address:

Code: Select all

... HELICOPTER @ CASE# WORD0 WORD1 WORD2 WORD3 WORD4 THEN DUP ...

Wether you use any of this or not, I hope it gives you food for thought.
Cheers,
Jim

[chitselb]

JimBoyd wrote:

... { lots of spot on suggestions and code } ...
Hope this helps.
... { more of that } ...

This is a very good design, and it seems vaguely familiar from what I vaguely remember from some Forth Dimensions articles on CASE, so it has that 'all the cool kids are doing it' thing going for it as well! Thank you!

Code: Select all

: CASE[  ( -- ADR )  COMPILE (CASE#)  HERE 0 , ; IMMEDIATE
: ]END-CASE  ( ADR -- )  HERE SWAP ! ; IMMEDIATE

pretty sure this should be :
[code]: CASE[  ( -- ADR )  COMPILE (CASE#)  HERE 0 C, ; IMMEDIATE
: ]END-CASE  ( ADR -- )  HERE SWAP C! ; IMMEDIATE

[GARTHWILSON]

{ and } turned out to be a neat little addition to my Forth tool box, from Forth Dimensions magazine, for situations where I didn't want the code to require an exact number of inputs. { and } tell the code how many inputs there are, so it can handle it just fine.

Code: Select all

WSIZE VAR BEG_DEPTH              \ Variable to store the beginning stack depth for
                                 \ { and } below.  You can start a series of stack
: {          ( -- )              \ entries with {, and end it with }.  The final }
   DEPTH  BEG_DEPTH  !       ;   \ puts a number on TOS telling how many items got
                                 \ added to the stack, not including itself, since
: }        ( -- n )              \ the {.  This way, code can appropriately handle
   DEPTH  BEG_DEPTH  @   -   ;   \ an arbitrary number of stack entries.

Even the programmer does not need to know how exactly how many there will be (for example if the numbers are laid down by an iterative function, even at run time), as long as he knows it won't overrun the data stack. { and } can be used in many kinds of situations. An example usage is:

Code: Select all

    CASE
           1                      OF   <do_stuff>   END_OF
           2                      OF   <do_stuff>   END_OF
           3  11            RANGE_OF   <do_stuff>   END_OF
        { 13  25  93  551 }   SET_OF   <do_stuff>   END_OF
          <default actions used for any case not specified above>
    END_CASE

What's between { and } can be constants, expressions to be evaluated at assembly time, etc.. They could be compiled by a function that runs at compile time, or put on the stack by a function that runs at run time.

Edited. Hopefully I got it right this time.

[barrym95838]

Code: Select all

{ 13 , 25 , 93 , 551 }

Possibly n00b confusion on my part, Garth, but won't those commas mess up what your curly brackets are trying to measure?

[GARTHWILSON]

You're right. I modified something from elsewhere, in too big of a hurry. If commas were right, I'd be missing the last one anyway. I'll fix it. Thanks.

[JimBoyd]

chitselb wrote:

JimBoyd wrote:

... { lots of spot on suggestions and code } ...
Hope this helps.
... { more of that } ...

This is a very good design, and it seems vaguely familiar from what I vaguely remember from some Forth Dimensions articles on CASE, so it has that 'all the cool kids are doing it' thing going for it as well! Thank you!

You're welcome. I wrote the following last night when I got home so I could verify that it works.
Mine is an ITC Forth.

Code: Select all

SCR# A0 
// (CASE#)
HEX
CODE (CASE#)  ( N -- )
   0 ,X LDA,
   IP )Y CMP,       // COMPARE TOS
   CS IF,           // WITH # CASES
      TYA,          // AND ZERO IF
   THEN,            // TOO BIG
   .A ASL,  TAY,  INY,
   IP )Y LDA,  W    STA,  INY,
   IP )Y LDA,  W 1+ STA,  0 # LDY,
   IP )Y LDA,  .A ASL,
   SEC,  IP    ADC,  IP    STA,
   TYA,  IP 1+ ADC,  IP 1+ STA,
   INX,  INX,  W 1- JMP,
END-CODE

SCR# A1 
// CASE[ ]END-CASE
HEX
: CASE[  ( -- ADR )
   COMPILE (CASE#)  HERE 0 C, ;
   IMMEDIATE
: ]END-CASE  ( ADR -- )
   HERE OVER - 1- 2/ SWAP C! ;
   IMMEDIATE

SCR# A2 
// TEST OF CASE[ ]END-CASE
HEX
: POWER  ." POWERING UP SYSTEMS." ;
: TAKEOFF  ." VERTICAL ASCENT." ;
: HOVER   ." AIRWOLF HOVERING." ;
: TURBO   ." TURBOS ENGAGED!" ;
: LAND   ." LANDING AIRWOLF." ;
VARIABLE HELICOPTER
: AIRWOLF  ( -- )
   HELICOPTER @ CASE[
      POWER TAKEOFF HOVER TURBO
      LAND  ]END-CASE
   CR .S ;

And it does.
That's about all I had time for.