camel Forth build changes and fixes

;   19-Oct 19 v1.02 Convert to zsm assembler which
;                   identified and fixed incorrect
;                   case conversion when lowercase
;                   keywords are being passed in a
;                   macro. Remove Z80MR assembler

Source/Forth/Build.cmd

@@ -11,5 +11,7 @@ set ZXBINDIR=%TOOLS%/cpm/bin/
 set ZXLIBDIR=%TOOLS%/cpm/lib/
 set ZXINCDIR=%TOOLS%/cpm/include/
 
-zx z80mr camel80
-zx MLOAD25 -camel80.bin=camel80.hex
+zx zsm =camel80.azm
+zx link -CAMEL80.BIN=CAMEL80
+
+

Source/Forth/Clean.cmd

@@ -5,3 +5,5 @@ if exist *.bin del *.bin
 if exist *.lst del *.lst
 if exist *.prn del *.prn
 if exist *.hex del *.hex
+if exist *.rel del *.rel
+if exist *.sym del *.sym

Source/Forth/camel80.azm

@@ -60,6 +60,12 @@ FTH_LOC			EQU	0200h
 ;   05 Nov 18 v1.02 Initial ROMWBW HBIOS version.
 ;   10-Nov 18 v1.02 New org address.
 ;       b1ackmai1er difficultylevelhigh@gmail.com
+;   19-Oct 19 v1.02 Convert to zsm assembler which
+;                   identified and fixed incorrect
+;                   case conversion when lowercase
+;                   keywords are being passed in a
+;                   macro.
+;       b1ackmai1er difficultylevelhigh@gmail.com
 ; ===============================================
 ; Macros to define Forth headers
 ; HEAD  label,length,name,action
@@ -75,25 +81,25 @@ FTH_LOC			EQU	0200h
 DOCODE  EQU 0      ; flag to indicate CODE words
 link    DEFL 0     ; link to previous Forth word
 
-head    MACRO   #label,#length,#name,#action
+head    MACRO  label,length,name,action
         DW link
         DB 0
 link    DEFL $
