Does anyone have experience doing a 'writeback' in an ASM program on the CE?

I'm talking about the writeback described in the Learn TI-83 Plus Assembly in 28 Days page found here: http://tutorials.eeems.ca/ASMin28Days/lesson/day20.html

I believe that 3 bytes are used to store size on the CE (as opposed to 2 bytes as described in the ASM in 28 tut). I've written code to create and/or open an AppVar and I've found that loading a 24 bit register from the 3 bytes at the beginning of the data works correctly gives the AppVars size.

Because of this, I assume that the data location for an asm program (identified in the VAT) will begin with

So, I believe the following code from the ASM in 28 tut...


Code:
    b_call(_PopRealO1)     ;Retrieve OP1 for writeback
    b_call(_ChkFindSym)

    ;Find data location as offset from start of program.
    LD    HL, DataStart - $9D95 + 4    ;Have to add 4 because of tAsmCmp token
                                      ;(2 bytes) and for size bytes (2 bytes)
    ADD    HL, DE        ;HL now points to data location in original program.
    EX    DE, HL         ;Write back.
    LD    HL, DataStart
    LD    BC, DataEnd - DataStart
    LDIR
    RET
DataStart:
counter:    .DW    10000
DataEnd:


... should be changed to the following for use on a CE...

Code:

   Call    _PopRealO1     ;Retrieve OP1 for writeback
   Call    _ChkFindSym

    ;Find data location as offset from start of program.
    LD    HL, DataStart - userMem + 6 ; userMem is the equate provided in TI84PCE.inc   
                                      ;Have to add 6 because of tAsmCmp token
                                      ;(3 bytes) and for size bytes (3 bytes)
    ADD    HL, DE        ;HL now points to data location in original program.
    EX    DE, HL         ;Write back.
    LD    HL, DataStart
    LD    BC, DataEnd - DataStart
    LDIR
    RET
DataStart:
counter:    .DL    10000 ; this needs to be 24 bit
DataEnd:


However, running this modified code appears to have no effect. The program is not updated, nor is it corrupted (because my ptr math had an error).

Still investigating, but thought I would ask here.
While indirect loads do load three bytes now, I was under the impression that AppVars, programs, and strings still used a 2-byte size word, based on information that I gleaned from discussions on #cemetech. In addition, your comment that the tAsmCmp token is 3 bytes now is definitely wrong (it's still a 2-byte extended token), so the correct offset is either 4 or 5 bytes.
Thanks for the quick response Kerm. The correct offset is 4, so I was mistaken about the 24 bit length of an AppVar!

Thanks,
Brian
Here, I wrote this little thing here a while back for traversing the VAT on the CE. Documentation. Wink Hope this helps somewhat, and good luck! Smile

http://wikiti.brandonw.net/index.php?title=84PCE:OS:VAT

In addition, data storage doesn't have to be 24 bits. Using suffixs on instructions allows you to get around this, or modify the structure of your code.
Thanks for the info; looks like I will have to use the .S suffixes after all.

Just wanted to mention that I posted this question because I was unable to successfully use this writeback method in my own program. It turns out that I was doing something else which prevented the writeback from working (it would appear to work, but then the original program would be restored after my app quit).

I was calling _DelRes as part of my 'cleanup' process. But Not for any good reason; I must have grabbed it because I saw someone else using it.

I can't find any documentation on _DelRes; what does it do?
Nevermind that last question. I see _DelRes is used to invalidate the statistics variables. So that was a coincidence and not related to my problem doing a writeback. Investigating further...
brianodell wrote:
Nevermind that last question. I see _DelRes is used to invalidate the statistics variables. So that was a coincidence and not related to my problem doing a writeback. Investigating further...
Yep, you only need to use it if you used the StatsVar area as scratch RAM. What exactly seems to be going wrong that you're trying to work around? How did you verify that the modification was successful during the lifetime of your program?
Well, thanks for asking. I have successfully used writeback via the following...

Code:
.ASSUME ADL=1

.nolist
#include "..\inc\ti84pce.inc"
.list
   .org    userMem-2
   .db    tExtTok,tAsm84CeCmp

main:   
   call   _PushRealO1    ;Save OP1 before we blow it away somehow
   LD     HL, (counter)
   LD     DE, 100
   ADD    HL, DE
   LD     (counter), HL
   ld      a,0
   ld      (curCol),a
   call   _DispHL
   call   _PopRealO1    ;Retrieve OP1 for writeback
   call   _ChkFindSym

    ;Find data location as offset from start of program.
    LD    HL, DataStart - userMem + 4
    ADD    HL, DE        ;HL now points to data location in original program.
    EX    DE, HL         ;Write back.
    LD    HL, DataStart
    LD    BC, DataEnd - DataStart
    LDIR
    RET
DataStart:
counter:    .DL    10000
DataEnd:

   .end


But when I apply this to a program I'm working on, it doesn't work.

I've added code to view the values stored at the memory locations identified by "Datastart-userMem+4" or its equivalent and I can confirm in this way that the values I wrote are actually 'there', but when I quit and rerun my program, the changes are not present.

My program is an indirect threaded FORTH compiler. The code for writeback is in a primitive FORTH word SAVE...


Code:


; SAVE
lsave:
   .dl      lopen2
fsave:
   .db      0
nsave:
   .db      4,"SAVE"
xsave:
   .dl      dsave
dsave:
   call   _popRealO1 ; pushed OP1 (with prog name) when program started
   call   _PushRealO1
   call   _ChkFindSym ; find it in the vat (sets DE as ptr to original program mem)
   push   de ; push start of original prog mem to stack for later use
   ld      hl,dhere - userMem + 4 
   add      hl,de ; now HL points to dhere in the original program
   ; push   de
   ; push   hl
   ; call   _Disphl ; display the prog mem address
   ; call   _NewLine
   ; pop      hl
   ; pop      de
   ld      de,(dhere) ; DE is the long value from dhere in the ram prog
   ld      (hl), de ; write DE to dhere in original prog mem
   ; push   de
   ; push   hl
   ; ex      de,hl
   ; push   de
   ; push   hl
   ; call   _Disphl ; display the value we just put in original prog mem
   ; call   _NewLine
   ; pop      hl
   ; pop      de
   ; ex      de,hl
   ; ld      de,(hl)
   ; push   de
   ; push   hl
   ; call   _Disphl ; display the original prog mem address
   ; call   _NewLine
   ; pop      hl
   ; pop      de
   ; ex      de,hl
   ; call   _Disphl ; display the value from original prog mem
   ; call   _NewLine
   ; call   _GetKey
   ; pop      hl
   ; pop      de

   pop      de ; get start of original prog mem
   push   de ; push it for later use
   ld      hl,dlast - userMem + 4 
   add      hl,de ; now HL points to dlast in the orig prog
   ld      de,(dlast) ; DE is long value from dlast in ram prog
   ld      (hl), de ; store DE in dlast in the orig prog
   pop      de ; one last time
   ld      hl,dictionary - userMem + 4 
   add      hl,de ; HL points to dictionary in orig prog
   ex      de,hl ; DE points to dictionary in orig prog
   ld      hl,dictionary ; HL points to dictionary in ram prog
   ld      bc,dictionaryend-dictionary ; BC is count of bytes to write
   ldir ; do it
   jp      next

The commented code will display 4 values:
1. the address of the dhere location in orig program
2. the long value from the dhere mem location in the ram program
3. the address of the dhere location in orig prog (again)
4. the long value pulled form the dhere mem location in the orig program

If I uncomment this code, I can see that the values were actually written as expected. At some point, after commenting out a call to _DelRes, the writeback function actually did work and when I ran the program again, my changes were present; but _DelRes had nothing to do with it.

I assume that the TI OS actually has a copy of my program (which I refer to in my comments as 'original program mem'), in addition to the copy in RAM which is actually executing and that I can learn the address of the 'original' version via _ChkFindSym. Just trying to explain my references to original program memory and ram program memory. I'm happy to correct my terminology if necessary.

At this point, I'm not sure what I'm doing wrong, so if you have a moment to step through this code, I would appreciate any suggestions even if they are not an obvious fix.

Thanks!

- EDIT - replaced references to 'archive program memory' with 'original program memory'; the program is not archived; 'original program memory' refers to the original program, a copy of which is running in ram.
One phrase caught my eye: Archive. If your program is Archived, your writeback routine must unarchive it, modify it, and then rearchive it. If you had a shell like Doors CE available, then that would all be handled by the shell, but until we get that key, I'm afraid there's no shell to help. Sad Simply check if the program is archived before writeback, save that info, unarchive it if so, modify it, then rearchive it if it was archived before.
Thanks Kerm, but my program isn't archived. I've used the term 'archive' to reference the original copy of the program in order to distinguish it from the copy of the program which is executing in RAM. I've edited my post to change this reference to 'original program mem'.

