diff --git a/Source/Forth/Build.cmd b/Source/Forth/Build.cmd index d7ce3630..08fb735b 100644 --- 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 + + diff --git a/Source/Forth/Clean.cmd b/Source/Forth/Clean.cmd index e2e6145a..ad58c78d 100644 --- 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 diff --git a/Source/Forth/camel80.azm b/Source/Forth/camel80.azm index b97396a4..a2ce8acf 100644 --- 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 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 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 diff --git a/Source/Forth/camel80d.azm b/Source/Forth/camel80d.azm index 0dd13e3e..b2d15fda 100644 --- 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 ============================== diff --git a/Source/Forth/camel80h.azm b/Source/Forth/camel80h.azm index 10646031..d7a7c481 100644 --- 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 diff --git a/Tools/cpm/bin/Z80MR.COM b/Tools/cpm/bin/Z80MR.COM deleted file mode 100644 index 0bdda14d..00000000 Binary files a/Tools/cpm/bin/Z80MR.COM and /dev/null differ diff --git a/Tools/cpm/bin/ZSM.COM b/Tools/cpm/bin/ZSM.COM new file mode 100644 index 00000000..3704c8d9 Binary files /dev/null and b/Tools/cpm/bin/ZSM.COM differ