-        DB #length,'#name'
-#label:
-        IF  .NOT.(#action=DOCODE)
-        call #action
+        DB length,"&name"
+label:
+        IFF (action EQ DOCODE)
+        call action
         ENDIF
         ENDM
 
-immed   MACRO   #label,#length,#name,#action
+immed   MACRO   label,length,name,action
         DW link
         DB 1
 link    DEFL $
-        DB #length,'#name'
-#label:
-        IF  .NOT.(#action=DOCODE)
-        call #action
+        DB length,"&name"
+label:
+        IFF (action EQ DOCODE)
+        call action
         ENDIF
         ENDM
 
@@ -123,8 +129,10 @@ nexthl  MACRO
 ; ...are not used in the CP/M implementation
 ; Instead, we have the...
 
-; CP/M ENTRY POINT
-        org FTH_LOC  ; Execute address 
+; RELOCATED ENTRY POINT
+
+	.PHASE	0200H
+
 reset:  ld hl,0FDFFh ; HBIOS address, rounded down
         ld l,0       ;    = end of avail.mem (EM)
         dec h        ; EM-100h
@@ -384,7 +392,7 @@ poptos: pop bc
         DW SWOP,OVER,EXIT
 
 ;C >R    x --   R: -- x   push to return stack
-    head TOR,2,>R,docode
+    head TOR,2,!>R,docode
         dec ix          ; push TOS onto rtn stk
         ld (ix+0),b
         dec ix
@@ -393,7 +401,7 @@ poptos: pop bc
         next
 
 ;C R>    -- x    R: x --   pop from return stack
-    head RFROM,2,R>,docode
+    head RFROM,2,R!>,docode
         push bc         ; push old TOS
         ld c,(ix+0)     ; pop top rtn stk item
         inc ix          ;       to TOS
@@ -418,7 +426,7 @@ poptos: pop bc
         next
 
 ;Z SP!  a-addr --       set data stack pointer
-    head SPSTORE,3,SP!,docode
+    head SPSTORE,3,SP!!,docode
         ld h,b
         ld l,c
         ld sp,hl
@@ -433,7 +441,7 @@ poptos: pop bc
         next
 
 ;Z RP!  a-addr --       set return stack pointer
-    head RPSTORE,3,RP!,docode
+    head RPSTORE,3,RP!!,docode
         push bc
         pop ix
         pop bc
@@ -442,7 +450,7 @@ poptos: pop bc
 ; MEMORY AND I/O OPERATIONS =====================
 
 ;C !        x a-addr --   store cell in memory
-    head STORE,1,!,docode
+    head STORE,1,!!,docode
         ld h,b          ; address in hl
         ld l,c
         pop bc          ; data in bc
@@ -453,7 +461,7 @@ poptos: pop bc
         next
 
 ;C C!      char c-addr --    store char in memory
-    head CSTORE,2,C!,docode
+    head CSTORE,2,C!!,docode
         ld h,b          ; address in hl
         ld l,c
         pop bc          ; data in bc
@@ -478,7 +486,7 @@ poptos: pop bc
         next
 
 ;Z PC!     char c-addr --    output char to port
-    head PCSTORE,3,PC!,docode
+    head PCSTORE,3,PC!!,docode
         pop hl          ; char in L
         out (c),l       ; to port (BC)
         pop bc          ; pop new TOS
@@ -588,7 +596,7 @@ mplus1: pop de          ; restore saved IP
         next
 
 ;Z ><      x1 -- x2         swap bytes (not ANSI)
-    head swapbytes,2,><,docode
+    head swapbytes,2,!>!<,docode
         ld a,b
         ld b,c
         ld c,a
@@ -632,7 +640,7 @@ rsh2:   djnz rsh1
         next
 
 ;C +!     n/u a-addr --       add cell to memory
-    head PLUSSTORE,2,+!,docode
+    head PLUSSTORE,2,+!!,docode
         pop hl
         ld a,(bc)       ; low byte
         add a,l
@@ -657,7 +665,7 @@ rsh2:   djnz rsh1
         next
 
 ;C 0<     n -- flag      true if TOS negative
-    head ZEROLESS,2,0<,docode
+    head ZEROLESS,2,0!<,docode
         sla b           ; sign bit -> cy flag
         sbc a,a         ; propagate cy through A
         ld b,a          ; put 0000 or FFFF in TOS
@@ -674,11 +682,11 @@ tosfalse: ld bc,0
         next
 
 ;X <>     x1 x2 -- flag    test not eq (not ANSI)
-    head NOTEQUAL,2,<>,docolon
+    head NOTEQUAL,2,!<!>,docolon
         DW EQUAL,ZEROEQUAL,EXIT
 
 ;C <      n1 n2 -- flag        test n1<n2, signed
-    head LESS,1,<,docode
+    head LESS,1,!<,docode
         pop hl
         or a
         sbc hl,bc       ; n1-n2 in HL, SZVC valid
@@ -695,11 +703,11 @@ revsense: jp m,tosfalse ; OV: if -ve, reslt false
         jr tostrue      ;     if +ve, result true
 
 ;C >     n1 n2 -- flag         test n1>n2, signed
-    head GREATER,1,>,docolon
+    head GREATER,1,!>,docolon
         DW SWOP,LESS,EXIT
 
 ;C U<    u1 u2 -- flag       test u1<n2, unsigned
-    head ULESS,2,U<,docode
+    head ULESS,2,U!<,docode
         pop hl
         or a
         sbc hl,bc       ; u1-u2 in HL, SZVC valid
@@ -709,7 +717,7 @@ revsense: jp m,tosfalse ; OV: if -ve, reslt false
         next
 
 ;X U>    u1 u2 -- flag     u1>u2 unsgd (not ANSI)
-    head UGREATER,2,U>,docolon
+    head UGREATER,2,U!>,docolon
         DW SWOP,ULESS,EXIT
 
 ; LOOP AND BRANCH OPERATIONS ====================
@@ -949,7 +957,7 @@ cmovedone: exx
 
 ;X CMOVE>  c-addr1 c-addr2 u --  move from top
 ; as defined in the ANSI optional String word set
-    head CMOVEUP,6,CMOVE>,docode
+    head CMOVEUP,6,CMOVE!>,docode
         push bc
         exx
         pop bc      ; count
@@ -1048,8 +1056,8 @@ sdiff:  ; mismatch!  undo last 'cpi' increment
         ld c,a
 snext:  next
 
-*INCLUDE camel80d.azm   ; CPU Dependencies
-*INCLUDE camel80h.azm   ; High Level words
+INCLUDE camel80d.azm   ; CPU Dependencies
+INCLUDE camel80h.azm   ; High Level words
 lastword EQU link   ; nfa of last word in dict.
 enddict EQU $       ; user's code starts here
 
@@ -1057,6 +1065,7 @@ enddict EQU $       ; user's code starts here
 
 		ds (FTH_SIZ-(enddict-reset)-1)
 		nop
+	.DEPHASE
 		
         END
 

Source/Forth/camel80d.azm

@@ -74,7 +74,7 @@ noop:   next
 
 ;C >BODY    xt -- a-addr      adrs of param field
 ;   3 + ;                     Z80 (3 byte CALL)
-    head TOBODY,5,>BODY,docolon
+    head TOBODY,5,!>BODY,docolon
         DW LIT,3,PLUS,EXIT
 
 ;X COMPILE,  xt --         append execution token
@@ -82,7 +82,7 @@ noop:   next
 ; it is defined in the ANSI standard as COMPILE,.
 ; On a DTC Forth this simply appends xt (like , )
 ; but on an STC Forth this must append 'CALL xt'.
-    head COMMAXT,8,'COMPILE,',docode
+    head COMMAXT,8,COMPILE!,,docode
         jp COMMA
 
 ;Z !CF    adrs cfa --   set code action of a word
@@ -90,13 +90,13 @@ noop:   next
 ;   1+ ! ;              Z80 VERSION
 ; Depending on the implementation this could
 ; append CALL adrs or JUMP adrs.
-    head STORECF,3,!CF,docolon
+    head STORECF,3,!!CF,docolon
         DW LIT,0CDH,OVER,CSTORE
         DW ONEPLUS,STORE,EXIT
 
 ;Z ,CF    adrs --       append a code field
 ;   HERE !CF 3 ALLOT ;  Z80 VERSION (3 bytes)
-    head COMMACF,3,',CF',docolon
+    head COMMACF,3,!,CF,docolon
         DW HERE,STORECF,LIT,3,ALLOT,EXIT
 
 ;Z !COLON   --      change code field to docolon
@@ -104,7 +104,7 @@ noop:   next
 ; This should be used immediately after CREATE.
 ; This is made a distinct word, because on an STC
 ; Forth, colon definitions have no code field.
-    head STORCOLON,6,'!COLON',docolon
+    head STORCOLON,6,!!COLON,docolon
         DW LIT,-3,ALLOT
         DW LIT,docolon,COMMACF,EXIT
 
@@ -112,7 +112,7 @@ noop:   next
 ;   ['] EXIT ,XT ;
 ; This is made a distinct word, because on an STC
 ; Forth, it appends a RET instruction, not an xt.
-    head CEXIT,5,',EXIT',docolon
+    head CEXIT,5,!,EXIT,docolon
         DW LIT,EXIT,COMMAXT,EXIT
 
 ; CONTROL STRUCTURES ============================
@@ -123,21 +123,21 @@ noop:   next
 ; xt is the branch operator to use, e.g. qbranch
 ; or (loop).  It does NOT append the destination
 ; address.  On the Z80 this is equivalent to ,XT.
-    head COMMABRANCH,7,',BRANCH',docode
+    head COMMABRANCH,7,!,BRANCH,docode
         jp COMMA
 
 ;Z ,DEST   dest --        append a branch address
 ; This appends the given destination address to
 ; the branch instruction.  On the Z80 this is ','
 ; ...other CPUs may use relative addressing.
-    head COMMADEST,5,',DEST',docode
+    head COMMADEST,5,!,DEST,docode
         jp COMMA
 
 ;Z !DEST   dest adrs --    change a branch dest'n
 ; Changes the destination address found at 'adrs'
 ; to the given 'dest'.  On the Z80 this is '!'
 ; ...other CPUs may need relative addressing.
-    head STOREDEST,5,'!DEST',docode
+    head STOREDEST,5,!!DEST,docode
         jp STORE
 
 ; HEADER STRUCTURE ==============================

Source/Forth/camel80h.azm

@@ -56,7 +56,7 @@
 
 ;C >IN     -- a-addr        holds offset into TIB
 ;  2 USER >IN
-    head TOIN,3,>IN,douser
+    head TOIN,3,!>IN,douser
         dw 2
 
 ;C BASE    -- a-addr       holds conversion radix
@@ -132,7 +132,7 @@ TICKSOURCE: call douser         ; in name!
 
 ;C S>D    n -- d          single -> double prec.
 ;   DUP 0< ;
-    head STOD,3,S>D,docolon
+    head STOD,3,S!>D,docolon
         dw DUP,ZEROLESS,EXIT
 
 ;Z ?NEGATE  n1 n2 -- n3  negate n1 if n2 negative
@@ -254,7 +254,7 @@ MIN1:   dw DROP,EXIT
 ;C 2!    x1 x2 a-addr --    store 2 cells
 ;   SWAP OVER ! CELL+ ! ;
 ;   the top of stack is stored at the lower adrs
-    head TWOSTORE,2,2!,docolon
+    head TWOSTORE,2,2!!,docolon
         dw SWOP,OVER,STORE,CELLPLUS,STORE,EXIT
 
 ;C 2DROP  x1 x2 --          drop 2 cells
@@ -348,25 +348,25 @@ TYP5:   DW EXIT
 
 ;Z (S")     -- c-addr u   run-time code for S"
 ;   R> COUNT 2DUP + ALIGNED >R  ;
-    head XSQUOTE,4,(S"),docolon
+    head XSQUOTE,4,(S""!),docolon
         DW RFROM,COUNT,TWODUP,PLUS,ALIGNED,TOR
         DW EXIT
 
 ;C S"       --         compile in-line string
 ;   COMPILE (S")  [ HEX ]
 ;   22 WORD C@ 1+ ALIGNED ALLOT ; IMMEDIATE
-    immed SQUOTE,2,S",docolon
+    immed SQUOTE,2,S"",docolon
         DW LIT,XSQUOTE,COMMAXT
         DW LIT,22H,WORD,CFETCH,ONEPLUS
         DW ALIGNED,ALLOT,EXIT
 
 ;C ."       --         compile string to print
 ;   POSTPONE S"  POSTPONE TYPE ; IMMEDIATE
-    immed DOTQUOTE,2,.",docolon
+    immed DOTQUOTE,2,."",docolon
         DW SQUOTE
         DW LIT,TYPE,COMMAXT
         DW EXIT
-                        
+                       
 ; NUMERIC OUTPUT ================================
 ; Numeric conversion is done l.s.digit first, so
 ; the output buffer is built backwards in memory.
@@ -394,12 +394,12 @@ TYP5:   DW EXIT
 
 ;C <#    --             begin numeric conversion
 ;   PAD HP ! ;          (initialize Hold Pointer)
-    head LESSNUM,2,<#,docolon
+    head LESSNUM,2,!<#,docolon
         DW PAD,HP,STORE,EXIT
 
 ;Z >digit   n -- c      convert to 0..9A..Z
 ;   [ HEX ] DUP 9 > 7 AND + 30 + ;
-    head TODIGIT,6,>DIGIT,docolon
+    head TODIGIT,6,!>DIGIT,docolon
         DW DUP,LIT,9,GREATER,LIT,7,AND,PLUS
         DW LIT,30H,PLUS,EXIT
 
@@ -417,7 +417,7 @@ NUMS1:  DW NUM,TWODUP,OR,ZEROEQUAL,qbranch,NUMS1
 
 ;C #>    ud1 -- c-addr u    end conv., get string
 ;   2DROP HP @ PAD OVER - ;
-    head NUMGREATER,2,#>,docolon
+    head NUMGREATER,2,#!>,docolon
         DW TWODROP,HP,FETCH,PAD,OVER,MINUS,EXIT
 
 ;C SIGN  n --           add minus sign if n<0
@@ -434,7 +434,7 @@ SIGN1:  DW EXIT
 
 ;C .     n --           display n signed
 ;   <# DUP ABS 0 #S ROT SIGN #> TYPE SPACE ;
-    head DOT,1,'.',docolon
+    head DOT,1,.,docolon
         DW LESSNUM,DUP,ABS,LIT,0,NUMS
         DW ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
 
@@ -465,12 +465,12 @@ SIGN1:  DW EXIT
 
 ;C ,    x --           append cell to dict
 ;   HERE ! 1 CELLS ALLOT ;
-    head COMMA,1,',',docolon
+    head COMMA,1,!,,docolon
         dw HERE,STORE,lit,1,CELLS,ALLOT,EXIT
 
 ;C C,   char --        append char to dict
 ;   HERE C! 1 CHARS ALLOT ;
-    head CCOMMA,2,'C,',docolon
+    head CCOMMA,2,C!,,docolon
         dw HERE,CSTORE,lit,1,CHARS,ALLOT,EXIT
 
 ; INTERPRETER ===================================
@@ -491,7 +491,7 @@ SIGN1:  DW EXIT
 
 ;Z >counted  src n dst --     copy to counted str
 ;   2DUP C! CHAR+ SWAP CMOVE ;
-    head TOCOUNTED,8,>COUNTED,docolon
+    head TOCOUNTED,8,!>COUNTED,docolon
         DW TWODUP,CSTORE,CHARPLUS,SWOP,CMOVE,EXIT
 
 ;C WORD   char -- c-addr n   word delim'd by char
@@ -516,12 +516,12 @@ WORD1:  DW RFROM,RFROM,ROT,MINUS,TOIN,PLUSSTORE
 
 ;Z NFA>LFA   nfa -- lfa    name adr -> link field
 ;   3 - ;
-    head NFATOLFA,7,NFA>LFA,docolon
+    head NFATOLFA,7,NFA!>LFA,docolon
         DW LIT,3,MINUS,EXIT
 
 ;Z NFA>CFA   nfa -- cfa    name adr -> code field
 ;   COUNT 7F AND + ;       mask off 'smudge' bit
-    head NFATOCFA,7,NFA>CFA,docolon
+    head NFATOCFA,7,NFA!>CFA,docolon
         DW COUNT,LIT,07FH,AND,PLUS,EXIT
 
 ;Z IMMED?    nfa -- f      fetch immediate flag
@@ -599,7 +599,7 @@ QSIGN1: DW EXIT
 ;       R> M+ 2SWAP
 ;       1 /STRING
 ;   REPEAT ;
-    head TONUMBER,7,>NUMBER,docolon
+    head TONUMBER,7,!>NUMBER,docolon
 TONUM1: DW DUP,qbranch,TONUM3
         DW OVER,CFETCH,DIGITQ
         DW ZEROEQUAL,qbranch,TONUM2,DROP,EXIT
@@ -701,7 +701,7 @@ QABO1:  DW TWODROP,EXIT
 ;C ABORT"  i*x 0  -- i*x   R: j*x -- j*x  x1=0
 ;C         i*x x1 --       R: j*x --      x1<>0
 ;   POSTPONE S" POSTPONE ?ABORT ; IMMEDIATE
-    immed ABORTQUOTE,6,ABORT",docolon
+    immed ABORTQUOTE,6,ABORT"",docolon
         DW SQUOTE
         DW LIT,QABORT,COMMAXT
         DW EXIT
@@ -753,14 +753,14 @@ TICK:   call docolon
 ;   R>              adrs of headless DOES> def'n
 ;   LATEST @ NFA>CFA    code field to fix up
 ;   !CF ;
-    head XDOES,7,(DOES>),docolon
+    head XDOES,7,(DOES!>),docolon
         DW RFROM,LATEST,FETCH,NFATOCFA,STORECF
         DW EXIT
 
 ;C DOES>    --      change action of latest def'n
 ;   COMPILE (DOES>)
 ;   dodoes ,CF ; IMMEDIATE
-    immed DOES,5,DOES>,docolon
+    immed DOES,5,DOES!>,docolon
         DW LIT,XDOES,COMMAXT
         DW LIT,dodoes,COMMACF,EXIT
 
@@ -807,7 +807,7 @@ TICK:   call docolon
 ;C ;
 ;   REVEAL  ,EXIT
 ;   POSTPONE [  ; IMMEDIATE
-    immed SEMICOLON,1,';',docolon
+    immed SEMICOLON,1,!;,docolon
         DW REVEAL,CEXIT
         DW LEFTBRACKET,EXIT
 
@@ -911,12 +911,12 @@ POST2:  DW EXIT
 
 ;Z >L   x --   L: -- x        move to leave stack
 ;   CELL LP +!  LP @ ! ;      (L stack grows up)
-    head TOL,2,>L,docolon
+    head TOL,2,!>L,docolon
         DW CELL,LP,PLUSSTORE,LP,FETCH,STORE,EXIT
 
 ;Z L>   -- x   L: x --      move from leave stack
 ;   LP @ @  CELL NEGATE LP +! ;
-    head LFROM,2,L>,docolon
+    head LFROM,2,L!>,docolon
         DW LP,FETCH,FETCH
         DW CELL,NEGATE,LP,PLUSSTORE,EXIT
 
@@ -1020,7 +1020,7 @@ DOTS2:  DW EXIT
         DW UINIT,U0,NINIT,CMOVE
 ;        DW LIT,80h,COUNT,INTERPRET
         DW XSQUOTE
-        DB 55,'Z80 CamelForth v1.02  25 Jan 1995, ROMWBW 10 Nov 2018'
+        DB 55,'Z80 CamelForth v1.02  25 Jan 1995, ROMWBW 19 Oct 2019'
         DB 0dh,0ah
         DW TYPE,ABORT       ; ABORT never returns
 ; DON'T FORGET TO UPDATE THE BYTE COUNT IF YOU CHANCGE THE SIZE OF THE BOOT MSG