6502.org Forum  Projects  Code  Documents  Tools  Forum
It is currently Thu Nov 21, 2024 5:45 pm

All times are UTC




Post new topic Reply to topic  [ 110 posts ]  Go to page Previous  1 ... 3, 4, 5, 6, 7, 8  Next
Author Message
PostPosted: Tue Sep 15, 2015 7:10 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
: konst  <builds , does> @ ;
15 konst fifteen

: kkonst <builds , , does> 2@ ;
3.1415926 kkonst pi
here's what gets stored in the core dictionary
Code:
(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:
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:
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:
: @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:
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


Top
 Profile  
Reply with quote  
PostPosted: Wed Sep 16, 2015 8:59 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
: 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:
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:
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?


Top
 Profile  
Reply with quote  
PostPosted: Thu Sep 17, 2015 3:02 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
Here's working code for CREATE ... ;CODE ... END-CODE words
Code:
\ 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


Top
 Profile  
Reply with quote  
PostPosted: Mon Oct 05, 2015 4:53 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
[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.


Top
 Profile  
Reply with quote  
PostPosted: Mon Jul 31, 2017 4:41 am 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
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:
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


Top
 Profile  
Reply with quote  
PostPosted: Mon Aug 21, 2017 2:40 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
Here's a link to an article I put in comp.lang.forth

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


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 6:16 am 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
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.


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 7:40 am 
Offline
User avatar

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8543
Location: Southern California
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 ?: .

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 7:42 am 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 8:40 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
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:
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:
... 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:
// 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:
... 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:
: 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:
: 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:
: CASE#  ( -- ADR CS.NUMBER )  COMPILE (CASE#) >MARK ; IMMEDIATE

And it would use THEN to resolve the address:
Code:
... 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


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 11:27 pm 
Offline

Joined: Sat Aug 21, 2010 7:52 am
Posts: 231
Location: Arlington VA
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:
: 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


Top
 Profile  
Reply with quote  
PostPosted: Sun Sep 16, 2018 11:35 pm 
Offline
User avatar

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8543
Location: Southern California
{ 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:
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:
    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.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?


Top
 Profile  
Reply with quote  
PostPosted: Mon Sep 17, 2018 12:04 am 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1949
Location: Sacramento, CA, USA
Code:
{ 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?

_________________
Got a kilobyte lying fallow in your 65xx's memory map? Sprinkle some VTL02C on it and see how it grows on you!

Mike B. (about me) (learning how to github)


Top
 Profile  
Reply with quote  
PostPosted: Mon Sep 17, 2018 1:16 am 
Offline
User avatar

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8543
Location: Southern California
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.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?


Top
 Profile  
Reply with quote  
PostPosted: Mon Sep 17, 2018 8:47 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
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:

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.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 110 posts ]  Go to page Previous  1 ... 3, 4, 5, 6, 7, 8  Next

All times are UTC


Who is online

Users browsing this forum: No registered users and 14 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to: