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
6 years ago · 1ee2167c2a
7 changed files with 78 additions and 65 deletions
--- a/Source/Forth/Build.cmd
+++ b/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
+
+
--- a/Source/Forth/Clean.cmd
+++ b/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
--- a/Source/Forth/camel80.azm
+++ b/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

--- a/Source/Forth/camel80d.azm
+++ b/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 ==============================
--- a/Source/Forth/camel80h.azm
+++ b/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
--- a/Tools/cpm/bin/Z80MR.COM
+++ b/Tools/cpm/bin/Z80MR.COM
--- a/Tools/cpm/bin/ZSM.COM
+++ b/Tools/cpm/bin/ZSM.COM