Could you enlighten me on how the TI OS executes a program? I assume it copies it from it's 'original' location to RAM and then executes it. How do people refer to that 'original' copy of the app?
Yes, you are correct in your terminology. Would you mind posting your entire code in a code box to make it easier to debug? The "original" copy is just stored in UserMem somewhere, and then is just copied in order to keep relative address the same. If you would like, it seems like you are just looking up the program and modifying certain sections; I would recommend taking a look at the PacMan CE code, under the Routines directory and in the Appvar.ez80 file. Appvars are structured exactly like programs, with just a few minor differences. Thanks! Smile Intelligent write back can be done by checking the comparison between the copied version and the original as well, if nessasary.
Thanks Mateo. That's quite an offer (to debug my code). I'll post it here, in case you really do have a chance to look at it.

And thanks for pointing me to PacManCE code that works with APPVARs. I will look into that code. I may use an APPVAR instead of a writeback.

Here's the main file (it contains three include directives that assume TI84PCE.inc and the other two files on this post are in a subdirectory called "include"):

Code:
; TI 84 Plus CE Forth by Brian O'Dell
; Based on Itsy-Forth by John Metcalf http://www.retroprogramming.com/2012/03/itsy-forth-1k-tiny-compiler.html
.ASSUME ADL=1

.nolist
#include "include\ti84pce.inc"
.list
   .org    userMem-2
   .db    tExtTok,tAsm84CeCmp

main:   
   call   cleanup
   call   _RunIndicOff
   call   _PushRealO1 ; save the program name for later use
   ld      hl,0
   ld      (curRow),hl
   ld      hl, titletxt+1
   call   _Puts
   pop      bc ; save 2 long words at the top of the stack to restore later
   pop      de
   ld      (ostackdata), de
   ld      (ostackdata+3),bc
   ld      (ostackdata+6), ix ; also save IX register to restore later
   push   de
   push   bc
    push   ix
   ld      (origstack), sp ; save the current stack pointer to restore later
   ld      hl,interpreter - 3
   ld      (dip), hl ; set instruction stream to point at outer interpreter

; next - ( - ) jump to next instruction in instruction stream
next:
   ld      hl,(origstack)
   scf
   ccf
   sbc      hl,sp
   jp      M,nexterr
   ld      hl, (dip)
   inc      hl
   inc      hl
   inc      hl
   ld      (dip),hl
   ld      ix,(hl)
   ld      (dcxt), ix
   ld      ix, (ix)
   jp      (ix)
nexterr:
   call   _NewLine
   ld      hl, (dip)
   call   _Disphl
   ld      a,32
   call   _Putc
   ld      sp,(origstack)
   pop      hl
   pop      hl
   pop      hl
   ld      hl,(ostackdata)
   push   hl
   ld      hl,(ostackdata+3)
   push   hl
   ld      hl,(ostackdata+6)
   push   hl
   ld      hl,0
   ld      (dstate), hl
   ld      hl, stkunder
   call   _Puts
   ld      hl,interpreter
   ld      (dip), hl
   ld      ix,(hl)
   ld      (dcxt), ix
   ld      ix, (ix)   
   jp      (ix)



; outer interpreter (written in FORTH, of course)
interpreter:
   .dl      xprompt
   .dl      xtib
   .dl      xlit
   .dl      80
   .dl      xaccept
   .dl      xdrop
   .dl      xcr
intnextword:
   .dl      xlit
   .dl      32
   .dl      xword
   .dl      xcount
   .dl      xfind
   .dl      xstate
   .dl      xfetch
   .dl      xif
   .dl      xbranch
   .dl      compilemode
   .dl      xthen
   .dl      xif
   .dl      xexec
   .dl      xelse
   .dl      xtonum
   .dl      xthen
intnext:
   .dl      xtoin
   .dl      xfetch
   .dl      xnotib
   .dl      xfetch
   .dl      xequal
   .dl      xif
   .dl      xbranch
   .dl      interpreter
   .dl      xthen
   .dl      xbranch
   .dl      intnextword
compilemode:
   .dl      xif
   .dl      xbranch
   .dl      compilext
   .dl      xelse
   .dl      xtonum
   .dl      xdup
   .dl      xliteral
   .dl      xthen
   .dl      xbranch
   .dl      intnext
compilext:
   .dl      xdup
   .dl      ximq
   .dl      xif
   .dl      xexec
   .dl      xelse
   .dl      xcoma
   .dl      xthen
   .dl      xbranch
   .dl      intnext
 


titletxt:
   .db      7, "84+CE Forth", 0
abouttxt:
   .db      47,"84+CE Forth               Coded by Brian O'Dell",0
stkunder:
   .db      "Stack Underflow",0
origstack:
   .dl      0
ostackdata:
   .dl      0,0,0
temp:
   .dl      0
temp2:
   .dl      0
prompttxt:
   .db      "-OK>",0


#include "include\std84pce.asm"

sysdictionary:
#include "include\primitives.asm"

dictionary:      
   .fill   1024,0
dictionaryend:
   .end


Here's an include for mapping the keyboard and some other hardware stuff: (note the commented out "call _DelRes" on line 6)

Code:
;Standard Routines

;cleanup - call at beginning and ending of program
cleanup:
;   call   _DelRes ; identify the statistics variables as invalid
   call   _Clrtxtshd
   call   _Clrscrn
   set      0,(iy+3)
   call   _HomeUp
   call   _DrawStatusBar
   ret

;getchar - get character from keyboard and reflect to console
;input: none
;output: ASCII in A (or 0FFh for EOL)      
getchar:
   call   _GetKey
   call   getascii
   cp      a,0
   jr      z,getchar
   cp      a,0dh
   jr      z,getchara
   cp      a,0ffh
   jr      z,getchara
   cp      a,0feh
   jr      z,getchara
   ld      (getcharb), a
   call   _Putc
   ld      a, (getcharb)
getchara:
   ret
getcharb:
   .db      0
      
;getascii - translate key press code (_GetKey) into ASCII
;input: keyscan in A
;output: ASCII in A (or 0 if no ASCII)
getascii:
   push   hl
   ld      h, 0
   ld      l, a
   ld      de, key2ascii
   add      hl, de
   ld      a, (hl)
   pop      hl
   ret
      
; key2ascii table contains ascii values for printable characters beginning at key press code 80h "+"
key2ascii:
   ;00h
   .db      0h, 0h, 0ffh, 0h, 0h, 0dh, 0h, 0h, 0h, 0feh, 0ffh, 0h, 040h, 0h, 0h, 0h
   ;010h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;020h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 03dh, 03eh, 0h, 019h
   ;030h
   .db      0h, 0h, 03ch, 017h, 0h, 0c2h, 027h, 0h, 0h, 018h, 0h, 0h, 0h, 0h, 0h, 0h
   ;040h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;050h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;060h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;070h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;080h
   .db      02bh, 02dh, 02Ah, 02fh, 05eh, 028h, 029h, 0c1h, 05dh, 0h, 021h, 02ch, 020h, 02eh, 030h, 031h
   ;090h
   .db      032h, 033h, 034h, 035h, 036h, 037h, 038h, 039h, 0h, 020h, 041h, 042h, 043h, 044h, 045h, 046h
   ;0a0h
   .db      047h, 048h, 049h, 04ah, 04bh, 04ch, 04dh, 04eh, 04fh, 050h, 051h, 052h, 053h, 054h, 055h, 056h
   ;0b0h
   .db      057h, 058h, 059h, 05ah, 0h, 0c4h, 011h, 021h, 023h, 040h, 025h, 026h, 02ah, 012h, 010h, 05fh
   ;0c0h
   .db      05eh, 07eh, 0h, 0h, 0h, 03bh, 03ah, 0h, 0h, 0h, 03fh, 022h, 05bh, 0h, 0h, 0h
   ;0d0h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h
   ;0e0h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 07bh, 07dh, 0h, 0h
   ;0f0h
   .db      0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 0h, 002h, 003h, 004h, 0h, 0h, 0h, 0h

      


And this file contains the 'system' dictionary of primitive FORTH words, some compound words and variables:

Code:
; TI 84 Plus CE Forth Primitives

; dovar - internal routine to place a variable on the stack
; the variable's execution token is expected to be in dcxt
dovar:
   ld      hl, (dcxt)
   inc      hl
   inc      hl
   inc      hl
   push   hl
   jp      next

; docolon - internal routine to store current instruction stream pointer,
; prepare new instruction stream and launch inner interpreter
docolon:
   call   puship
   ld      hl, (dcxt)
   ld      (dip), hl
   jp      next

; return stack push and pop
puship:
   ld      de,(dip)
   ld      hl, (drsp)
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   ld      (drsp), hl
   ret
