MirrorRepos/RomWBW
1
0
Fork 1
mirror of https://github.com/wwarthen/RomWBW.git synced 2026-02-06 22:43:15 -06:00
Code Issues Projects Releases Wiki Activity

camel Forth build changes and fixes

Browse Source 
;   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
This commit is contained in:
b1ackmai1er
2019-10-19 09:09:59 +08:00
parent 8c8c09097d
commit 1ee2167c2a
7 changed files with 78 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
Source/Forth/Build.cmd
View File

@@ -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

2
Source/Forth/Clean.cmd
View File

@@ -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

69
Source/Forth/camel80.azm
View File

@@ -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

18
Source/Forth/camel80d.azm
View File

@@ -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 ==============================

48
Source/Forth/camel80h.azm
View File

@@ -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