popip:
   ld      hl, (drsp)
   dec      hl
   dec      hl
   dec      hl
   ld      de, (hl)
   ld      (drsp), hl
   ld      (dip), de
   ret

; control stack push and pop
pushde:
   ld      hl, (dcsp)
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   ld      (dcsp), hl
   ret
popde:
   ld      hl, (dcsp)
   dec      hl
   dec      hl
   dec      hl
   ld      de, (hl)
   ld      (dcsp), hl
   ret

; dictionary entry description
; link field - l*: - pointer to the previous dictionary entry's link field
; flag field - f*: - flag byte; defines immediate words
; name field - n*: - length-prefixed string containing name of word
; execution token - x*: - pointer to code to run when word is executed
; data field - d*: - code (primitive word), execution tokens (compound word)
;              memory space (variable)

; @ (fetch) - ( addr -- n ) put value at addr on top of stack
lfetch:
   .dl      0
ffetch:
   .db      0
nfetch:
   .db      1,"@"
xfetch:
   .dl      dfetch
dfetch:
   pop      hl
   ld      bc, (hl)
   push   bc
   jp      next

; C@ (char fetch) - ( addr -- char ) put character (byte) at addr on top of stack
lcfetch:
   .dl      lfetch
fcfetch:
   .db      0
ncfetch:
   .db      2,"C@"
xcfetch:
   .dl      dcfetch
dcfetch:
   pop      hl
   ld      bc,0
   ld      c, (hl)
   push   bc
   jp      next

; ! (store) - ( n addr -- ) Store n at addr
lstor:
   .dl      lcfetch
fstor:
   .db      0
nstor:
   .db      1,"!"
xstor:
   .dl      dstor
dstor:
   pop      hl
   pop      bc
   ld      (hl), bc
   jp      next

; C! (char store) - ( char addr -- ) store character (byte) at addr
lcstor:
   .dl      lstor
fcstor:
   .db      0
ncstor:
   .db      2,"C!"
xcstor:
   .dl      dcstor
dcstor:
   pop      hl
   pop      bc
   ld      (hl), c
   jp      next

; IP - Instruction Pointer; contains a ptr to the currently executing instruction in the instruction stream
lip:
   .dl      lcstor
fip:
   .db      0
nip:
   .db      2,"IP"
xip:
   .dl      dovar
dip:
   .dl      0

; CXT - Current Execution Token; contains a pointer to the current word's execution token
lcxt:
   .dl      lip
fcxt:
   .db      0
ncxt:
   .db      3,"CXT"
xcxt:
   .dl      dovar
dcxt:
   .dl      0

; STATE - compilation mode (1) or interpreter mode (0)
lstate:
   .dl      lcxt
fstate:
   .db      0
nstate:
   .db      5,"STATE"
xstate:
   .dl      dovar
dstate:
   .dl      0

; RSP - return stack pointer
lrsp:
   .dl      lstate
frsp:
   .db      0
nrsp:
   .db      3,"RSP"
xrsp:
   .dl      dovar
drsp:
   .dl      drsb

; RSB - Return Stack Buffer
lrsb:
   .dl      lrsp
frsb:
   .db      0
nrsb:
   .db      2,"RSB"
xrsb:
   .dl      dovar
drsb:
   .dl      0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

; CSP - control stack pointer
lcsp:
   .dl      lrsb
fcsp:
   .db      0
ncsp:
   .db      3,"CSP"
xcsp:
   .dl      dovar
dcsp:
   .dl      dcsb

; CSB - Control Stack Buffer
lcsb:
   .dl      lcsp
fcsb:
   .db      0
ncsb:
   .db      2,"CSB"
xcsb:
   .dl      dovar
dcsb:
   .dl      0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

; #TIB - ( - addr ) push address of #TIB (dnotib) on the stack
lnotib:
   .dl      lcsb
fnotib:
   .db      0
nnotib:
   .db      4,"#TIB"
xnotib:
   .dl      dovar
dnotib:
   .dl      0

; TIB - ( - addr ) push address of TIB on the stack
ltib:
   .dl      lnotib
ftib:
   .db      0
ntib
   .db      3,"TIB"
xtib:
   .dl      dovar
dtib:
   .db      0,"012345678901234567890123456789012345678901234567890123456789012345678901234567890123"

; SOURCE
lsource:
   .dl      ltib
fsource:
   .db      0
nsource:
   .db      6,"SOURCE"
xsource:
   .dl      docolon
dsource:
   .dl      xtib, xnotib, xfetch, xexit
   ld      hl,dtib
   push   hl
   ld      hl,0
   ld      a,(dnotib)
   ld      l,a
   push   hl
   jp      next

; >IN - index of the next available byte in tib
ltoin:
   .dl      lsource
ftoin:
   .db      0
ntoin:
   .db      3,">IN"
xtoin:
   .dl      dovar
dtoin:
   .dl      0

; BASE - number base (not currently used)
lbase:
   .dl      ltoin
fbase:
   .db      0
nbase:
   .db      4,"BASE"
xbase:
   .dl      dovar
dbase:
   .dl      10

; PAD - 84 byte buffer for programmer use
lpad:
   .dl      lbase
fpad:
   .db      0
npad:
   .db      3,"PAD"
xpad:
   .dl      dovar
dpad:
   .db      "012345678901234567890123456789012345678901234567890123456789012345678901234567890123"


; SPAD - another PAD
lspad:
   .dl      lpad
fspad:
   .db      0
nspad:
   .db      3,"SPAD"
xspad:
   .dl      dovar
dspad:
   .db      "012345678901234567890123456789012345678901234567890123456789012345678901234567890123"

; C" - ( C" ccc " - addr2) - copies characters from input stream to a length prefixed
; string in SPAD and puts the address of SPAD on the stack
lcstr:
   .dl      lspad
fcstr:
   .db      0
ncstr:
   .db      2,"C",022h
xcstr:
   .dl      docolon
dcstr:
   .dl      xlit, 022h, xword, xspad, xover, x1p, xcmove, xspad, xexit

; QUIT - launch outer interpreter
lquit:
   .dl      lcstr
fquit:
   .db      0
nquit:
   .db      4,"QUIT"
xquit:
   .dl      dquit
dquit:
   ld      hl,interpreter
   ld      (dip), hl
   ld      ix,(hl)
   ld      (dcxt), ix
   ld      ix, (ix)   
   jp      (ix)

; = - ( n1  n2 - n3 ) if n1!=n2 then n3 will be zero; otherwise n3=1
lequal
   .dl      lquit
fequal:
   .db      0
nequal:
   .db      1,"="
xequal:
   .dl      dequal
dequal:
   pop      de
   pop      hl
   scf
   ccf
   sbc      hl,de
   jr      z, equala
   ld      hl, 0
   push   hl
   jp      next
equala:
   ld      hl, 1
   push   hl
   jp      next

; <
llst:
   .dl      lequal
flst:
   .db      0
nlst:
   .db      1,"<"
xlst:
   .dl      dlst
dlst:
   pop      hl
   pop      de
   scf
   ccf
   sbc      hl,de
   jp      m,lsta
   ld      bc,1
   push   bc
   jp      next
lsta:
   ld      bc,0
   push   bc
   jp      next

; >
lgrt:
   .dl      llst
fgrt:
   .db      0
ngrt:
   .db      1,">"
xgrt:
   .dl      dgrt
dgrt:
   pop      de
   pop      hl
   scf
   ccf
   sbc      hl,de
   jp      m,grta
   ld      bc,1
   push   bc
   jp      next
grta:
   ld      bc,0
   push   bc
   jp      next

; 0< - ( n - flag ) flag is true if n < 0
lzlt:
   .dl      lgrt
fzlt:
   .db      0
nzlt:
   .db      2,"0<"
xzlt:
   .dl      dzlt
dzlt:
   ld      bc,0
   push   bc
   jp      next

; 0= - ( n - flag ) flag is true if n = 0
lzeq:
   .dl      lzlt
fzeq:
   .db      0
nzeq:
   .db      2,"0="
xzeq:
   .dl      dzeq
dzeq:
   pop      bc
   ld      a,0
   cp      b
   jr      nz,zeqa
   cp      c
   jr      nz,zeqa
   ld      bc,1
   push   bc
   jp      next
zeqa:
   ld      bc,0
   push   bc
   jp      next

; 0> - ( n - flag ) flag is true if n > 0
lzgt:
   .dl      lzeq
fzgt:
   .db      0
nzgt:
   .db      2,"0>"
xzgt:
   .dl      dzgt
dzgt:
   pop      bc
   ld      a,0
   cp      b
   jr      nz,zgta
   cp      c
   jr      nz,zgta
   ld      bc,0
   push   bc
   jp      next
zgta:
   ld      bc,1
   push   bc
   jp      next

; + - ( n1 n2 - n3) - n3=n1+n2
lplus:
   .dl      lzgt
fplus:
   .db      0
nplus:
   .db      1,"+"
xplus
   .dl      dplus
dplus:
   pop      de
   pop      hl
   add      hl,de
   push   hl
   jp      next

; minus - ( n1 n2 - n3 ) n3 n1 - n2
lminus:
   .dl      lplus
fminus:
   .db      0
nminus:
   .db      1,"-"
xminus:
   .dl      dminus
dminus:
   pop      de
   pop      hl
   sbc      hl,de
   push   hl
   jp      next

; X ( n1 n2 - n3 ) where n3 = n1 * n2
lmult:
   .dl      lminus
fmult:
   .db      0
nmult:
   .db      1,"*"
xmult:
   .dl      dmult
dmult:
   pop      bc
   pop      hl
   ld      a,0
   cp      b
   jr      nz, multa
   cp      c
   jr      z, multb
   ld      a,1
   cp      c
   jr      z, multd
   ld      a,0
   dec      bc
   push   hl
   pop      de
multa:
   add      hl,de
   dec      bc
   cp      b
   jr      nz, multa
   cp      c
   jr      nz, multa
multd:
   push   hl
   jp      next
multb:
   push   bc
   jp      next

; / - ( n1 n2 - n3 ) where n3 = n1/n2 and n2 is an 8 bit value

ldiv:
   .dl      lmult
fdiv:
   .db      0
ndiv:
   .db      1,"/"
xdiv:
   .dl      ddiv
ddiv:
   pop      bc
   ld      a,c
   pop      hl
   push   ix
   call   _Divhlbya
   pop      ix
   push   hl
   jp      next

; /MOD - ( n1 n2 - n3 ) where n3 = n1/n2 and n2 is an 8 bit value

ldivmod:
   .dl      ldiv
fdivmod:
   .db      0
ndivmod:
   .db      4,"/MOD"
xdivmod:
   .dl      ddivmod
ddivmod:
   pop      bc
   ld      a,c
   pop      hl
   push   ix
   call   _Divhlbya
   pop      ix
   ld      bc,0
   ld      c,a
   push   bc
   push   hl
   jp      next

; 1+
l1p:
   .dl      ldivmod
f1p:
   .db      0
n1p:
   .db      2,"1+"
x1p:
   .dl      d1p
d1p:
   pop      bc
   inc      bc
   push   bc
   jp      next

; 1-
l1m:
   .dl      l1p
f1m:
   .db      0
n1m:
   .db      2,"1-"
x1m:
   .dl      d1m
d1m:
   pop      bc
   dec      bc
   push   bc
   jp      next

; 2+
l2p:
   .dl      l1m
f2p:
   .db      0
n2p:
   .db      2,"2+"
x2p:
   .dl      d2p
d2p:
   pop      bc
   inc      bc
   inc      bc
   push   bc
   jp      next

; 2-
l2m:
   .dl      l2p
f2m:
   .db      0
n2m:
   .db      2,"2-"
x2m:
   .dl      d2m
d2m:
   pop      bc
   dec      bc
   dec      bc
   push   bc
   jp      next

; rot - ( n1 n2 n3 - n2 n3 n1)
lrot:
   .dl      l2m
frot:
   .db      0
nrot:
   .db      3,"ROT"
xrot:
   .dl      drot
drot:
   pop      bc
   pop      de
   pop      hl
   push   de
   push   bc
   push   hl
   jp      next

; drop   - ( n - )
ldrop:
   .dl      lrot
fdrop:
   .db      0
ndrop:
   .db      4,"DROP"
xdrop:
   .dl      ddrop
ddrop:
   pop      hl
   jp      next

; 2drop   - ( n1 n2 - )
l2drop:
   .dl      ldrop
f2drop:
   .db      0
n2drop:
   .db      5,"2DROP"
x2drop:
   .dl      d2drop
d2drop:
   pop      hl
   pop      hl
   jp      next

; dup - ( n - n n )
ldup:
   .dl      l2drop
fdup:
   .db      0
ndup:
   .db      3,"DUP"
xdup:
   .dl      ddup
ddup:
   pop      hl
   push   hl
   push   hl
   jp      next

; 2dup - ( n1 n2 - n1 n2 n1 n2 )
l2dup:
   .dl      ldup
f2dup:
   .db      0
n2dup:
   .db      4,"2DUP"
x2dup:
   .dl      d2dup
d2dup:
   pop      bc
   pop      hl
   push   hl
   push   bc
   push   hl
   push   bc
   jp      next

; swap - ( n1 n2 - n2 n1 )
lswap:
   .dl      l2dup
fswap:
   .db      0
nswap:
   .db      4,"SWAP"
xswap:
   .dl      dswap
dswap:
   pop      de
   pop      hl
   push   de
   push   hl
   jp      next

; over
lover:
   .dl      lswap
fover:
   .db      0
nover:
   .db      4,"OVER"
xover:
   .dl      dover
dover:
   pop      hl
   pop      de
   push   de
   push   hl
   push   de
   jp      next

; and
land:
   .dl      lover
fand:
   .db      0
nand:
   .db      3,"AND"
xand:
   .dl      dand
dand:
   pop      hl
   pop      de
   ld      bc,0
   ld      a,h
   and      a,d
   ld      b,a
   ld      a,l
   and      a,e
   ld      c,a
   push   bc
   jp      next

; OR
lor:
   .dl      land
for:
   .db      0
nor:
   .db      2,"OR"
xor:
   .dl      dor
dor:
   pop      hl
   pop      de
   ld      bc,0
   ld      a,h
   or      a,d
   ld      b,a
   ld      a,l
   or      a,e
   ld      c,a
   push   bc
   jp      next

; OR
lxor:
   .dl      lor
fxor:
   .db      0
nxor:
   .db      3,"XOR"
xxor:
   .dl      dxor
dxor:
   pop      hl
   pop      de
   ld      bc,0
   ld      a,h
   xor      a,d
   ld      b,a
   ld      a,l
   xor      a,e
   ld      c,a
   push   bc
   jp      next

; if - ( n - ) if item on top of stack is 0, moves instruction pointer to instruction after THEN
lif:
   .dl      lxor
fif:
   .db      0
nif:
   .db      2,"IF"
xif:
   .dl      dif
dif:
   pop      bc

;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      hl,0
;   ld      l,c
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   ld      a,0
   cp      b
   jr      nz,ifdone
   cp      c
   jr      nz,ifdone
   ld      c,0
   ld      a,0
ifcrawl:
   ld      hl, (dip) ; get the current instruction pointer
   inc      hl
   inc      hl
   inc      hl   ; increment it to point at the next instruction
   ld      (dip),hl ; save the instruction pointer
   ld      de,(hl)   ; load the instruction
   ld      hl, xif
   scf
   ccf
   sbc      hl,de
   jr      nz,ifnotif ; encountered a nested IF?
   inc      c ; yes, we did
   jr      ifcrawl
ifnotif:
   ld      hl, xelse

;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ex      de,hl
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   scf
   ccf
   sbc      hl,de
   jr      z,ifelse ; if the instruction is xelse, we may be done
   ld      hl, xthen
   scf
   ccf
   sbc      hl,de
   jr      nz,ifcrawl ; if the instruction is not xthen, do it again
   cp      c
   jr      z,ifdone ; is it our THEN?
   dec      c
   jr      ifcrawl
ifelse:
   cp      c
   jr      nz,ifcrawl ; is it our ELSE?
ifdone:
   jp      next

; else
lelse:
   .dl      lif
felse:
   .db      0
nelse:
   .db      4,"ELSE"
xelse:
   .dl      delse
delse:
   ld      a,0
   ld      c,0
elsecrawl:
   ld      hl, (dip)
   inc      hl
   inc      hl
   inc      hl
   ld      (dip),hl
   ld      de,(hl)
   ld      hl, xif
   scf
   ccf
   sbc      hl,de
   jr      nz,elsenext
   inc      c
   jr      elsecrawl
elsenext:
   ld      hl, xthen
   scf
   ccf
   sbc      hl,de
   jr      nz,elsecrawl
   cp      c
   jr      z,elsedone
   dec      c
elsedone:
   jp      next

; then - ( - ) does nothing; placeholder in instruction stream for IF
lthen:
   .dl      lelse
fthen:
   .db      0
nthen:
   .db      4,"THEN"
xthen:
   .dl      dthen
dthen:
   jp      next

; DO
ldo:
   .dl      lthen
fdo:
   .db      0
ndo:
   .db      2,"DO"
xdo:
   .dl      ddo
ddo:
   ld      de,(dip)
   call   pushde ; store a ptr to this DO
   pop      hl ; get the counter start value
   pop      de ; get the counter final value
   push   hl ; pushde destroys HL so push it
   call   pushde ; push counter final value onto control stack
   pop      hl ; pop it
   ex      de,hl
   call   pushde ; push counter start value onto control stack
   jp      next

; LOOP
lloop:
   .dl      ldo
floop:
   .db      0
nloop:
   .db      4,"LOOP"
xloop:
   .dl      dloop
dloop:
   call   popde ; get counter
   inc      de ; increment counter
   ex      de,hl ; store counter in hl
   push   hl ; push counter to data stack
   call   popde ; get counter max value
   pop      hl ; get counter in hl
   ld      a,l ; load low byte of counter in a
   cp      e ; compare low byte of counter max
   jr      nc,loopdone ; if a>=e then we're done
   push   hl ; push counter
   push   de ; push counter max
   call   popde ; get ptr to corresponding DO
   ld      (dip),de ; go back to the DO
   call   pushde ; put the DO back in the control stack
   pop      de ; pop counter max off data stack
   call   pushde ; and put it back on control stack
   pop      hl ; pop counter off data stack
   ex      de,hl
   call   pushde ; and put it back on control stack
   jp       next
loopdone:
   call   popde ; pop the DO ptr off the control stack
   jp      next

; +LOOP
lploop:
   .dl      lloop
fploop:
   .db      0
nploop:
   .db      5,"+LOOP"
xploop:
   .dl      dploop
dploop:
   call   popde ; get counter
   pop      bc ; get value to increment counter with
   ld      a,e
   add      a,c
   ld      e,a ; ok, so I'm only supporting 8 bits
   ex      de,hl ; store counter in hl
   push   hl ; push counter to data stack
   call   popde ; get counter max value
   pop      hl ; get counter in hl
   ld      a,l ; load low byte of counter in a
   cp      e ; compare low byte of counter max
   jr      nc,ploopdone ; if a>=e then we're done
   push   hl ; push counter
   push   de ; push counter max
   call   popde ; get ptr to corresponding DO
   ld      (dip),de ; go back to the DO
   call   pushde ; put the DO back in the control stack
   pop      de ; pop counter max off data stack
   call   pushde ; and put it back on control stack
   pop      hl ; pop counter off data stack
   ex      de,hl
   call   pushde ; and put it back on control stack
   jp       next
ploopdone:
   call   popde ; pop the DO ptr off the control stack
   jp      next

; LEAVE
lleave:
   .dl      lploop
fleave:
   .db      0
nleave:
   .db      5,"LEAVE"
xleave:
   .dl      dleave
dleave:
   call   popde
   call   popde
   call   popde
leavecrawl:
   ld      hl, (dip)
   inc      hl
   inc      hl
   inc      hl
   ld      (dip),hl
   ld      de,(hl)
   ld      hl, xloop
   scf
   ccf
   sbc      hl,de
   jr      z,leavedone
   ld      hl, xploop
   scf
   ccf
   sbc      hl,de
   jr      nz,leavecrawl
leavedone:
   jp      next

; lit - ( - n ) pushes next 'instruction' in the instruction stream on the stack as a literal number
llit:
   .dl      lleave
flit:
   .db      0
nlit:
   .db      5,0c1h,"LIT]"
xlit:
   .dl      dlit
dlit:
   ld      hl, (dip)
   inc      hl
   inc      hl
   inc      hl
   ld      (dip),hl
   ld      bc,(hl)
   push   bc
   jp      next

; accept - ( addr n1 - n2 ) input n characters into tib
laccept:
   .dl      llit
faccept:
   .db      0
naccept:
   .db      6,"ACCEPT"
xaccept:
   .dl      daccept
daccept:
   pop      bc
   pop      hl
   push   hl
   push   bc   ; just in case the user clears and we start over
   ld      b,c
;   ld      hl,dtib
   inc      hl
acceptwhile:
   push   bc
   push   de
   push   hl
   push   ix
   push   iy
   call   getchar
   pop      iy
   pop      ix
   pop      hl
   pop      de
   pop      bc
   cp      a,0dh
   jr      z,acceptdone
   cp      a,0ffh
   jr      z,acceptdel
   cp      a, 0feh
   jr      z,acceptclr
   ld      (hl),a
   inc      hl
   djnz   acceptwhile
acceptdone:
   pop      bc
   pop      de
;   ld      de,dtib
   scf
   ccf
   sbc      hl,de
   ld      a,l
   scf
   ccf
   sbc      a,1
   ld      (dtib),a
   ld      hl,0
   ld      l,a
   ld      (dnotib),hl
   push   hl
; changed dnotib to 24 bit
;   ld      (dnotib), a
   ld      hl,0
   ld      (dtoin),hl
; changed dtoin to 24bit
;   ld      a,0
;   ld      (dtoin), a
;   pop      bc
   jp       next
acceptdel:
   ld      a,(curCol)
   dec      a
   ld      (curCol),a
   dec      hl
   ld      a,32
   push   bc
   push   de
   push   hl
   push   ix
   push   iy
   call   _Putc
   pop      iy
   pop      ix
   pop      hl
   pop      de
   pop      bc
   ld      a,(curCol)
   dec      a
   ld      (curCol),a
   jr      acceptwhile
acceptclr
   call   _NewLine
   ld      a,0
   ld      (curCol), a
   ld      hl, prompttxt
   call   _Puts
   jp      daccept

; space
lspc:
   .dl      laccept
fspc:
   .db      0
nspc:
   .db      5,"SPACE"
xspc:
   .dl      dspc
dspc:
   ld      a,32
   call   _Putc
   jp      next

; BL
lbl:
   .dl      lspc
fbl:
   .db      0
nbl:
   .db      2,"BL"
xbl:
   .dl      dbl
dbl:
   ld      hl,32
   push   hl
   jp      next

; word ( char - addr) - get next word in tib
lword:
   .dl      lbl
fword:
   .db      0
nword:
   .db      4,"WORD"
xword:
   .dl      dword
dword:
   ld      hl,(dtoin)
   ld      c,l
   ld      hl, (dnotib)
   ld      a, l
   cp      c
   jr      z,wordf ; if >IN = #TIB then there are no more words in TIB
   sub      a,c
   jp      m,wordf ; if >IN > #TIB then there are really no more words in TIB
   pop      hl ; get the delimiter
   ld      a,l ; put it in a
   push   af ; A has delimiter so push it to use A for a compare
   ld      bc,0
   ld      hl,(dtoin)
   ld      c,l
   ld      hl, dtib
   add      hl,bc ; HL is now a ptr to the last char read previously
              ; or beginning of TIB, which is a count
   pop      af ; get the delimiter
   ld      c,0 ; c will be the char count
wordc: ; ignore all delimiters before the next word (if there is one)
   push   hl ; store the current HL...
   pop      de ; in DE, it will be the ptr this function returns
   inc      hl ; now HL points at the next unread char
   ld      b,(hl) ; get next char in TIB
   cp      b 
   jr      nz,wordd ; if b is not the delimiter then we found a word
   push   hl   ; b is the delimiter, so remember this address
   ld      hl,dtoin ; increment the variable >IN while stepping over...
   inc      (hl) ; preceding delimiters
   pop      hl
   jr      wordc
worda:
   inc      hl ; increment the pointer
   ld      b,(hl) ; get the next char
   cp      b ; check for a delimiter
   jr      z,wordb ; if B is a delimiter we've found all chars for the next word
wordd: ; we just found the first char of the next word
   inc      c ; increment the char counter
   push   af
   push   hl
   ld      hl, (dnotib)
   ld      a, l
   ld      hl, (dtoin)
   sub      a,l
   cp      c
   jr      z,worde ; are we at the end of TIB?
   pop      hl ; no
   pop      af
   jr      worda
worde: ; done counting chars for next word and at the end of TIB
   pop      hl ; remember to pop HL and AF
   pop      af
   ld      a,c
   ld      (de),a ; store the count in (DE), the byte prior to our current word
   push   de ; return a ptr to a length prefixed string
   ld      hl, (dnotib)
   ld      (dtoin), hl
   jp      next
wordb: ; done counting chars for the next word because B is now a delimiter
   ld      a,c
   ld      (de),a ; store the count in (DE), the byte prior to our current word
   push   de ; return a ptr to a length prefixed string
   ld      hl, (dtoin) ; update >IN to point to the next char
   ld      a,l
   add      a,c
   inc      a ; we didn't increment C after B became a delimiter
   ld      hl,0
   ld      l,a
   ld      (dtoin), hl ; now >IN points to the delimiter we just discovered
   jp      next
wordf:
   ld      a,0
   ld      de, dtib
   ld      (de),a
   push   de
   ld      hl, (dnotib)
   ld      (dtoin), hl
   jp      next

; find   ( addr1 n1 - [addr2] n2) OR ( addr1 n1 - addr1 n1 0 )
;- if string at addr1 (with count n1) is found
; in the primitives dictionary, addr2 is an execution token and n2=1, otherwise
; n2=0 and addr2 is not provided
lfind:
   .dl      lword
ffind:
   .db      0
nfind:
   .db      4,"FIND"
xfind:
   .dl      dfind
dfind:
   pop      bc
   pop      de
   ld      hl,(dlast)
; first check the length of the next word in the dictionary
finda:
   push   de
   push   bc
   push   hl

   ; push   af
   ; push   bc
   ; push   de
   ; push   hl
   ; push   ix
   ; push   iy

   ; call   _Disphl

   ; pop      iy
   ; pop      ix
   ; pop      hl
   ; pop      de
   ; pop      bc
   ; pop      af

   inc      hl
   inc      hl
   inc      hl ; skip link field
   inc      hl ; skip flag field

   ; push   af
   ; push   bc
   ; push   de
   ; push   hl
   ; push   ix
   ; push   iy

   ; inc      hl
   ; ld      a,(hl)
   ; call   _Putc
   ; call   _NewLine
   ; call   _GetKey

   ; pop      iy
   ; pop      ix
   ; pop      hl
   ; pop      de
   ; pop      bc
   ; pop      af

   ld      a,(hl); get count of dictionary word
   cp      c   ; compare to count of provided string
   jp      nz,findc ; not equal, get previous word in dict
   inc      hl
; compare letters in given word to current word
findb:
   ld      a,(de)

   ; push   af
   ; push   bc
   ; push   de
   ; push   hl
   ; push   ix
   ; push   iy

   ; call   _Putc
   ; ld      a,(hl)
   ; call   _Putc
   ; call   _NewLine
   ; call   _GetKey

   ; pop      iy
   ; pop      ix
   ; pop      hl
   ; pop      de
   ; pop      bc
   ; pop      af
   
   cpi
   jp      nz,findc
   ld      a,0
   cp      c
   jp      z,findd
   inc      de
   jp      findb
; move to the previous word in dictionary
findc:
   pop      hl
   ld      de,(hl)
   ld      a,0
   cp      d
   jr      nz,findca
   cp      e
   jr      z,finde
findca:
   ex      de,hl
   pop      bc
   pop      de
   jp      finda
; found a match
findd:
   pop      hl
   ld      bc,0
   inc      hl
   inc      hl
   inc      hl ; skip link field
   inc      hl ; skip flag field
   ld      c,(hl)
   add      hl,bc
   inc      hl
   pop      bc
   pop      de
   ld      c,1
   push   hl
   push   bc

   ; push   af
   ; push   bc
   ; push   de
   ; push   hl
   ; push   ix
   ; push   iy

   ; call   _Disphl
   ; call   _GetKey

   ; pop      iy
   ; pop      ix
   ; pop      hl
   ; pop      de
   ; pop      bc
   ; pop      af

   jp      next
; did not find a match
finde:
   ld      bc,0
   push   bc
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      a,023h
;   call   _Putc
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   jp      next

; emit - ( char - ) send char to monitor
lemit:
   .dl      lfind
femit:
   .db      0
nemit
   .db      4,"EMIT"
xemit:
   .dl      demit
demit:
   pop      bc
   ld      a,c
   call   _Putc
   jp      next

; count - ( addr1 - int addr2 ) accept counted string as input and return ptr to string and count
lcount:
   .dl      lemit
fcount:
   .db      0
ncount:
   .db      5,"COUNT"
xcount:
   .dl      dcount
dcount:
   pop      hl
   ld      bc,0
   ld      c, (hl)
   inc      hl
   push   hl
   push   bc
   jp      next

; type - ( n addr - ) accept ptr to string and count and emit characters to monitor
ltype
   .dl      lcount
ftype:
   .db      0
ntype:
   .db      4,"TYPE"
xtype:
   .dl      dtype
dtype:
   pop      bc
   pop      hl
   ld      b,c
   ld      a,0
   cp      b
   jr      z,typeb
typea:
   ld      a,(hl)
   inc      hl
   push   hl
   call   _Putc
   pop      hl
   djnz   typea
typeb:
   jp      next

; . - ( n - ) sent n to monitor as a number
ldot:
   .dl      ltype
fdot:
   .db      0
ndot:
   .db      1,"."
xdot:
   .dl      ddot
ddot:
   pop      hl
   call   _Disphl
   jp      next

; U.
ludot:
   .dl      ldot
fudot:
   .db      0
nudot:
   .db      2,"U."
xudot:
   .dl      dudot
dudot:
   jp      ddot

; prompt - ( - ) display prompt message      
lprompt:
   .dl      ludot
fprompt:
   .db      0
nprompt:
   .db      6,"PROMPT"
xprompt:
   .dl      dprompt      
dprompt:
   call   _NewLine
   ld      a,0
   ld      (curCol), a
   ld      hl, prompttxt+1
   call   _Puts
   jp      next

; newline - ( - ) call TI's _NewLine
lcr:
   .dl      lprompt
fcr:
   .db      0
ncr:
   .db      2,"CR"
xcr:   
   .dl      dcr
dcr:
   call   _NewLine
   ld      a,0
   ld      (curCol),a
   jp      next

; BYE - ( - ) quit FORTH
lbye:
   .dl      lcr
fbye:
   .db      0
nbye:
   .db      3,"BYE"
xbye:
   .dl      dbye
dbye:
   call   cleanup
   ld      sp,(origstack)
   pop      hl
   pop      hl
   pop      hl
   ld      hl,(ostackdata)
   push   hl
   ld      hl,(ostackdata+3)
   push   hl
   ld      hl,(ostackdata+6)
   push   hl
   pop      ix
   ret

; execute - ( addr - ) executes execution token at addr
lexec:
   .dl      lbye
fexec:
   .db      0
nexec:
   .db      7,"EXECUTE"
xexec:
   .dl      dexec
dexec:
   pop      hl
   ld      (dcxt), hl

;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   call   _Disphl
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   ld      ix, (hl)
   jp      (ix)

; EXIT - quits executing compiled word and returns control to the calling routine
lexit:
   .dl      lexec
fexit:
   .db      0
nexit:
   .db      4,"EXIT"
xexit:
   .dl      dexit
dexit:
   call   popip
   jp      next

; CMOVE - ( addr1 addr2 n - ) moves n bytes from addr1 to addr2
lcmove:
   .dl      lexit
fcmove:
   .db      0
ncmove:
   .db      5,"CMOVE"
xcmove:
   .dl      dcmove
dcmove:
   pop      bc
   pop      de
   pop      hl
cmovea:
   ld      a,(hl)
   ex      de,hl
   ld      (hl), a
   dec      c
   inc      hl
   ex      de,hl
   inc      hl
   ld      a,0
   cp      c
   jr      nz,cmovea
   jp      next

; CRCODE
lcrcode:
   .dl      lcmove
fcrcode:
   .db      0
ncrcode:
   .db      6,"CRCODE"
xcrcode:
   .dl      dcrcode
dcrcode:
   ld      hl,(dhere) ; get address of first available space
   ld      de, (dlast) ; get ptr to LAST
   ld      (hl), de ; populate link field of next word
   ld      (dlast), hl ; new word under construction is our new LAST
   inc      hl
   inc      hl
   inc      hl
   inc      hl ; now hl points to name portion of next word
   ld      (dhere), hl
   push   hl
   ld      hl, dstate
   ld      bc,1
   ld      (hl), bc ; set STATE to Compile
   jp      next

; CREATE - add next word to a new dictionary entry
lcreate:
   .dl      lcrcode
fcreate:
   .db      0
ncreate:
   .db      6,"CREATE"
xcreate:
   .dl      docolon
dcreate:
   .dl      xcrcode
   .dl      xlit
   .dl      32
   .dl      xword ; get name of new word from TIB
   .dl      xswap ; swap name and ptr to next mem space of new word
   .dl      xover ; copy name addr
   .dl      xcount ; count name of new word
   .dl      x1p ; increment that by one to include the length byte, itself
   .dl      xswap
   .dl      xdrop ; drop the ptr to the string returned by COUNT
   .dl      xdup ; duplicate length of bytes to copy
   .dl      xhere
   .dl      xfetch
   .dl      xplus ; add length of bytes to copy to contents of HERE
   .dl      xhere
   .dl      xstor ; update here to point to xt of new word
   .dl      xcmove ; move bytes of length prefixed string to name field of new word
   .dl      xpcompile ; put the address of the docolon routine at HERE and inc HERE
   .dl      docolon
   .dl      xexit

; [COMPILE] - copies next word in instruction stream to HERE and increments HERE
; then skips next word in instruction stream
lpcompile:
   .dl      lcreate
fpcompile:
   .db      0
npcompile:
   .db      9,0c1h,"COMPILE]"
xpcompile:
   .dl      dpcompile
dpcompile:
   ld      hl,(dip)
   inc      hl
   inc      hl
   inc      hl
   ld      (dip), hl
   ld      de,(hl)
   ld      hl,(dhere)
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   ld      (dhere), hl
   jp      next

; , - ( xt - ) compiles execution token
lcoma:
   .dl      lpcompile
fcoma:
   .db      0
ncoma:
   .db      1,","
xcoma:
   .dl      dcoma
dcoma:
   pop      de
   ld      hl,(dhere)
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   ld      (dhere), hl
   jp      next

; LITERAL - ( n - ) compiles a number which will be placed
; on the stack when the current word is executed
lliteral:
   .dl      lcoma
fliteral:
   .db      0
nliteral:
   .db      3,"LITERAL"
xliteral:
   .dl      dliteral
dliteral:
   ld      hl,(dhere)
   ld      de,xlit
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   pop      de
   ld      (hl), de
   inc      hl
   inc      hl
   inc      hl
   ld      (dhere), hl
   jp      next
   
; : begin compiling a new word to dictionary
lcoln:
   .dl      lliteral
fcoln:
   .db      0
ncoln:
   .db      1,":"
xcoln:
   .dl      docolon
dcoln:
   .dl      xcreate
   .dl      xexit

; ; - leave compile mode and complete latest word in dictionary
lsemicol:
   .dl      lcoln
fsemicol:
   .db      1
nsemicol:
   .db      1,";"
xsemicol:
   .dl      docolon
dsemicol:
   .dl      xpcompile ; add EXIT to end of new word
   .dl      xexit
   .dl      xlit
   .dl      0
   .dl      xstate ; set STATE to interpret
   .dl      xstor
   .dl      xexit

; VARIABLE
lvar:
   .dl      lsemicol
fvar:
   .db      0
nvar:
   .db      8,"VARIABLE"
xvar:
   .dl      docolon
dvar
   .dl      xcrcode
   .dl      xlit
   .dl      32
   .dl      xword ; get name of new word from TIB
   .dl      xswap ; swap name and ptr to next mem space of new word
   .dl      xover ; copy name addr
   .dl      xcount ; count name of new word
   .dl      x1p ; increment that by one to include the length byte, itself
   .dl      xswap
   .dl      xdrop ; drop the ptr to the string returned by COUNT
   .dl      xdup ; duplicate length of bytes to copy
   .dl      xhere
   .dl      xfetch
   .dl      xplus ; add length of bytes to copy to contents of HERE
   .dl      xhere
   .dl      xstor ; update here to point to xt of new word
   .dl      xcmove ; move bytes of length prefixed string to name field of new word
   .dl      xpcompile ; put the address of the dovar routine at HERE and inc HERE
   .dl      dovar
   .dl      xhere
   .dl      xfetch ; put the data field address on the stack
   .dl      xpcompile ; use [COMPILE] to put a long 0 in the data field
   .dl      0
   .dl      xlit
   .dl      0
   .dl      xstate
   .dl      xstor ; crcode set compile mode, so disable it
   .dl      xexit

; TRAV- - ( xt - addr ) addr is a ptr to the length pre-fixed string
; containing the name of the word whose execution token is xt
ltrav:
   .dl      lvar
ftrav:
   .db      0
ntrav:
   .db      5,"TRAV-"
xtrav:
   .dl      dtrav
dtrav:
   pop      hl
   ld      a,0
   dec      a
trava:
   inc      a
   dec      hl
   ld      c,(hl)
   cp      c
   jr      nz,trava
   push   hl
   jp      next

; IM? - ( xt - flag ) returns Immediate flag field for a given execution token
limq:
   .dl      ltrav
fimq:
   .db      0
nimq:
   .db      3,"IM?"
ximq:
   .dl      dimq
dimq:
   pop      hl
   ld      a,0
   dec      a
imqa:
   inc      a
   dec      hl
   ld      c,(hl)
   cp      c
   jr      nz,imqa
   dec      hl
   ld      bc,0
   ld      c,(hl)
   push   bc
   jp      next
   

; >NUMBER - ( addr n - n2 )
ltonum:
   .dl      limq
ftonum:
   .db      0
ntonum:
   .db      7,">NUMBER"
xtonum:
   .dl      dtonum
dtonum:
   pop      bc
   pop      hl
   ld      e,0
tonuma:
   ld      a,(hl)
   inc      hl
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   call   _Putc
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   dec      c
   sub      a,030h
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      hl,0
;   ld      l,a
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   cp      0ah
   jr      nc, tonumb
   push   hl
   ld      d,a
   ld      a,e
   call   x10
   ld      e,a
   ld      a,d
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      hl,0
;   ld      l,a
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   add      a,e
   ld      e,a
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      hl,0
;   ld      l,e
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   pop      hl
   ld      d,a
   ld      a,0
   cp      c
   jr      z,tonumb
   ld      a,d
   jp      tonuma
tonumb:
   ld      bc,0
   ld      c,e
   push   bc
   
;   push   af
;   push   bc
;   push   de
;   push   hl
;   push   ix
;   push   iy
;
;   ld      hl,0
;   ld      l,e
;   ld      h,d
;   call   _Disphl
;   call   _NewLine
;   call   _GetKey
;
;   pop      iy
;   pop      ix
;   pop      hl
;   pop      de
;   pop      bc
;   pop      af

   jp      next
x10:
   ld      l,a
   sla      a
   sla      a
   sla      a
   ld      h,a
   ld      a,l
   sla      a
   add      a,h
   ret

; branch - ( addr - ) sets
lbranch:
   .dl      ltonum
fbranch:
   .db      0
nbranch:
   .db      4,"GOTO"
xbranch:
   .dl      dbranch
dbranch:
   ld      hl, (dip)
   inc      hl
   inc      hl
   inc      hl
   ld      de,(hl)
   ld      (dip),de
   ex      de,hl
   ld      ix,(hl)
   ld      (dcxt), ix
   ld      ix, (ix)
   jp      (ix)
   jp      next


; KEY
lkey:
   .dl      lbranch
fkey:
   .db      0
nkey:
   .db      3,"KEY"
xkey:
   .dl      dkey
dkey:
   call   _GetKey
   ld      hl,0
   ld      l,a
   push   hl
   jp      next

; WORDS - ( - ) list words
lwords:
   .dl      lkey
fwords:
   .db      0
nwords:
   .db      5,"WORDS"
xwords:
   .dl      docolon
dwords:
   .dl      xlast
wordsa:
   .dl      xfetch, xdup, xzeq, xif, xdrop, xexit, xthen, xdup
   .dl      xlit, 4, xplus, xcount, xtype, xspc
   .dl      xbranch, wordsa

; FORGET
lforget:
   .dl      lwords
fforget:
   .db      0
nforget:
   .db      6,"FORGET"
xforget:
   .dl      docolon
dforget:
   .dl      xfind, xif, xtrav, x2m, x2m, xdup, xhere, xstor
   .dl      xfetch, xlast, xstor, xthen, xexit

; SEE
lsee:
   .dl      lforget
fsee:
   .db      0
nsee:
   .db      3,"SEE"
xsee:
   .dl      docolon
dsee:
   .dl      xfind, xif
dseeagain:
   .dl      x2p, xdup, xfetch, xlit, xexit, xequal
   .dl      xif, xdrop, xexit, xthen
   .dl      xtrav, xcount, xtype, xspc, xbranch, dseeagain

; .S - ( n1 n2 n3 - n1 n2 n3 ) view top three items on stack in the order n1, n2, n3
ldots:
   .dl      lsee
fdots:
   .db      0
ndots:
   .db      2,".S"
xdots:
   .dl      ddots
ddots:
   pop      hl
   pop      de
   pop      bc

   push   bc
   push   de
   push   hl

   push   hl
   push   de
   push   bc

   pop      hl
   call   _NewLine
   call   _Disphl
   pop      hl
   call   _NewLine
   call   _Disphl
   pop      hl
   call   _NewLine
   call   _Disphl
   jp      next

; A
lemita:
   .dl      ldots
femita:
   .db      0
nemita:
   .db      1,"A"
xemita:
   .dl      demita
demita:
   ld      a,65
   call   _Putc
   jp      next
; B
lemitb:
   .dl      lemita
femitb:
   .db      0
nemitb:
   .db      1,"B"
xemitb:
   .dl      demitb
demitb:
   ld      a,66
   call   _Putc
   jp      next
; C
lemitc:
   .dl      lemitb
femitc:
   .db      0
nemitc:
   .db      1,"C"
xemitc:
   .dl      demitc
demitc:
   ld      a,67
   call   _Putc
   jp      next
; D
lemitd:
   .dl      lemitc
femitd
   .db      0
nemitd:
   .db      1,"D"
xemitd:
   .dl      demitd
demitd:
   ld      a,68
   call   _Putc
   jp      next
; E
lemite:
   .dl      lemitd
femite:
   .db      0
nemite:
   .db      1,"E"
xemite:
   .dl      demite
demite:
   ld      a,69
   call   _Putc
   jp      next

; about
labout:
   .dl      lemite
fabout:
   .db      0
nabout:
   .db      5,"ABOUT"
xabout:
   .dl      dabout
dabout:
   jp      dforth

; disphere
ldisphere:
   .dl      labout
fdisphere:
   .db      0
ndisphere:
   .db      7,"SEELAST"
xdisphere:
   .dl      ddisphere
ddisphere:
   ld      hl,(dlast)
   ld      de,(hl)

   push   af
   push   de
   push   hl
   ex      de,hl
   call   _Disphl
   call   _NewLine
   pop      hl
   pop      de
   pop      af

   ld      hl,(dlast)
   inc      hl
   inc      hl
   inc      hl
   inc      hl
   ld      c,(hl)
dispherea:
   inc      hl
   ld      a,(hl)
   push   bc
   push   hl
   call   _Putc
   pop      hl
   pop      bc
   dec      c
   ld      a,0
   cp      c
   jr      nz,dispherea
   inc      hl
   ld      c,6
disphereb:
   
   ld      de,(hl)

   push   af
   push   bc
   push   de
   push   hl
   ex      de,hl
   call   _Disphl
   call   _NewLine
   pop      hl
   pop      de
   pop      bc
   pop      af

   inc      hl
   inc      hl
   inc      hl
   dec    c
   ld      a,0
   cp      c
   jr      nz, disphereb

   jp      next

; OPEN - ( n addr - addr2 n2 )opens APPVAR with name identified
; by zero terminated string at addr (creates appvar if doesn't exist
; with length n bytes); returns address of appvar space at addr2 and
; appvar size of n2 bytes
lopen:
   .dl      ldisphere
fopen:
   .db      0
nopen:
   .db      4,"OPEN"
xopen:
   .dl      dopen
dopen:
   pop      hl
   push   hl
   call   _Mov9ToOP1 ; put it in OP1
   call   _ChkFindSym ; look for it in the VAT
   jr       nc,VarFound
CreateVar:
   pop      hl
   push   hl
   call   _Mov9ToOP1
   pop      hl
   pop      bc
   push   bc
   push   hl
   push    bc
   pop      hl
   call   _CreateAppVar
   jr       VarInRam
VarFound:
   call   _ChkinRam
   jr      z,VarInRam
   pop      hl
   push   hl
   call   _Mov9ToOP1
   call   _Arc_Unarc
   jr      dopen ;find again in ram
VarInRam:
   ex      de,hl
   ld.s   de,(hl) ; get appvar size
   inc      hl
   inc      hl
   pop      bc ; drop appvar name str ptr
   pop      bc ; drop length
   push   hl ; appvar ptr
   push   de ; appvar length
   jp      next

; SAVE
lsave:
   .dl      lopen
fsave:
   .db      0
nsave:
   .db      4,"SAVE"
xsave:
   .dl      dsave
dsave:
   call   _popRealO1 ; pushed OP1 (with prog name) when program started
   call   _PushRealO1
   call   _ChkFindSym ; find it in the vat (sets DE as ptr to archive mem)
   push   de ; push start of archive prog mem to stack for later use
   ld      hl,dhere - userMem + 4 
   add      hl,de ; now HL points to dhere in the orig/archived program
   ld      de,(dhere) ; DE is the long value from dhere in the ram prog
   ld      (hl), de ; write DE to dhere in archive

   ld      de,(hl)
   ld      (temp), de

   pop      de ; get start of archive prog mem
   push   de ; push it for later use
   ld      hl,dlast - userMem + 4 
   add      hl,de ; now HL points to dlast in the orig/archived prog
   ld      de,(dlast) ; DE is long value from dlast in ram prog
   ld      (hl), de ; store DE in dlast in the archive prog

   pop      de ; one last time
   ld      hl,dictionary - userMem + 4 
   add      hl,de ; HL points to dictionary in archive prog
   ex      de,hl ; DE points to dictionary in archive prog
   ld      hl,dictionary ; HL points to dictionary in ram prog
   ld      bc,dictionaryend-dictionary ; BC is count of bytes to write
   ldir ; do it
   ld      de,(temp)
   push   de
   jp      next

; test - ( addr -- ) write 10 bytes with char A to addr
ltest:
   .dl      lsave
ftest:
   .db      0
ntest:
   .db      1,"T"
xtest:
   .dl      dtest
dtest:
   ld      a,65
   pop      hl
   ld      b,10
testagain:
   ld      (hl),a
   inc      hl
   djnz   testagain
   jp      next


; HERE - ptr to next available free memory location
lhere:
   .dl      ltest
fhere:
   .db      0
nhere:
   .db      4,"HERE"
xhere:
   .dl      dovar
dhere:
   .dl      dictionary

; LAST - ptr to last word in dictionary
llast:
   .dl      lhere
flast:
   .db      0
nlast:
   .db      4,"LAST"
xlast:
   .dl      dovar
dlast:
   .dl      lforth


; SP - print stack ptr
lpsp:
   .dl      llast
fpsp:
   .db    0
npsp:
   .db      2,"SP"
xpsp:
   .dl      dpsp
dpsp:
   ld      (temp), sp
   ld      hl,(temp)   
   call   _Disphl
   jp      next

; GK
lgk:
   .dl      lpsp
fgk:
   .db      0
ngk:
   .db      2,"GK"
xgk:
   .dl      dgk
dgk:
   call   _GetKey
   jp      next

; FORTH - displays forth version
lforth:
   .dl      lgk
fforth:
   .db      0
nforth:
   .db      5,"FORTH"
xforth:
   .dl      dforth
dforth:
   call   _NewLine
   ld      hl,abouttxt+1
   call   _Puts
   call   _NewLine
   jp      next

   


After building this. One could test it by doing the following...

Enter this after running the program on the calculator:
"10 10 10 + . ."
Spaces are important (the unary minus on the calc is an alternate Space key for convenience). This basically puts 10 on the stack 3 times, adds the top two values on the stack and prints the value on the stack twice, so it will output the values 20 and 10.

Now, let's make a simple new FORTH word for testing.
": J CR . ;"
The semicolon is the [2nd] Unary Minus (I have no use for Ans). This 'statement' means
1. Define a new word (:)
2. call it "J" (J)
3. this word prints a carriage return (CR)
4. then this word print the top value from the stack (.)
5. end new word (;)

test the new word J by entering the following:
"10 10 10 + J J"
This should behave like before but the two values will be on separate lines because carriage returns have been entered before each value.

Now do this...
"SAVE" - saves any user defined words back to the original program
then
"BYE" - quits FORTH and returns to the TI OS

If the writeback performed by SAVE was successful, you should be able to run the program again and use your new word J.
"10 J"
should print a new line and the value 10.

For me, this is currently working. But if I edit the second file and uncomment the "call _DelRes" (on line 6). The writeback will not be successful.

The SAVE primitive word's "data field" which contains the assembly can be found in the third file by searching for "dsave:". Also, BYE can be found by searching for "dbye:". BYE makes a call to "cleanup" found in the second file.

In order to use writeback, I've appended space at the end of the program to accomodate additional words in the dictionary. Ultimately, I would like to use an APPVAR to store FORTH code (before it is compiled to the dictionary), but that's a ways off.

Any help or suggestions would be..., well,... helpful. And appreciated.
So it seems the only problem is just the DelRes call? I believe it is because you call cleanup when your program starts. DelRes modifys OP1, which you then push as the writeback name after the call. I'm somewhat surprised nothing bad has happened. I haven't had time to test anything yet, because I'm sorta out of commission at the moment, but that might be a place to start. Just throwing ideas around. Smile Try pushing OP1before calling cleanup and see what happens.

Also, writing back a user defined dictionary would be quite neat. The AddMemoryToAppvar and its counterpart might be somewhat helpful. Good luck! Smile
Wow. Thanks Mateo! I didn't realize DelRes modified OP1; that would explain it. (But of course DelRes modifies OP1 - it uses the system provided routines to find and re-init the stat variables, I imagine.)

I'll test it this evening! Of course, I don't need to call DelRes when the program starts, or ever, since I'm not using the stat variables as scratch, but it will be good to confirm 'why'.
Just verified I should push OP1 before calling DelRes. Thanks again Mateo.
  
Register to Join the Conversation
Have your own thoughts to add to this or any other topic? Want to ask a question, offer a suggestion, share your own programs and projects, upload a file to the file archives, get help with calculator and computer programming, or simply chat with like-minded coders and tech and calculator enthusiasts via the site-wide AJAX SAX widget? Registration for a free Cemetech account only takes a minute.

» Go to Registration page
Page 1 of 1
» All times are UTC - 5 Hours
 
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 vote in polls in this forum

 

Advertisement