diff --git a/Source/HBIOS/Build.cmd b/Source/HBIOS/Build.cmd
index 52660c54..d315afa8 100644
--- a/Source/HBIOS/Build.cmd
+++ b/Source/HBIOS/Build.cmd
@@ -1,4 +1,9 @@
@echo off
+
+set TOOLS=../../Tools
+
+setlocal & cd .\Forth && call Build || exit /b 1 & endlocal
+
setlocal
PowerShell .\Build.ps1 %*
diff --git a/Source/HBIOS/Build.ps1 b/Source/HBIOS/Build.ps1
index 716caf7d..23f3fe2a 100644
--- a/Source/HBIOS/Build.ps1
+++ b/Source/HBIOS/Build.ps1
@@ -190,9 +190,8 @@ Concat 'prefix.bin','cpm.bin' 'cpm.sys'
Concat 'prefix.bin','zsys.bin' 'zsys.sys'
# Build 32K OS chunk containing the loader, debug monitor, and OS images
-Concat 'romldr.bin', 'dbgmon.bin','cpm.bin','zsys.bin', 'eastaegg.bin', 'imgpad.bin' osimg.bin
-Concat 'nascom.bin', 'tastybasic.bin', 'imgpad0.bin' osimg1.bin
-
+Concat 'romldr.bin', 'dbgmon.bin', 'cpm.bin', 'zsys.bin', 'eastaegg.bin', 'imgpad.bin' osimg.bin
+Concat 'camel80.bin', 'nascom.bin', 'tastybasic.bin', 'imgpad0.bin' osimg1.bin
#
# Now the ROM disk image is created. This is done by starting with a
# blank ROM disk image of the correct size, then cpmtools is used to
diff --git a/Source/HBIOS/Forth/Build.cmd b/Source/HBIOS/Forth/Build.cmd
new file mode 100644
index 00000000..1833c745
--- /dev/null
+++ b/Source/HBIOS/Forth/Build.cmd
@@ -0,0 +1,19 @@
+@echo off
+setlocal
+
+set TOOLS=../../../Tools
+
+set PATH=%TOOLS%\tasm32;%TOOLS%\zx;%PATH%
+
+set TASMTABS=%TOOLS%\tasm32
+
+set ZXBINDIR=%TOOLS%/cpm/bin/
+set ZXLIBDIR=%TOOLS%/cpm/lib/
+set ZXINCDIR=%TOOLS%/cpm/include/
+
+zx z80mr camel80
+zx MLOAD25 -camel80.bin=camel80.hex
+
+copy camel80.bin ..\
+
+goto :eof
diff --git a/Source/HBIOS/Forth/Clean.cmd b/Source/HBIOS/Forth/Clean.cmd
new file mode 100644
index 00000000..e2e6145a
--- /dev/null
+++ b/Source/HBIOS/Forth/Clean.cmd
@@ -0,0 +1,7 @@
+@echo off
+setlocal
+
+if exist *.bin del *.bin
+if exist *.lst del *.lst
+if exist *.prn del *.prn
+if exist *.hex del *.hex
diff --git a/Source/HBIOS/Forth/camel80.azm b/Source/HBIOS/Forth/camel80.azm
new file mode 100644
index 00000000..e9c97241
--- /dev/null
+++ b/Source/HBIOS/Forth/camel80.azm
@@ -0,0 +1,1056 @@
+CIODEV_CONSOLE EQU 0D0h
+CIOIN EQU 00h ; CHARACTER INPPUT
+CIOOUT EQU 01h ; CHARACTER OUTPUT
+CIOIST EQU 02h ; CHARACTER INPUT STATUS
+BID_BOOT EQU 00h
+HB_BNKCALL EQU 0fff9h
+FTH_SIZ EQU 1700h
+
+; Listing 2.
+; ===============================================
+; CamelForth for the Zilog Z80
+; Copyright (c) 1994,1995 Bradford J. Rodriguez
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation; either version 3 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with this program. If not, see .
+
+; Commercial inquiries should be directed to the author at
+; 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
+; or via email to bj@camelforth.com
+;
+; ===============================================
+; CAMEL80.AZM: Code Primitives
+; Source code is for the Z80MR macro assembler.
+; Forth words are documented as follows:
+;x NAME stack -- stack description
+; where x=C for ANS Forth Core words, X for ANS
+; Extensions, Z for internal or private words.
+;
+; Direct-Threaded Forth model for Zilog Z80
+; 16 bit cell, 8 bit char, 8 bit (byte) adrs unit
+; Z80 BC = Forth TOS (top Param Stack item)
+; HL = W working register
+; DE = IP Interpreter Pointer
+; SP = PSP Param Stack Pointer
+; IX = RSP Return Stack Pointer
+; IY = UP User area Pointer
+; A, alternate register set = temporaries
+;
+; Revision history:
+; 19 Aug 94 v1.0
+; 25 Jan 95 v1.01 now using BDOS function 0Ah
+; for interpreter input; TIB at 82h.
+; 02 Mar 95 v1.02 changed ALIGN to ALIGNED in
+; S" (S"); changed ,BRANCH to ,XT in DO.
+; 05 Nov 18 v1.02 Initial ROMWBW HBIOS version.
+; b1ackmai1er difficultylevelhigh@gmail.com
+; ===============================================
+; Macros to define Forth headers
+; HEAD label,length,name,action
+; IMMED label,length,name,action
+; label = assembler name for this word
+; (special characters not allowed)
+; length = length of name field
+; name = Forth's name for this word
+; action = code routine for this word, e.g.
+; DOCOLON, or DOCODE for code words
+; IMMED defines a header for an IMMEDIATE word.
+;
+DOCODE EQU 0 ; flag to indicate CODE words
+link DEFL 0 ; link to previous Forth word
+
+head MACRO #label,#length,#name,#action
+ DW link
+ DB 0
+link DEFL $
+ DB #length,'#name'
+#label:
+ IF .NOT.(#action=DOCODE)
+ call #action
+ ENDIF
+ ENDM
+
+immed MACRO #label,#length,#name,#action
+ DW link
+ DB 1
+link DEFL $
+ DB #length,'#name'
+#label:
+ IF .NOT.(#action=DOCODE)
+ call #action
+ ENDIF
+ ENDM
+
+; The NEXT macro (7 bytes) assembles the 'next'
+; code in-line in every Z80 CamelForth CODE word.
+next MACRO
+ ex de,hl
+ ld e,(hl)
+ inc hl
+ ld d,(hl)
+ inc hl
+ ex de,hl
+ jp (hl)
+ ENDM
+
+; NEXTHL is used when the IP is already in HL.
+nexthl MACRO
+ ld e,(hl)
+ inc hl
+ ld d,(hl)
+ inc hl
+ ex de,hl
+ jp (hl)
+ ENDM
+
+; RESET AND INTERRUPT VECTORS ===================
+; ...are not used in the CP/M implementation
+; Instead, we have the...
+
+; CP/M ENTRY POINT
+ org 0A00h ; Execute address
+reset: ld hl,0FDFFh ; HBIOS address, rounded down
+ ld l,0 ; = end of avail.mem (EM)
+ dec h ; EM-100h
+ ld sp,hl ; = top of param stack
+ inc h ; EM
+ push hl
+ pop ix ; = top of return stack
+ dec h ; EM-200h
+ dec h
+ push hl
+ pop iy ; = bottom of user area
+ ld de,1 ; do reset if COLD returns
+ jp COLD ; enter top-level Forth word
+
+; Memory map:
+; Terminal Input Buffer, 128 bytes
+; 0A00h Forth kernel = starts after ROMLDR
+; ? h Forth dictionary (user RAM)
+; EM-200h User area, 128 bytes
+; EM-180h Parameter stack, 128B, grows down
+; EM-100h HOLD area, 40 bytes, grows down
+; EM-0D8h PAD buffer, 88 bytes
+; EM-80h Return stack, 128 B, grows down
+; EM End of RAM = start of HBIOS
+; See also the definitions of U0, S0, and R0
+; in the "system variables & constants" area.
+; A task w/o terminal input requires 200h bytes.
+; Double all except TIB and PAD for 32-bit CPUs.
+
+; INTERPRETER LOGIC =============================
+; See also "defining words" at end of this file
+
+;C EXIT -- exit a colon definition
+ head EXIT,4,EXIT,docode
+ ld e,(ix+0) ; pop old IP from ret stk
+ inc ix
+ ld d,(ix+0)
+ inc ix
+ next
+
+;Z lit -- x fetch inline literal to stack
+; This is the primtive compiled by LITERAL.
+ head lit,3,lit,docode
+ push bc ; push old TOS
+ ld a,(de) ; fetch cell at IP to TOS,
+ ld c,a ; advancing IP
+ inc de
+ ld a,(de)
+ ld b,a
+ inc de
+ next
+
+;C EXECUTE i*x xt -- j*x execute Forth word
+;C at 'xt'
+ head EXECUTE,7,EXECUTE,docode
+ ld h,b ; address of word -> HL
+ ld l,c
+ pop bc ; get new TOS
+ jp (hl) ; go do Forth word
+
+; DEFINING WORDS ================================
+
+; ENTER, a.k.a. DOCOLON, entered by CALL ENTER
+; to enter a new high-level thread (colon def'n.)
+; (internal code fragment, not a Forth word)
+; N.B.: DOCOLON must be defined before any
+; appearance of 'docolon' in a 'word' macro!
+docolon: ; (alternate name)
+enter: dec ix ; push old IP on ret stack
+ ld (ix+0),d
+ dec ix
+ ld (ix+0),e
+ pop hl ; param field adrs -> IP
+ nexthl ; use the faster 'nexthl'
+
+;C VARIABLE -- define a Forth variable
+; CREATE 1 CELLS ALLOT ;
+; Action of RAM variable is identical to CREATE,
+; so we don't need a DOES> clause to change it.
+ head VARIABLE,8,VARIABLE,docolon
+ DW CREATE,LIT,1,CELLS,ALLOT,EXIT
+; DOVAR, code action of VARIABLE, entered by CALL
+; DOCREATE, code action of newly created words
+docreate:
+dovar: ; -- a-addr
+ pop hl ; parameter field address
+ push bc ; push old TOS
+ ld b,h ; pfa = variable's adrs -> TOS
+ ld c,l
+ next
+
+;C CONSTANT n -- define a Forth constant
+; CREATE , DOES> (machine code fragment)
+ head CONSTANT,8,CONSTANT,docolon
+ DW CREATE,COMMA,XDOES
+; DOCON, code action of CONSTANT,
+; entered by CALL DOCON
+docon: ; -- x
+ pop hl ; parameter field address
+ push bc ; push old TOS
+ ld c,(hl) ; fetch contents of parameter
+ inc hl ; field -> TOS
+ ld b,(hl)
+ next
+
+;Z USER n -- define user variable 'n'
+; CREATE , DOES> (machine code fragment)
+ head USER,4,USER,docolon
+ DW CREATE,COMMA,XDOES
+; DOUSER, code action of USER,
+; entered by CALL DOUSER
+douser: ; -- a-addr
+ pop hl ; parameter field address
+ push bc ; push old TOS
+ ld c,(hl) ; fetch contents of parameter
+ inc hl ; field
+ ld b,(hl)
+ push iy ; copy user base address to HL
+ pop hl
+ add hl,bc ; and add offset
+ ld b,h ; put result in TOS
+ ld c,l
+ next
+
+; DODOES, code action of DOES> clause
+; entered by CALL fragment
+; parameter field
+; ...
+; fragment: CALL DODOES
+; high-level thread
+; Enters high-level thread with address of
+; parameter field on top of stack.
+; (internal code fragment, not a Forth word)
+dodoes: ; -- a-addr
+ dec ix ; push old IP on ret stk
+ ld (ix+0),d
+ dec ix
+ ld (ix+0),e
+ pop de ; adrs of new thread -> IP
+ pop hl ; adrs of parameter field
+ push bc ; push old TOS onto stack
+ ld b,h ; pfa -> new TOS
+ ld c,l
+ next
+
+; CP/M TERMINAL I/O =============================
+
+;C EMIT c -- output character to console
+ head EMIT,4,EMIT,docode
+ PUSH DE
+ PUSH HL ; OUTPUT CHARACTER TO CONSOLE VIA HBIOS
+ LD E,C ; OUTPUT CHAR TO E
+ LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
+ LD B,CIOOUT ; HBIOS FUNC: OUTPUT CHAR
+ RST 08 ; HBIOS OUTPUTS CHARACTER
+ POP HL
+ POP DE
+ pop BC ; PUT TOP OF STACK IN BC
+ next
+;
+;Z SAVEKEY -- addr temporary storage for KEY?
+ head savekey,7,SAVEKEY,dovar
+SVKY: DW 0
+
+;X KEY? -- f return true if char waiting
+ head querykey,4,KEY?,docode
+ PUSH BC ; SAVE TOP OF STACK
+ PUSH DE
+ PUSH HL ; GET CONSOLE INPUT STATUS VIA HBIOS
+ LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
+ LD B,CIOIST ; HBIOS FUNC: INPUT STATUS
+ RST 08 ; HBIOS RETURNS STATUS IN A
+ LD B,A
+ OR A
+ JR Z,key3 ; INPUT CHARACTER FROM CONSOLE VIA HBIOS
+ LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
+ LD B,CIOIN ; HBIOS FUNC: INPUT CHAR
+ RST 08 ; HBIOS READS CHARACTDR
+ LD B,E
+key3: LD C,0
+ LD HL,SVKY
+ LD (HL),B
+ INC HL
+ LD (HL),C
+ POP HL
+ POP DE
+ next
+
+;C KEY -- c get character from keyboard
+; BEGIN SAVEKEY C@ 0= WHILE KEY? DROP REPEAT
+; SAVEKEY C@ 0 SAVEKEY C! ;
+ head KEY,3,KEY,docolon
+KEY1: DW SAVEKEY,CFETCH,ZEROEQUAL,qbranch,KEY2
+ DW QUERYKEY,DROP,branch,KEY1
+KEY2: DW SAVEKEY,CFETCH,LIT,0,SAVEKEY,CSTORE
+ DW EXIT
+
+;X BYE i*x -- return to CP/M
+ head bye,3,bye,docode
+ LD A,BID_BOOT ; BOOT BANK
+ LD HL,0 ; ADDRESS ZERO
+ CALL HB_BNKCALL ; DOES NOT RETURN
+ HALT
+
+; STACK OPERATIONS ==============================
+
+;C DUP x -- x x duplicate top of stack
+ head DUP,3,DUP,docode
+pushtos: push bc
+ next
+
+;C ?DUP x -- 0 | x x DUP if nonzero
+ head QDUP,4,?DUP,docode
+ ld a,b
+ or c
+ jr nz,pushtos
+ next
+
+;C DROP x -- drop top of stack
+ head DROP,4,DROP,docode
+poptos: pop bc
+ next
+
+;C SWAP x1 x2 -- x2 x1 swap top two items
+ head SWOP,4,SWAP,docode
+ pop hl
+ push bc
+ ld b,h
+ ld c,l
+ next
+
+;C OVER x1 x2 -- x1 x2 x1 per stack diagram
+ head OVER,4,OVER,docode
+ pop hl
+ push hl
+ push bc
+ ld b,h
+ ld c,l
+ next
+
+;C ROT x1 x2 x3 -- x2 x3 x1 per stack diagram
+ head ROT,3,ROT,docode
+ ; x3 is in TOS
+ pop hl ; x2
+ ex (sp),hl ; x2 on stack, x1 in hl
+ push bc
+ ld b,h
+ ld c,l
+ next
+
+;X NIP x1 x2 -- x2 per stack diagram
+ head NIP,3,NIP,docolon
+ DW SWOP,DROP,EXIT
+
+;X TUCK x1 x2 -- x2 x1 x2 per stack diagram
+ head TUCK,4,TUCK,docolon
+ DW SWOP,OVER,EXIT
+
+;C >R x -- R: -- x push to return stack
+ head TOR,2,>R,docode
+ dec ix ; push TOS onto rtn stk
+ ld (ix+0),b
+ dec ix
+ ld (ix+0),c
+ pop bc ; pop new TOS
+ next
+
+;C R> -- x R: x -- pop from return stack
+ head RFROM,2,R>,docode
+ push bc ; push old TOS
+ ld c,(ix+0) ; pop top rtn stk item
+ inc ix ; to TOS
+ ld b,(ix+0)
+ inc ix
+ next
+
+;C R@ -- x R: x -- x fetch from rtn stk
+ head RFETCH,2,R@,docode
+ push bc ; push old TOS
+ ld c,(ix+0) ; fetch top rtn stk item
+ ld b,(ix+1) ; to TOS
+ next
+
+;Z SP@ -- a-addr get data stack pointer
+ head SPFETCH,3,SP@,docode
+ push bc
+ ld hl,0
+ add hl,sp
+ ld b,h
+ ld c,l
+ next
+
+;Z SP! a-addr -- set data stack pointer
+ head SPSTORE,3,SP!,docode
+ ld h,b
+ ld l,c
+ ld sp,hl
+ pop bc ; get new TOS
+ next
+
+;Z RP@ -- a-addr get return stack pointer
+ head RPFETCH,3,RP@,docode
+ push bc
+ push ix
+ pop bc
+ next
+
+;Z RP! a-addr -- set return stack pointer
+ head RPSTORE,3,RP!,docode
+ push bc
+ pop ix
+ pop bc
+ next
+
+; MEMORY AND I/O OPERATIONS =====================
+
+;C ! x a-addr -- store cell in memory
+ head STORE,1,!,docode
+ ld h,b ; address in hl
+ ld l,c
+ pop bc ; data in bc
+ ld (hl),c
+ inc hl
+ ld (hl),b
+ pop bc ; pop new TOS
+ next
+
+;C C! char c-addr -- store char in memory
+ head CSTORE,2,C!,docode
+ ld h,b ; address in hl
+ ld l,c
+ pop bc ; data in bc
+ ld (hl),c
+ pop bc ; pop new TOS
+ next
+
+;C @ a-addr -- x fetch cell from memory
+ head FETCH,1,@,docode
+ ld h,b ; address in hl
+ ld l,c
+ ld c,(hl)
+ inc hl
+ ld b,(hl)
+ next
+
+;C C@ c-addr -- char fetch char from memory
+ head CFETCH,2,C@,docode
+ ld a,(bc)
+ ld c,a
+ ld b,0
+ next
+
+;Z PC! char c-addr -- output char to port
+ head PCSTORE,3,PC!,docode
+ pop hl ; char in L
+ out (c),l ; to port (BC)
+ pop bc ; pop new TOS
+ next
+
+;Z PC@ c-addr -- char input char from port
+ head PCFETCH,3,PC@,docode
+ in c,(c) ; read port (BC) to C
+ ld b,0
+ next
+
+; ARITHMETIC AND LOGICAL OPERATIONS =============
+
+;C + n1/u1 n2/u2 -- n3/u3 add n1+n2
+ head PLUS,1,+,docode
+ pop hl
+ add hl,bc
+ ld b,h
+ ld c,l
+ next
+
+;X M+ d n -- d add single to double
+ head MPLUS,2,M+,docode
+ ex de,hl
+ pop de ; hi cell
+ ex (sp),hl ; lo cell, save IP
+ add hl,bc
+ ld b,d ; hi result in BC (TOS)
+ ld c,e
+ jr nc,mplus1
+ inc bc
+mplus1: pop de ; restore saved IP
+ push hl ; push lo result
+ next
+
+;C - n1/u1 n2/u2 -- n3/u3 subtract n1-n2
+ head MINUS,1,-,docode
+ pop hl
+ or a
+ sbc hl,bc
+ ld b,h
+ ld c,l
+ next
+
+;C AND x1 x2 -- x3 logical AND
+ head AND,3,AND,docode
+ pop hl
+ ld a,b
+ and h
+ ld b,a
+ ld a,c
+ and l
+ ld c,a
+ next
+
+;C OR x1 x2 -- x3 logical OR
+ head OR,2,OR,docode
+ pop hl
+ ld a,b
+ or h
+ ld b,a
+ ld a,c
+ or l
+ ld c,a
+ next
+
+;C XOR x1 x2 -- x3 logical XOR
+ head XOR,3,XOR,docode
+ pop hl
+ ld a,b
+ xor h
+ ld b,a
+ ld a,c
+ xor l
+ ld c,a
+ next
+
+;C INVERT x1 -- x2 bitwise inversion
+ head INVERT,6,INVERT,docode
+ ld a,b
+ cpl
+ ld b,a
+ ld a,c
+ cpl
+ ld c,a
+ next
+
+;C NEGATE x1 -- x2 two's complement
+ head NEGATE,6,NEGATE,docode
+ ld a,b
+ cpl
+ ld b,a
+ ld a,c
+ cpl
+ ld c,a
+ inc bc
+ next
+
+;C 1+ n1/u1 -- n2/u2 add 1 to TOS
+ head ONEPLUS,2,1+,docode
+ inc bc
+ next
+
+;C 1- n1/u1 -- n2/u2 subtract 1 from TOS
+ head ONEMINUS,2,1-,docode
+ dec bc
+ next
+
+;Z >< x1 -- x2 swap bytes (not ANSI)
+ head swapbytes,2,><,docode
+ ld a,b
+ ld b,c
+ ld c,a
+ next
+
+;C 2* x1 -- x2 arithmetic left shift
+ head TWOSTAR,2,2*,docode
+ sla c
+ rl b
+ next
+
+;C 2/ x1 -- x2 arithmetic right shift
+ head TWOSLASH,2,2/,docode
+ sra b
+ rr c
+ next
+
+;C LSHIFT x1 u -- x2 logical L shift u places
+ head LSHIFT,6,LSHIFT,docode
+ ld b,c ; b = loop counter
+ pop hl ; NB: hi 8 bits ignored!
+ inc b ; test for counter=0 case
+ jr lsh2
+lsh1: add hl,hl ; left shift HL, n times
+lsh2: djnz lsh1
+ ld b,h ; result is new TOS
+ ld c,l
+ next
+
+;C RSHIFT x1 u -- x2 logical R shift u places
+ head RSHIFT,6,RSHIFT,docode
+ ld b,c ; b = loop counter
+ pop hl ; NB: hi 8 bits ignored!
+ inc b ; test for counter=0 case
+ jr rsh2
+rsh1: srl h ; right shift HL, n times
+ rr l
+rsh2: djnz rsh1
+ ld b,h ; result is new TOS
+ ld c,l
+ next
+
+;C +! n/u a-addr -- add cell to memory
+ head PLUSSTORE,2,+!,docode
+ pop hl
+ ld a,(bc) ; low byte
+ add a,l
+ ld (bc),a
+ inc bc
+ ld a,(bc) ; high byte
+ adc a,h
+ ld (bc),a
+ pop bc ; pop new TOS
+ next
+
+; COMPARISON OPERATIONS =========================
+
+;C 0= n/u -- flag return true if TOS=0
+ head ZEROEQUAL,2,0=,docode
+ ld a,b
+ or c ; result=0 if bc was 0
+ sub 1 ; cy set if bc was 0
+ sbc a,a ; propagate cy through A
+ ld b,a ; put 0000 or FFFF in TOS
+ ld c,a
+ next
+
+;C 0< n -- flag true if TOS negative
+ 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
+ ld c,a
+ next
+
+;C = x1 x2 -- flag test x1=x2
+ head EQUAL,1,=,docode
+ pop hl
+ or a
+ sbc hl,bc ; x1-x2 in HL, SZVC valid
+ jr z,tostrue
+tosfalse: ld bc,0
+ next
+
+;X <> x1 x2 -- flag test not eq (not ANSI)
+ head NOTEQUAL,2,<>,docolon
+ DW EQUAL,ZEROEQUAL,EXIT
+
+;C < n1 n2 -- flag test n1 n1 +ve, n2 -ve, rslt -ve, so n1>n2
+; if result positive & not OV, n1>=n2
+; pos. & OV => n1 -ve, n2 +ve, rslt +ve, so n1 n1 n2 -- flag test n1>n2, signed
+ 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
+ DW SWOP,ULESS,EXIT
+
+; LOOP AND BRANCH OPERATIONS ====================
+
+;Z branch -- branch always
+ head branch,6,branch,docode
+dobranch: ld a,(de) ; get inline value => IP
+ ld l,a
+ inc de
+ ld a,(de)
+ ld h,a
+ nexthl
+
+;Z ?branch x -- branch if TOS zero
+ head qbranch,7,?branch,docode
+ ld a,b
+ or c ; test old TOS
+ pop bc ; pop new TOS
+ jr z,dobranch ; if old TOS=0, branch
+ inc de ; else skip inline value
+ inc de
+ next
+
+;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2
+;Z run-time code for DO
+; '83 and ANSI standard loops terminate when the
+; boundary of limit-1 and limit is crossed, in
+; either direction. This can be conveniently
+; implemented by making the limit 8000h, so that
+; arithmetic overflow logic can detect crossing.
+; I learned this trick from Laxen & Perry F83.
+; fudge factor = 8000h-limit, to be added to
+; the start value.
+ head xdo,4,(do),docode
+ ex de,hl
+ ex (sp),hl ; IP on stack, limit in HL
+ ex de,hl
+ ld hl,8000h
+ or a
+ sbc hl,de ; 8000-limit in HL
+ dec ix ; push this fudge factor
+ ld (ix+0),h ; onto return stack
+ dec ix ; for later use by 'I'
+ ld (ix+0),l
+ add hl,bc ; add fudge to start value
+ dec ix ; push adjusted start value
+ ld (ix+0),h ; onto return stack
+ dec ix ; as the loop index.
+ ld (ix+0),l
+ pop de ; restore the saved IP
+ pop bc ; pop new TOS
+ next
+
+;Z (loop) R: sys1 sys2 -- | sys1 sys2
+;Z run-time code for LOOP
+; Add 1 to the loop index. If loop terminates,
+; clean up the return stack and skip the branch.
+; Else take the inline branch. Note that LOOP
+; terminates when index=8000h.
+ head xloop,6,(loop),docode
+ exx
+ ld bc,1
+looptst: ld l,(ix+0) ; get the loop index
+ ld h,(ix+1)
+ or a
+ adc hl,bc ; increment w/overflow test
+ jp pe,loopterm ; overflow=loop done
+ ; continue the loop
+ ld (ix+0),l ; save the updated index
+ ld (ix+1),h
+ exx
+ jr dobranch ; take the inline branch
+loopterm: ; terminate the loop
+ ld bc,4 ; discard the loop info
+ add ix,bc
+ exx
+ inc de ; skip the inline branch
+ inc de
+ next
+
+;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2
+;Z run-time code for +LOOP
+; Add n to the loop index. If loop terminates,
+; clean up the return stack and skip the branch.
+; Else take the inline branch.
+ head xplusloop,7,(+loop),docode
+ pop hl ; this will be the new TOS
+ push bc
+ ld b,h
+ ld c,l
+ exx
+ pop bc ; old TOS = loop increment
+ jr looptst
+
+;C I -- n R: sys1 sys2 -- sys1 sys2
+;C get the innermost loop index
+ head II,1,I,docode
+ push bc ; push old TOS
+ ld l,(ix+0) ; get current loop index
+ ld h,(ix+1)
+ ld c,(ix+2) ; get fudge factor
+ ld b,(ix+3)
+ or a
+ sbc hl,bc ; subtract fudge factor,
+ ld b,h ; returning true index
+ ld c,l
+ next
+
+;C J -- n R: 4*sys -- 4*sys
+;C get the second loop index
+ head JJ,1,J,docode
+ push bc ; push old TOS
+ ld l,(ix+4) ; get current loop index
+ ld h,(ix+5)
+ ld c,(ix+6) ; get fudge factor
+ ld b,(ix+7)
+ or a
+ sbc hl,bc ; subtract fudge factor,
+ ld b,h ; returning true index
+ ld c,l
+ next
+
+;C UNLOOP -- R: sys1 sys2 -- drop loop parms
+ head UNLOOP,6,UNLOOP,docode
+ inc ix
+ inc ix
+ inc ix
+ inc ix
+ next
+
+; MULTIPLY AND DIVIDE ===========================
+
+;C UM* u1 u2 -- ud unsigned 16x16->32 mult.
+ head UMSTAR,3,UM*,docode
+ push bc
+ exx
+ pop bc ; u2 in BC
+ pop de ; u1 in DE
+ ld hl,0 ; result will be in HLDE
+ ld a,17 ; loop counter
+ or a ; clear cy
+umloop: rr h
+ rr l
+ rr d
+ rr e
+ jr nc,noadd
+ add hl,bc
+noadd: dec a
+ jr nz,umloop
+ push de ; lo result
+ push hl ; hi result
+ exx
+ pop bc ; put TOS back in BC
+ next
+
+;C UM/MOD ud u1 -- u2 u3 unsigned 32/16->16
+ head UMSLASHMOD,6,UM/MOD,docode
+ push bc
+ exx
+ pop bc ; BC = divisor
+ pop hl ; HLDE = dividend
+ pop de
+ ld a,16 ; loop counter
+ sla e
+ rl d ; hi bit DE -> carry
+udloop: adc hl,hl ; rot left w/ carry
+ jr nc,udiv3
+ ; case 1: 17 bit, cy:HL = 1xxxx
+ or a ; we know we can subtract
+ sbc hl,bc
+ or a ; clear cy to indicate sub ok
+ jr udiv4
+ ; case 2: 16 bit, cy:HL = 0xxxx
+udiv3: sbc hl,bc ; try the subtract
+ jr nc,udiv4 ; if no cy, subtract ok
+ add hl,bc ; else cancel the subtract
+ scf ; and set cy to indicate
+udiv4: rl e ; rotate result bit into DE,
+ rl d ; and next bit of DE into cy
+ dec a
+ jr nz,udloop
+ ; now have complemented quotient in DE,
+ ; and remainder in HL
+ ld a,d
+ cpl
+ ld b,a
+ ld a,e
+ cpl
+ ld c,a
+ push hl ; push remainder
+ push bc
+ exx
+ pop bc ; quotient remains in TOS
+ next
+
+; BLOCK AND STRING OPERATIONS ===================
+
+;C FILL c-addr u char -- fill memory with char
+ head FILL,4,FILL,docode
+ ld a,c ; character in a
+ exx ; use alt. register set
+ pop bc ; count in bc
+ pop de ; address in de
+ or a ; clear carry flag
+ ld hl,0ffffh
+ adc hl,bc ; test for count=0 or 1
+ jr nc,filldone ; no cy: count=0, skip
+ ld (de),a ; fill first byte
+ jr z,filldone ; zero, count=1, done
+ dec bc ; else adjust count,
+ ld h,d ; let hl = start adrs,
+ ld l,e
+ inc de ; let de = start adrs+1
+ ldir ; copy (hl)->(de)
+filldone: exx ; back to main reg set
+ pop bc ; pop new TOS
+ next
+
+;X CMOVE c-addr1 c-addr2 u -- move from bottom
+; as defined in the ANSI optional String word set
+; On byte machines, CMOVE and CMOVE> are logical
+; factors of MOVE. They are easy to implement on
+; CPUs which have a block-move instruction.
+ head CMOVE,5,CMOVE,docode
+ push bc
+ exx
+ pop bc ; count
+ pop de ; destination adrs
+ pop hl ; source adrs
+ ld a,b ; test for count=0
+ or c
+ jr z,cmovedone
+ ldir ; move from bottom to top
+cmovedone: exx
+ pop bc ; pop new TOS
+ next
+
+;X CMOVE> c-addr1 c-addr2 u -- move from top
+; as defined in the ANSI optional String word set
+ head CMOVEUP,6,CMOVE>,docode
+ push bc
+ exx
+ pop bc ; count
+ pop hl ; destination adrs
+ pop de ; source adrs
+ ld a,b ; test for count=0
+ or c
+ jr z,umovedone
+ add hl,bc ; last byte in destination
+ dec hl
+ ex de,hl
+ add hl,bc ; last byte in source
+ dec hl
+ lddr ; move from top to bottom
+umovedone: exx
+ pop bc ; pop new TOS
+ next
+
+;Z SKIP c-addr u c -- c-addr' u'
+;Z skip matching chars
+; Although SKIP, SCAN, and S= are perhaps not the
+; ideal factors of WORD and FIND, they closely
+; follow the string operations available on many
+; CPUs, and so are easy to implement and fast.
+ head skip,4,SKIP,docode
+ ld a,c ; skip character
+ exx
+ pop bc ; count
+ pop hl ; address
+ ld e,a ; test for count=0
+ ld a,b
+ or c
+ jr z,skipdone
+ ld a,e
+skiploop: cpi
+ jr nz,skipmis ; char mismatch: exit
+ jp pe,skiploop ; count not exhausted
+ jr skipdone ; count 0, no mismatch
+skipmis: inc bc ; mismatch! undo last to
+ dec hl ; point at mismatch char
+skipdone: push hl ; updated address
+ push bc ; updated count
+ exx
+ pop bc ; TOS in bc
+ next
+
+;Z SCAN c-addr u c -- c-addr' u'
+;Z find matching char
+ head scan,4,SCAN,docode
+ ld a,c ; scan character
+ exx
+ pop bc ; count
+ pop hl ; address
+ ld e,a ; test for count=0
+ ld a,b
+ or c
+ jr z,scandone
+ ld a,e
+ cpir ; scan 'til match or count=0
+ jr nz,scandone ; no match, BC & HL ok
+ inc bc ; match! undo last to
+ dec hl ; point at match char
+scandone: push hl ; updated address
+ push bc ; updated count
+ exx
+ pop bc ; TOS in bc
+ next
+
+;Z S= c-addr1 c-addr2 u -- n string compare
+;Z n<0: s10: s1>s2
+ head sequal,2,S=,docode
+ push bc
+ exx
+ pop bc ; count
+ pop hl ; addr2
+ pop de ; addr1
+ ld a,b ; test for count=0
+ or c
+ jr z,smatch ; by definition, match!
+sloop: ld a,(de)
+ inc de
+ cpi
+ jr nz,sdiff ; char mismatch: exit
+ jp pe,sloop ; count not exhausted
+smatch: ; count exhausted & no mismatch found
+ exx
+ ld bc,0 ; bc=0000 (s1=s2)
+ jr snext
+sdiff: ; mismatch! undo last 'cpi' increment
+ dec hl ; point at mismatch char
+ cp (hl) ; set cy if char1 < char2
+ sbc a,a ; propagate cy thru A
+ exx
+ ld b,a ; bc=FFFF if cy (s1s2)
+ ld c,a
+snext: next
+
+*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
+
+ ; force padding to page boundary
+
+ ds (FTH_SIZ-(enddict-reset)-1)
+ nop
+
+ END
+
diff --git a/Source/HBIOS/Forth/camel80d.azm b/Source/HBIOS/Forth/camel80d.azm
new file mode 100644
index 00000000..0dd13e3e
--- /dev/null
+++ b/Source/HBIOS/Forth/camel80d.azm
@@ -0,0 +1,154 @@
+; LISTING 3.
+;
+; ===============================================
+; CamelForth for the Zilog Z80
+; Copyright (c) 1994,1995 Bradford J. Rodriguez
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation; either version 3 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with this program. If not, see .
+
+; Commercial inquiries should be directed to the author at
+; 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
+; or via email to bj@camelforth.com
+;
+; ===============================================
+; CAMEL80D.AZM: CPU and Model Dependencies
+; Source code is for the Z80MR macro assembler.
+; Forth words are documented as follows:
+;* NAME stack -- stack description
+; Word names in upper case are from the ANS
+; Forth Core word set. Names in lower case are
+; "internal" implementation words & extensions.
+;
+; Direct-Threaded Forth model for Zilog Z80
+; cell size is 16 bits (2 bytes)
+; char size is 8 bits (1 byte)
+; address unit is 8 bits (1 byte), i.e.,
+; addresses are byte-aligned.
+; ===============================================
+
+; ALIGNMENT AND PORTABILITY OPERATORS ===========
+; Many of these are synonyms for other words,
+; and so are defined as CODE words.
+
+;C ALIGN -- align HERE
+ head ALIGN,5,ALIGN,docode
+noop: next
+
+;C ALIGNED addr -- a-addr align given addr
+ head ALIGNED,7,ALIGNED,docode
+ jr noop
+
+;Z CELL -- n size of one cell
+ head CELL,4,CELL,docon
+ dw 2
+
+;C CELL+ a-addr1 -- a-addr2 add cell size
+; 2 + ;
+ head CELLPLUS,5,CELL+,docode
+ inc bc
+ inc bc
+ next
+
+;C CELLS n1 -- n2 cells->adrs units
+ head CELLS,5,CELLS,docode
+ jp twostar
+
+;C CHAR+ c-addr1 -- c-addr2 add char size
+ head CHARPLUS,5,CHAR+,docode
+ jp oneplus
+
+;C CHARS n1 -- n2 chars->adrs units
+ head CHARS,5,CHARS,docode
+ jr noop
+
+;C >BODY xt -- a-addr adrs of param field
+; 3 + ; Z80 (3 byte CALL)
+ head TOBODY,5,>BODY,docolon
+ DW LIT,3,PLUS,EXIT
+
+;X COMPILE, xt -- append execution token
+; I called this word ,XT before I discovered that
+; 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
+ jp COMMA
+
+;Z !CF adrs cfa -- set code action of a word
+; 0CD OVER C! store 'CALL adrs' instr
+; 1+ ! ; Z80 VERSION
+; Depending on the implementation this could
+; append CALL adrs or JUMP adrs.
+ 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
+ DW HERE,STORECF,LIT,3,ALLOT,EXIT
+
+;Z !COLON -- change code field to docolon
+; -3 ALLOT docolon-adrs ,CF ;
+; 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
+ DW LIT,-3,ALLOT
+ DW LIT,docolon,COMMACF,EXIT
+
+;Z ,EXIT -- append hi-level EXIT action
+; ['] 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
+ DW LIT,EXIT,COMMAXT,EXIT
+
+; CONTROL STRUCTURES ============================
+; These words allow Forth control structure words
+; to be defined portably.
+
+;Z ,BRANCH xt -- append a branch instruction
+; 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
+ 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
+ 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
+ jp STORE
+
+; HEADER STRUCTURE ==============================
+; The structure of the Forth dictionary headers
+; (name, link, immediate flag, and "smudge" bit)
+; does not necessarily differ across CPUs. This
+; structure is not easily factored into distinct
+; "portable" words; instead, it is implicit in
+; the definitions of FIND and CREATE, and also in
+; NFA>LFA, NFA>CFA, IMMED?, IMMEDIATE, HIDE, and
+; REVEAL. These words must be (substantially)
+; rewritten if either the header structure or its
+; inherent assumptions are changed.
+
diff --git a/Source/HBIOS/Forth/camel80h.azm b/Source/HBIOS/Forth/camel80h.azm
new file mode 100644
index 00000000..90ed8559
--- /dev/null
+++ b/Source/HBIOS/Forth/camel80h.azm
@@ -0,0 +1,1026 @@
+; LISTING 2.
+;
+; ===============================================
+; CamelForth for the Zilog Z80
+; Copyright (c) 1994,1995 Bradford J. Rodriguez
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation; either version 3 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with this program. If not, see .
+
+; Commercial inquiries should be directed to the author at
+; 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
+; or via email to bj@camelforth.com
+;
+; ===============================================
+; CAMEL80H.AZM: High Level Words
+; Source code is for the Z80MR macro assembler.
+; Forth words are documented as follows:
+;* NAME stack -- stack description
+; Word names in upper case are from the ANS
+; Forth Core word set. Names in lower case are
+; "internal" implementation words & extensions.
+; ===============================================
+
+; SYSTEM VARIABLES & CONSTANTS ==================
+
+;C BL -- char an ASCII space
+ head BL,2,BL,docon
+ dw 20h
+
+;Z tibsize -- n size of TIB
+ head TIBSIZE,7,TIBSIZE,docon
+ dw 124 ; 2 chars safety zone
+
+;X tib -- a-addr Terminal Input Buffer
+; HEX 82 CONSTANT TIB CP/M systems: 126 bytes
+; HEX -80 USER TIB others: below user area
+; head TIB,3,TIB,docon
+; dw 82h
+ head TIB,3,TIB,douser
+ dw -80h
+
+;Z u0 -- a-addr current user area adrs
+; 0 USER U0
+ head U0,2,U0,douser
+ dw 0
+
+;C >IN -- a-addr holds offset into TIB
+; 2 USER >IN
+ head TOIN,3,>IN,douser
+ dw 2
+
+;C BASE -- a-addr holds conversion radix
+; 4 USER BASE
+ head BASE,4,BASE,douser
+ dw 4
+
+;C STATE -- a-addr holds compiler state
+; 6 USER STATE
+ head STATE,5,STATE,douser
+ dw 6
+
+;Z dp -- a-addr holds dictionary ptr
+; 8 USER DP
+ head DP,2,DP,douser
+ dw 8
+
+;Z 'source -- a-addr two cells: len, adrs
+; 10 USER 'SOURCE
+; head TICKSOURCE,7,'SOURCE,douser
+ DW link ; must expand
+ DB 0 ; manually
+link DEFL $ ; because of
+ DB 7,27h,'SOURCE' ; tick character
+TICKSOURCE: call douser ; in name!
+ dw 10
+
+;Z latest -- a-addr last word in dict.
+; 14 USER LATEST
+ head LATEST,6,LATEST,douser
+ dw 14
+
+;Z hp -- a-addr HOLD pointer
+; 16 USER HP
+ head HP,2,HP,douser
+ dw 16
+
+;Z LP -- a-addr Leave-stack pointer
+; 18 USER LP
+ head LP,2,LP,douser
+ dw 18
+
+;Z s0 -- a-addr end of parameter stack
+ head S0,2,S0,douser
+ dw 100h
+
+;X PAD -- a-addr user PAD buffer
+; = end of hold area!
+ head PAD,3,PAD,douser
+ dw 128h
+
+;Z l0 -- a-addr bottom of Leave stack
+ head L0,2,L0,douser
+ dw 180h
+
+;Z r0 -- a-addr end of return stack
+ head R0,2,R0,douser
+ dw 200h
+
+;Z uinit -- addr initial values for user area
+ head UINIT,5,UINIT,docreate
+ DW 0,0,10,0 ; reserved,>IN,BASE,STATE
+ DW enddict ; DP
+ DW 0,0 ; SOURCE init'd elsewhere
+ DW lastword ; LATEST
+ DW 0 ; HP init'd elsewhere
+
+;Z #init -- n #bytes of user area init data
+ head NINIT,5,#INIT,docon
+ DW 18
+
+; ARITHMETIC OPERATORS ==========================
+
+;C S>D n -- d single -> double prec.
+; DUP 0< ;
+ head STOD,3,S>D,docolon
+ dw DUP,ZEROLESS,EXIT
+
+;Z ?NEGATE n1 n2 -- n3 negate n1 if n2 negative
+; 0< IF NEGATE THEN ; ...a common factor
+ head QNEGATE,7,?NEGATE,docolon
+ DW ZEROLESS,qbranch,QNEG1,NEGATE
+QNEG1: DW EXIT
+
+;C ABS n1 -- +n2 absolute value
+; DUP ?NEGATE ;
+ head ABS,3,ABS,docolon
+ DW DUP,QNEGATE,EXIT
+
+;X DNEGATE d1 -- d2 negate double precision
+; SWAP INVERT SWAP INVERT 1 M+ ;
+ head DNEGATE,7,DNEGATE,docolon
+ DW SWOP,INVERT,SWOP,INVERT,LIT,1,MPLUS
+ DW EXIT
+
+;Z ?DNEGATE d1 n -- d2 negate d1 if n negative
+; 0< IF DNEGATE THEN ; ...a common factor
+ head QDNEGATE,8,?DNEGATE,docolon
+ DW ZEROLESS,qbranch,DNEG1,DNEGATE
+DNEG1: DW EXIT
+
+;X DABS d1 -- +d2 absolute value dbl.prec.
+; DUP ?DNEGATE ;
+ head DABS,4,DABS,docolon
+ DW DUP,QDNEGATE,EXIT
+
+;C M* n1 n2 -- d signed 16*16->32 multiply
+; 2DUP XOR >R carries sign of the result
+; SWAP ABS SWAP ABS UM*
+; R> ?DNEGATE ;
+ head MSTAR,2,M*,docolon
+ DW TWODUP,XOR,TOR
+ DW SWOP,ABS,SWOP,ABS,UMSTAR
+ DW RFROM,QDNEGATE,EXIT
+
+;C SM/REM d1 n1 -- n2 n3 symmetric signed div
+; 2DUP XOR >R sign of quotient
+; OVER >R sign of remainder
+; ABS >R DABS R> UM/MOD
+; SWAP R> ?NEGATE
+; SWAP R> ?NEGATE ;
+; Ref. dpANS-6 section 3.2.2.1.
+ head SMSLASHREM,6,SM/REM,docolon
+ DW TWODUP,XOR,TOR,OVER,TOR
+ DW ABS,TOR,DABS,RFROM,UMSLASHMOD
+ DW SWOP,RFROM,QNEGATE,SWOP,RFROM,QNEGATE
+ DW EXIT
+
+;C FM/MOD d1 n1 -- n2 n3 floored signed div'n
+; DUP >R save divisor
+; SM/REM
+; DUP 0< IF if quotient negative,
+; SWAP R> + add divisor to rem'dr
+; SWAP 1- decrement quotient
+; ELSE R> DROP THEN ;
+; Ref. dpANS-6 section 3.2.2.1.
+ head FMSLASHMOD,6,FM/MOD,docolon
+ DW DUP,TOR,SMSLASHREM
+ DW DUP,ZEROLESS,qbranch,FMMOD1
+ DW SWOP,RFROM,PLUS,SWOP,ONEMINUS
+ DW branch,FMMOD2
+FMMOD1: DW RFROM,DROP
+FMMOD2: DW EXIT
+
+;C * n1 n2 -- n3 signed multiply
+; M* DROP ;
+ head STAR,1,*,docolon
+ dw MSTAR,DROP,EXIT
+
+;C /MOD n1 n2 -- n3 n4 signed divide/rem'dr
+; >R S>D R> FM/MOD ;
+ head SLASHMOD,4,/MOD,docolon
+ dw TOR,STOD,RFROM,FMSLASHMOD,EXIT
+
+;C / n1 n2 -- n3 signed divide
+; /MOD nip ;
+ head SLASH,1,/,docolon
+ dw SLASHMOD,NIP,EXIT
+
+;C MOD n1 n2 -- n3 signed remainder
+; /MOD DROP ;
+ head MOD,3,MOD,docolon
+ dw SLASHMOD,DROP,EXIT
+
+;C */MOD n1 n2 n3 -- n4 n5 n1*n2/n3, rem"
+; >R M* R> FM/MOD ;
+ head SSMOD,5,*/MOD,docolon
+ dw TOR,MSTAR,RFROM,FMSLASHMOD,EXIT
+
+;C */ n1 n2 n3 -- n4 n1*n2/n3
+; */MOD nip ;
+ head STARSLASH,2,*/,docolon
+ dw SSMOD,NIP,EXIT
+
+;C MAX n1 n2 -- n3 signed maximum
+; 2DUP < IF SWAP THEN DROP ;
+ head MAX,3,MAX,docolon
+ dw TWODUP,LESS,qbranch,MAX1,SWOP
+MAX1: dw DROP,EXIT
+
+;C MIN n1 n2 -- n3 signed minimum
+; 2DUP > IF SWAP THEN DROP ;
+ head MIN,3,MIN,docolon
+ dw TWODUP,GREATER,qbranch,MIN1,SWOP
+MIN1: dw DROP,EXIT
+
+; DOUBLE OPERATORS ==============================
+
+;C 2@ a-addr -- x1 x2 fetch 2 cells
+; DUP CELL+ @ SWAP @ ;
+; the lower address will appear on top of stack
+ head TWOFETCH,2,2@,docolon
+ dw DUP,CELLPLUS,FETCH,SWOP,FETCH,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
+ dw SWOP,OVER,STORE,CELLPLUS,STORE,EXIT
+
+;C 2DROP x1 x2 -- drop 2 cells
+; DROP DROP ;
+ head TWODROP,5,2DROP,docolon
+ dw DROP,DROP,EXIT
+
+;C 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells
+; OVER OVER ;
+ head TWODUP,4,2DUP,docolon
+ dw OVER,OVER,EXIT
+
+;C 2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 per diagram
+; ROT >R ROT R> ;
+ head TWOSWAP,5,2SWAP,docolon
+ dw ROT,TOR,ROT,RFROM,EXIT
+
+;C 2OVER x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
+; >R >R 2DUP R> R> 2SWAP ;
+ head TWOOVER,5,2OVER,docolon
+ dw TOR,TOR,TWODUP,RFROM,RFROM
+ dw TWOSWAP,EXIT
+
+; INPUT/OUTPUT ==================================
+
+;C COUNT c-addr1 -- c-addr2 u counted->adr/len
+; DUP CHAR+ SWAP C@ ;
+ head COUNT,5,COUNT,docolon
+ dw DUP,CHARPLUS,SWOP,CFETCH,EXIT
+
+;C CR -- output newline
+; 0D EMIT 0A EMIT ;
+ head CR,2,CR,docolon
+ dw lit,0dh,EMIT,lit,0ah,EMIT,EXIT
+
+;C SPACE -- output a space
+; BL EMIT ;
+ head SPACE,5,SPACE,docolon
+ dw BL,EMIT,EXIT
+
+;C SPACES n -- output n spaces
+; BEGIN DUP WHILE SPACE 1- REPEAT DROP ;
+ head SPACES,6,SPACES,docolon
+SPCS1: DW DUP,qbranch,SPCS2
+ DW SPACE,ONEMINUS,branch,SPCS1
+SPCS2: DW DROP,EXIT
+
+;Z umin u1 u2 -- u unsigned minimum
+; 2DUP U> IF SWAP THEN DROP ;
+ head UMIN,4,UMIN,docolon
+ DW TWODUP,UGREATER,QBRANCH,UMIN1,SWOP
+UMIN1: DW DROP,EXIT
+
+;Z umax u1 u2 -- u unsigned maximum
+; 2DUP U< IF SWAP THEN DROP ;
+ head UMAX,4,UMAX,docolon
+ DW TWODUP,ULESS,QBRANCH,UMAX1,SWOP
+UMAX1: DW DROP,EXIT
+
+;C ACCEPT c-addr +n -- +n' get line from term'l
+; OVER + 1- OVER -- sa ea a
+; BEGIN KEY -- sa ea a c
+; DUP 0D <> WHILE
+; DUP EMIT -- sa ea a c
+; DUP 8 = IF DROP 1- >R OVER R> UMAX
+; ELSE OVER C! 1+ OVER UMIN
+; THEN -- sa ea a
+; REPEAT -- sa ea a c
+; DROP NIP SWAP - ;
+ head ACCEPT,6,ACCEPT,docolon
+ DW OVER,PLUS,ONEMINUS,OVER
+ACC1: DW KEY,DUP,LIT,0DH,NOTEQUAL,QBRANCH,ACC5
+ DW DUP,EMIT,DUP,LIT,8,EQUAL,QBRANCH,ACC3
+ DW DROP,ONEMINUS,TOR,OVER,RFROM,UMAX
+ DW BRANCH,ACC4
+ACC3: DW OVER,CSTORE,ONEPLUS,OVER,UMIN
+ACC4: DW BRANCH,ACC1
+ACC5: DW DROP,NIP,SWOP,MINUS,EXIT
+
+;C TYPE c-addr +n -- type line to term'l
+; ?DUP IF
+; OVER + SWAP DO I C@ EMIT LOOP
+; ELSE DROP THEN ;
+ head TYPE,4,TYPE,docolon
+ DW QDUP,QBRANCH,TYP4
+ DW OVER,PLUS,SWOP,XDO
+TYP3: DW II,CFETCH,EMIT,XLOOP,TYP3
+ DW BRANCH,TYP5
+TYP4: DW DROP
+TYP5: DW EXIT
+
+;Z (S") -- c-addr u run-time code for S"
+; R> COUNT 2DUP + ALIGNED >R ;
+ 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
+ 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
+ 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.
+
+; Some double-precision arithmetic operators are
+; needed to implement ANSI numeric conversion.
+
+;Z UD/MOD ud1 u2 -- u3 ud4 32/16->32 divide
+; >R 0 R@ UM/MOD ROT ROT R> UM/MOD ROT ;
+ head UDSLASHMOD,6,UD/MOD,docolon
+ DW TOR,LIT,0,RFETCH,UMSLASHMOD,ROT,ROT
+ DW RFROM,UMSLASHMOD,ROT,EXIT
+
+;Z UD* ud1 d2 -- ud3 32*16->32 multiply
+; DUP >R UM* DROP SWAP R> UM* ROT + ;
+ head UDSTAR,3,UD*,docolon
+ DW DUP,TOR,UMSTAR,DROP
+ DW SWOP,RFROM,UMSTAR,ROT,PLUS,EXIT
+
+;C HOLD char -- add char to output string
+; -1 HP +! HP @ C! ;
+ head HOLD,4,HOLD,docolon
+ DW LIT,-1,HP,PLUSSTORE
+ DW HP,FETCH,CSTORE,EXIT
+
+;C <# -- begin numeric conversion
+; PAD HP ! ; (initialize Hold Pointer)
+ 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
+ DW DUP,LIT,9,GREATER,LIT,7,AND,PLUS
+ DW LIT,30H,PLUS,EXIT
+
+;C # ud1 -- ud2 convert 1 digit of output
+; BASE @ UD/MOD ROT >digit HOLD ;
+ head NUM,1,#,docolon
+ DW BASE,FETCH,UDSLASHMOD,ROT,TODIGIT
+ DW HOLD,EXIT
+
+;C #S ud1 -- ud2 convert remaining digits
+; BEGIN # 2DUP OR 0= UNTIL ;
+ head NUMS,2,#S,docolon
+NUMS1: DW NUM,TWODUP,OR,ZEROEQUAL,qbranch,NUMS1
+ DW EXIT
+
+;C #> ud1 -- c-addr u end conv., get string
+; 2DROP HP @ PAD OVER - ;
+ head NUMGREATER,2,#>,docolon
+ DW TWODROP,HP,FETCH,PAD,OVER,MINUS,EXIT
+
+;C SIGN n -- add minus sign if n<0
+; 0< IF 2D HOLD THEN ;
+ head SIGN,4,SIGN,docolon
+ DW ZEROLESS,qbranch,SIGN1,LIT,2DH,HOLD
+SIGN1: DW EXIT
+
+;C U. u -- display u unsigned
+; <# 0 #S #> TYPE SPACE ;
+ head UDOT,2,U.,docolon
+ DW LESSNUM,LIT,0,NUMS,NUMGREATER,TYPE
+ DW SPACE,EXIT
+
+;C . n -- display n signed
+; <# DUP ABS 0 #S ROT SIGN #> TYPE SPACE ;
+ head DOT,1,'.',docolon
+ DW LESSNUM,DUP,ABS,LIT,0,NUMS
+ DW ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
+
+;C DECIMAL -- set number base to decimal
+; 10 BASE ! ;
+ head DECIMAL,7,DECIMAL,docolon
+ DW LIT,10,BASE,STORE,EXIT
+
+;X HEX -- set number base to hex
+; 16 BASE ! ;
+ head HEX,3,HEX,docolon
+ DW LIT,16,BASE,STORE,EXIT
+
+; DICTIONARY MANAGEMENT =========================
+
+;C HERE -- addr returns dictionary ptr
+; DP @ ;
+ head HERE,4,HERE,docolon
+ dw DP,FETCH,EXIT
+
+;C ALLOT n -- allocate n bytes in dict
+; DP +! ;
+ head ALLOT,5,ALLOT,docolon
+ dw DP,PLUSSTORE,EXIT
+
+; Note: , and C, are only valid for combined
+; Code and Data spaces.
+
+;C , x -- append cell to dict
+; HERE ! 1 CELLS ALLOT ;
+ 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
+ dw HERE,CSTORE,lit,1,CHARS,ALLOT,EXIT
+
+; INTERPRETER ===================================
+; Note that NFA>LFA, NFA>CFA, IMMED?, and FIND
+; are dependent on the structure of the Forth
+; header. This may be common across many CPUs,
+; or it may be different.
+
+;C SOURCE -- adr n current input buffer
+; 'SOURCE 2@ ; length is at lower adrs
+ head SOURCE,6,SOURCE,docolon
+ DW TICKSOURCE,TWOFETCH,EXIT
+
+;X /STRING a u n -- a+n u-n trim string
+; ROT OVER + ROT ROT - ;
+ head SLASHSTRING,7,/STRING,docolon
+ DW ROT,OVER,PLUS,ROT,ROT,MINUS,EXIT
+
+;Z >counted src n dst -- copy to counted str
+; 2DUP C! CHAR+ SWAP CMOVE ;
+ head TOCOUNTED,8,>COUNTED,docolon
+ DW TWODUP,CSTORE,CHARPLUS,SWOP,CMOVE,EXIT
+
+;C WORD char -- c-addr n word delim'd by char
+; DUP SOURCE >IN @ /STRING -- c c adr n
+; DUP >R ROT SKIP -- c adr' n'
+; OVER >R ROT SCAN -- adr" n"
+; DUP IF CHAR- THEN skip trailing delim.
+; R> R> ROT - >IN +! update >IN offset
+; TUCK - -- adr' N
+; HERE >counted --
+; HERE -- a
+; BL OVER COUNT + C! ; append trailing blank
+ head WORD,4,WORD,docolon
+ DW DUP,SOURCE,TOIN,FETCH,SLASHSTRING
+ DW DUP,TOR,ROT,SKIP
+ DW OVER,TOR,ROT,SCAN
+ DW DUP,qbranch,WORD1,ONEMINUS ; char-
+WORD1: DW RFROM,RFROM,ROT,MINUS,TOIN,PLUSSTORE
+ DW TUCK,MINUS
+ DW HERE,TOCOUNTED,HERE
+ DW BL,OVER,COUNT,PLUS,CSTORE,EXIT
+
+;Z NFA>LFA nfa -- lfa name adr -> link field
+; 3 - ;
+ 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
+ DW COUNT,LIT,07FH,AND,PLUS,EXIT
+
+;Z IMMED? nfa -- f fetch immediate flag
+; 1- C@ ; nonzero if immed
+ head IMMEDQ,6,IMMED?,docolon
+ DW ONEMINUS,CFETCH,EXIT
+
+;C FIND c-addr -- c-addr 0 if not found
+;C xt 1 if immediate
+;C xt -1 if "normal"
+; LATEST @ BEGIN -- a nfa
+; 2DUP OVER C@ CHAR+ -- a nfa a nfa n+1
+; S= -- a nfa f
+; DUP IF
+; DROP
+; NFA>LFA @ DUP -- a link link
+; THEN
+; 0= UNTIL -- a nfa OR a 0
+; DUP IF
+; NIP DUP NFA>CFA -- nfa xt
+; SWAP IMMED? -- xt iflag
+; 0= 1 OR -- xt 1/-1
+; THEN ;
+ head FIND,4,FIND,docolon
+ DW LATEST,FETCH
+FIND1: DW TWODUP,OVER,CFETCH,CHARPLUS
+ DW SEQUAL,DUP,qbranch,FIND2
+ DW DROP,NFATOLFA,FETCH,DUP
+FIND2: DW ZEROEQUAL,qbranch,FIND1
+ DW DUP,qbranch,FIND3
+ DW NIP,DUP,NFATOCFA
+ DW SWOP,IMMEDQ,ZEROEQUAL,LIT,1,OR
+FIND3: DW EXIT
+
+;C LITERAL x -- append numeric literal
+; STATE @ IF ['] LIT ,XT , THEN ; IMMEDIATE
+; This tests STATE so that it can also be used
+; interpretively. (ANSI doesn't require this.)
+ immed LITERAL,7,LITERAL,docolon
+ DW STATE,FETCH,qbranch,LITER1
+ DW LIT,LIT,COMMAXT,COMMA
+LITER1: DW EXIT
+
+;Z DIGIT? c -- n -1 if c is a valid digit
+;Z -- x 0 otherwise
+; [ HEX ] DUP 39 > 100 AND + silly looking
+; DUP 140 > 107 AND - 30 - but it works!
+; DUP BASE @ U< ;
+ head DIGITQ,6,DIGIT?,docolon
+ DW DUP,LIT,39H,GREATER,LIT,100H,AND,PLUS
+ DW DUP,LIT,140H,GREATER,LIT,107H,AND
+ DW MINUS,LIT,30H,MINUS
+ DW DUP,BASE,FETCH,ULESS,EXIT
+
+;Z ?SIGN adr n -- adr' n' f get optional sign
+;Z advance adr/n if sign; return NZ if negative
+; OVER C@ -- adr n c
+; 2C - DUP ABS 1 = AND -- +=-1, -=+1, else 0
+; DUP IF 1+ -- +=0, -=+2
+; >R 1 /STRING R> -- adr' n' f
+; THEN ;
+ head QSIGN,5,?SIGN,docolon
+ DW OVER,CFETCH,LIT,2CH,MINUS,DUP,ABS
+ DW LIT,1,EQUAL,AND,DUP,qbranch,QSIGN1
+ DW ONEPLUS,TOR,LIT,1,SLASHSTRING,RFROM
+QSIGN1: DW EXIT
+
+;C >NUMBER ud adr u -- ud' adr' u'
+;C convert string to number
+; BEGIN
+; DUP WHILE
+; OVER C@ DIGIT?
+; 0= IF DROP EXIT THEN
+; >R 2SWAP BASE @ UD*
+; R> M+ 2SWAP
+; 1 /STRING
+; REPEAT ;
+ head TONUMBER,7,>NUMBER,docolon
+TONUM1: DW DUP,qbranch,TONUM3
+ DW OVER,CFETCH,DIGITQ
+ DW ZEROEQUAL,qbranch,TONUM2,DROP,EXIT
+TONUM2: DW TOR,TWOSWAP,BASE,FETCH,UDSTAR
+ DW RFROM,MPLUS,TWOSWAP
+ DW LIT,1,SLASHSTRING,branch,TONUM1
+TONUM3: DW EXIT
+
+;Z ?NUMBER c-addr -- n -1 string->number
+;Z -- c-addr 0 if convert error
+; DUP 0 0 ROT COUNT -- ca ud adr n
+; ?SIGN >R >NUMBER -- ca ud adr' n'
+; IF R> 2DROP 2DROP 0 -- ca 0 (error)
+; ELSE 2DROP NIP R>
+; IF NEGATE THEN -1 -- n -1 (ok)
+; THEN ;
+ head QNUMBER,7,?NUMBER,docolon
+ DW DUP,LIT,0,DUP,ROT,COUNT
+ DW QSIGN,TOR,TONUMBER,qbranch,QNUM1
+ DW RFROM,TWODROP,TWODROP,LIT,0
+ DW branch,QNUM3
+QNUM1: DW TWODROP,NIP,RFROM,qbranch,QNUM2,NEGATE
+QNUM2: DW LIT,-1
+QNUM3: DW EXIT
+
+;Z INTERPRET i*x c-addr u -- j*x
+;Z interpret given buffer
+; This is a common factor of EVALUATE and QUIT.
+; ref. dpANS-6, 3.4 The Forth Text Interpreter
+; 'SOURCE 2! 0 >IN !
+; BEGIN
+; BL WORD DUP C@ WHILE -- textadr
+; FIND -- a 0/1/-1
+; ?DUP IF -- xt 1/-1
+; 1+ STATE @ 0= OR immed or interp?
+; IF EXECUTE ELSE ,XT THEN
+; ELSE -- textadr
+; ?NUMBER
+; IF POSTPONE LITERAL converted ok
+; ELSE COUNT TYPE 3F EMIT CR ABORT err
+; THEN
+; THEN
+; REPEAT DROP ;
+ head INTERPRET,9,INTERPRET,docolon
+ DW TICKSOURCE,TWOSTORE,LIT,0,TOIN,STORE
+INTER1: DW BL,WORD,DUP,CFETCH,qbranch,INTER9
+ DW FIND,QDUP,qbranch,INTER4
+ DW ONEPLUS,STATE,FETCH,ZEROEQUAL,OR
+ DW qbranch,INTER2
+ DW EXECUTE,branch,INTER3
+INTER2: DW COMMAXT
+INTER3: DW branch,INTER8
+INTER4: DW QNUMBER,qbranch,INTER5
+ DW LITERAL,branch,INTER6
+INTER5: DW COUNT,TYPE,LIT,3FH,EMIT,CR,ABORT
+INTER6:
+INTER8: DW branch,INTER1
+INTER9: DW DROP,EXIT
+
+;C EVALUATE i*x c-addr u -- j*x interprt string
+; 'SOURCE 2@ >R >R >IN @ >R
+; INTERPRET
+; R> >IN ! R> R> 'SOURCE 2! ;
+ head EVALUATE,8,EVALUATE,docolon
+ DW TICKSOURCE,TWOFETCH,TOR,TOR
+ DW TOIN,FETCH,TOR,INTERPRET
+ DW RFROM,TOIN,STORE,RFROM,RFROM
+ DW TICKSOURCE,TWOSTORE,EXIT
+
+;C QUIT -- R: i*x -- interpret from kbd
+; L0 LP ! R0 RP! 0 STATE !
+; BEGIN
+; TIB DUP TIBSIZE ACCEPT SPACE
+; INTERPRET
+; STATE @ 0= IF CR ." OK" THEN
+; AGAIN ;
+ head QUIT,4,QUIT,docolon
+ DW L0,LP,STORE
+ DW R0,RPSTORE,LIT,0,STATE,STORE
+QUIT1: DW TIB,DUP,TIBSIZE,ACCEPT,SPACE ;CPMACCEPT
+ DW INTERPRET
+ DW STATE,FETCH,ZEROEQUAL,qbranch,QUIT2
+ DW CR,XSQUOTE
+ DB 3,'ok '
+ DW TYPE
+QUIT2: DW branch,QUIT1
+
+;C ABORT i*x -- R: j*x -- clear stk & QUIT
+; S0 SP! QUIT ;
+ head ABORT,5,ABORT,docolon
+ DW S0,SPSTORE,QUIT ; QUIT never returns
+
+;Z ?ABORT f c-addr u -- abort & print msg
+; ROT IF TYPE ABORT THEN 2DROP ;
+ head QABORT,6,?ABORT,docolon
+ DW ROT,qbranch,QABO1,TYPE,ABORT
+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
+ DW SQUOTE
+ DW LIT,QABORT,COMMAXT
+ DW EXIT
+
+;C ' -- xt find word in dictionary
+; BL WORD FIND
+; 0= ABORT" ?" ;
+; head TICK,1,',docolon
+ DW link ; must expand
+ DB 0 ; manually
+link DEFL $ ; because of
+ DB 1,27h ; tick character
+TICK: call docolon
+ DW BL,WORD,FIND,ZEROEQUAL,XSQUOTE
+ DB 1,'?'
+ DW QABORT,EXIT
+
+;C CHAR -- char parse ASCII character
+; BL WORD 1+ C@ ;
+ head CHAR,4,CHAR,docolon
+ DW BL,WORD,ONEPLUS,CFETCH,EXIT
+
+;C [CHAR] -- compile character literal
+; CHAR ['] LIT ,XT , ; IMMEDIATE
+ immed BRACCHAR,6,[CHAR],docolon
+ DW CHAR
+ DW LIT,LIT,COMMAXT
+ DW COMMA,EXIT
+
+;C ( -- skip input until )
+; [ HEX ] 29 WORD DROP ; IMMEDIATE
+ immed PAREN,1,(,docolon
+ DW LIT,29H,WORD,DROP,EXIT
+
+; COMPILER ======================================
+
+;C CREATE -- create an empty definition
+; LATEST @ , 0 C, link & immed field
+; HERE LATEST ! new "latest" link
+; BL WORD C@ 1+ ALLOT name field
+; docreate ,CF code field
+ head CREATE,6,CREATE,docolon
+ DW LATEST,FETCH,COMMA,LIT,0,CCOMMA
+ DW HERE,LATEST,STORE
+ DW BL,WORD,CFETCH,ONEPLUS,ALLOT
+ DW LIT,docreate,COMMACF,EXIT
+
+;Z (DOES>) -- run-time action of DOES>
+; R> adrs of headless DOES> def'n
+; LATEST @ NFA>CFA code field to fix up
+; !CF ;
+ 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
+ DW LIT,XDOES,COMMAXT
+ DW LIT,dodoes,COMMACF,EXIT
+
+;C RECURSE -- recurse current definition
+; LATEST @ NFA>CFA ,XT ; IMMEDIATE
+ immed RECURSE,7,RECURSE,docolon
+ DW LATEST,FETCH,NFATOCFA,COMMAXT,EXIT
+
+;C [ -- enter interpretive state
+; 0 STATE ! ; IMMEDIATE
+ immed LEFTBRACKET,1,[,docolon
+ DW LIT,0,STATE,STORE,EXIT
+
+;C ] -- enter compiling state
+; -1 STATE ! ;
+ head RIGHTBRACKET,1,],docolon
+ DW LIT,-1,STATE,STORE,EXIT
+
+;Z HIDE -- "hide" latest definition
+; LATEST @ DUP C@ 80 OR SWAP C! ;
+ head HIDE,4,HIDE,docolon
+ DW LATEST,FETCH,DUP,CFETCH,LIT,80H,OR
+ DW SWOP,CSTORE,EXIT
+
+;Z REVEAL -- "reveal" latest definition
+; LATEST @ DUP C@ 7F AND SWAP C! ;
+ head REVEAL,6,REVEAL,docolon
+ DW LATEST,FETCH,DUP,CFETCH,LIT,7FH,AND
+ DW SWOP,CSTORE,EXIT
+
+;C IMMEDIATE -- make last def'n immediate
+; 1 LATEST @ 1- C! ; set immediate flag
+ head IMMEDIATE,9,IMMEDIATE,docolon
+ DW LIT,1,LATEST,FETCH,ONEMINUS,CSTORE
+ DW EXIT
+
+;C : -- begin a colon definition
+; CREATE HIDE ] !COLON ;
+ head COLON,1,:,docode
+ CALL docolon ; code fwd ref explicitly
+ DW CREATE,HIDE,RIGHTBRACKET,STORCOLON
+ DW EXIT
+
+;C ;
+; REVEAL ,EXIT
+; POSTPONE [ ; IMMEDIATE
+ immed SEMICOLON,1,';',docolon
+ DW REVEAL,CEXIT
+ DW LEFTBRACKET,EXIT
+
+;C ['] -- find word & compile as literal
+; ' ['] LIT ,XT , ; IMMEDIATE
+; When encountered in a colon definition, the
+; phrase ['] xxx will cause LIT,xxt to be
+; compiled into the colon definition (where
+; (where xxt is the execution token of word xxx).
+; When the colon definition executes, xxt will
+; be put on the stack. (All xt's are one cell.)
+; immed BRACTICK,3,['],docolon
+ DW link ; must expand
+ DB 1 ; manually
+link DEFL $ ; because of
+ DB 3,5Bh,27h,5Dh ; tick character
+BRACTICK: call docolon
+ DW TICK ; get xt of 'xxx'
+ DW LIT,LIT,COMMAXT ; append LIT action
+ DW COMMA,EXIT ; append xt literal
+
+;C POSTPONE -- postpone compile action of word
+; BL WORD FIND
+; DUP 0= ABORT" ?"
+; 0< IF -- xt non immed: add code to current
+; def'n to compile xt later.
+; ['] LIT ,XT , add "LIT,xt,COMMAXT"
+; ['] ,XT ,XT to current definition
+; ELSE ,XT immed: compile into cur. def'n
+; THEN ; IMMEDIATE
+ immed POSTPONE,8,POSTPONE,docolon
+ DW BL,WORD,FIND,DUP,ZEROEQUAL,XSQUOTE
+ DB 1,'?'
+ DW QABORT,ZEROLESS,qbranch,POST1
+ DW LIT,LIT,COMMAXT,COMMA
+ DW LIT,COMMAXT,COMMAXT,branch,POST2
+POST1: DW COMMAXT
+POST2: DW EXIT
+
+;Z COMPILE -- append inline execution token
+; R> DUP CELL+ >R @ ,XT ;
+; The phrase ['] xxx ,XT appears so often that
+; this word was created to combine the actions
+; of LIT and ,XT. It takes an inline literal
+; execution token and appends it to the dict.
+; head COMPILE,7,COMPILE,docolon
+; DW RFROM,DUP,CELLPLUS,TOR
+; DW FETCH,COMMAXT,EXIT
+; N.B.: not used in the current implementation
+
+; CONTROL STRUCTURES ============================
+
+;C IF -- adrs conditional forward branch
+; ['] qbranch ,BRANCH HERE DUP ,DEST ;
+; IMMEDIATE
+ immed IF,2,IF,docolon
+ DW LIT,qbranch,COMMABRANCH
+ DW HERE,DUP,COMMADEST,EXIT
+
+;C THEN adrs -- resolve forward branch
+; HERE SWAP !DEST ; IMMEDIATE
+ immed THEN,4,THEN,docolon
+ DW HERE,SWOP,STOREDEST,EXIT
+
+;C ELSE adrs1 -- adrs2 branch for IF..ELSE
+; ['] branch ,BRANCH HERE DUP ,DEST
+; SWAP POSTPONE THEN ; IMMEDIATE
+ immed ELSE,4,ELSE,docolon
+ DW LIT,branch,COMMABRANCH
+ DW HERE,DUP,COMMADEST
+ DW SWOP,THEN,EXIT
+
+;C BEGIN -- adrs target for bwd. branch
+; HERE ; IMMEDIATE
+ immed BEGIN,5,BEGIN,docode
+ jp HERE
+
+;C UNTIL adrs -- conditional backward branch
+; ['] qbranch ,BRANCH ,DEST ; IMMEDIATE
+; conditional backward branch
+ immed UNTIL,5,UNTIL,docolon
+ DW LIT,qbranch,COMMABRANCH
+ DW COMMADEST,EXIT
+
+;X AGAIN adrs -- uncond'l backward branch
+; ['] branch ,BRANCH ,DEST ; IMMEDIATE
+; unconditional backward branch
+ immed AGAIN,5,AGAIN,docolon
+ DW LIT,branch,COMMABRANCH
+ DW COMMADEST,EXIT
+
+;C WHILE -- adrs branch for WHILE loop
+; POSTPONE IF ; IMMEDIATE
+ immed WHILE,5,WHILE,docode
+ jp IF
+
+;C REPEAT adrs1 adrs2 -- resolve WHILE loop
+; SWAP POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE
+ immed REPEAT,6,REPEAT,docolon
+ DW SWOP,AGAIN,THEN,EXIT
+
+;Z >L x -- L: -- x move to leave stack
+; CELL LP +! LP @ ! ; (L stack grows up)
+ 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
+ DW LP,FETCH,FETCH
+ DW CELL,NEGATE,LP,PLUSSTORE,EXIT
+
+;C DO -- adrs L: -- 0
+; ['] xdo ,XT HERE target for bwd branch
+; 0 >L ; IMMEDIATE marker for LEAVEs
+ immed DO,2,DO,docolon
+ DW LIT,xdo,COMMAXT,HERE
+ DW LIT,0,TOL,EXIT
+
+;Z ENDLOOP adrs xt -- L: 0 a1 a2 .. aN --
+; ,BRANCH ,DEST backward loop
+; BEGIN L> ?DUP WHILE POSTPONE THEN REPEAT ;
+; resolve LEAVEs
+; This is a common factor of LOOP and +LOOP.
+ head ENDLOOP,7,ENDLOOP,docolon
+ DW COMMABRANCH,COMMADEST
+LOOP1: DW LFROM,QDUP,qbranch,LOOP2
+ DW THEN,branch,LOOP1
+LOOP2: DW EXIT
+
+;C LOOP adrs -- L: 0 a1 a2 .. aN --
+; ['] xloop ENDLOOP ; IMMEDIATE
+ immed LOOP,4,LOOP,docolon
+ DW LIT,xloop,ENDLOOP,EXIT
+
+;C +LOOP adrs -- L: 0 a1 a2 .. aN --
+; ['] xplusloop ENDLOOP ; IMMEDIATE
+ immed PLUSLOOP,5,+LOOP,docolon
+ DW LIT,xplusloop,ENDLOOP,EXIT
+
+;C LEAVE -- L: -- adrs
+; ['] UNLOOP ,XT
+; ['] branch ,BRANCH HERE DUP ,DEST >L
+; ; IMMEDIATE unconditional forward branch
+ immed LEAVE,5,LEAVE,docolon
+ DW LIT,unloop,COMMAXT
+ DW LIT,branch,COMMABRANCH
+ DW HERE,DUP,COMMADEST,TOL,EXIT
+
+; OTHER OPERATIONS ==============================
+
+;X WITHIN n1|u1 n2|u2 n3|u3 -- f n2<=n1R - R> U< ; per ANS document
+ head WITHIN,6,WITHIN,docolon
+ DW OVER,MINUS,TOR,MINUS,RFROM,ULESS,EXIT
+
+;C MOVE addr1 addr2 u -- smart move
+; VERSION FOR 1 ADDRESS UNIT = 1 CHAR
+; >R 2DUP SWAP DUP R@ + -- ... dst src src+n
+; WITHIN IF R> CMOVE> src <= dst < src+n
+; ELSE R> CMOVE THEN ; otherwise
+ head MOVE,4,MOVE,docolon
+ DW TOR,TWODUP,SWOP,DUP,RFETCH,PLUS
+ DW WITHIN,qbranch,MOVE1
+ DW RFROM,CMOVEUP,branch,MOVE2
+MOVE1: DW RFROM,CMOVE
+MOVE2: DW EXIT
+
+;C DEPTH -- +n number of items on stack
+; SP@ S0 SWAP - 2/ ; 16-BIT VERSION!
+ head DEPTH,5,DEPTH,docolon
+ DW SPFETCH,S0,SWOP,MINUS,TWOSLASH,EXIT
+
+;C ENVIRONMENT? c-addr u -- false system query
+; -- i*x true
+; 2DROP 0 ; the minimal definition!
+ head ENVIRONMENTQ,12,ENVIRONMENT?,docolon
+ DW TWODROP,LIT,0,EXIT
+
+; UTILITY WORDS AND STARTUP =====================
+
+;X WORDS -- list all words in dict.
+; LATEST @ BEGIN
+; DUP COUNT TYPE SPACE
+; NFA>LFA @
+; DUP 0= UNTIL
+; DROP ;
+ head WORDS,5,WORDS,docolon
+ DW LATEST,FETCH
+WDS1: DW DUP,COUNT,TYPE,SPACE,NFATOLFA,FETCH
+ DW DUP,ZEROEQUAL,qbranch,WDS1
+ DW DROP,EXIT
+
+;X .S -- print stack contents
+; SP@ S0 - IF
+; SP@ S0 2 - DO I @ U. -2 +LOOP
+; THEN ;
+ head DOTS,2,.S,docolon
+ DW SPFETCH,S0,MINUS,qbranch,DOTS2
+ DW SPFETCH,S0,LIT,2,MINUS,XDO
+DOTS1: DW II,FETCH,UDOT,LIT,-2,XPLUSLOOP,DOTS1
+DOTS2: DW EXIT
+
+;Z COLD -- cold start Forth system
+; UINIT U0 #INIT CMOVE init user area
+; 80 COUNT INTERPRET interpret CP/M cmd
+; ." Z80 CamelForth etc."
+; ABORT ;
+ head COLD,4,COLD,docolon
+ DW UINIT,U0,NINIT,CMOVE
+; DW LIT,80h,COUNT,INTERPRET
+ DW XSQUOTE
+ DB 54,'Z80 CamelForth v1.02 25 Jan 1995, ROMWBW 5 Nov 2018'
+ DB 0dh,0ah
+ DW TYPE,ABORT ; ABORT never returns
+
diff --git a/Source/HBIOS/Forth/cameltst.azm b/Source/HBIOS/Forth/cameltst.azm
new file mode 100644
index 00000000..ad480ed2
--- /dev/null
+++ b/Source/HBIOS/Forth/cameltst.azm
@@ -0,0 +1,93 @@
+; Listing 1.
+; ===============================================
+; CamelForth for the Zilog Z80
+; Primitive testing code
+;
+; This is the "minimal" test of the CamelForth
+; kernel. It verifies the threading and nesting
+; mechanisms, the stacks, and the primitives
+; DUP EMIT EXIT lit branch ONEPLUS.
+; It is particularly useful because it does not
+; use the DO..LOOP, multiply, or divide words,
+; and because it can be used on embedded CPUs.
+; The numeric display word .A is also useful
+; for testing the rest of the Core wordset.
+;
+; The required macros and CPU initialization
+; are in file CAMEL80.AZM.
+; ===============================================
+
+;Z >< u1 -- u2 swap the bytes of TOS
+ head SWAB,2,><,docode
+ ld a,b
+ ld b,c
+ ld c,a
+ next
+
+;Z LO c1 -- c2 return low nybble of TOS
+ head LO,2,LO,docode
+ ld a,c
+ and 0fh
+ ld c,a
+ ld b,0
+ next
+
+;Z HI c1 -- c2 return high nybble of TOS
+ head HI,2,HI,docode
+ ld a,c
+ and 0f0h
+ rrca
+ rrca
+ rrca
+ rrca
+ ld c,a
+ ld b,0
+ next
+
+;Z >HEX c1 -- c2 convert nybble to hex char
+ head TOHEX,4,>HEX,docode
+ ld a,c
+ sub 0ah
+ jr c,numeric
+ add a,7
+numeric: add a,3ah
+ ld c,a
+ next
+
+;Z .HH c -- print byte as 2 hex digits
+; DUP HI >HEX EMIT LO >HEX EMIT ;
+ head DOTHH,3,.HH,docolon
+ DW DUP,HI,TOHEX,EMIT,LO,TOHEX,EMIT,EXIT
+
+;Z .B a -- a+1 fetch & print byte, advancing
+; DUP C@ .HH 20 EMIT 1+ ;
+ head DOTB,2,.B,docolon
+ DW DUP,CFETCH,DOTHH,lit,20h,EMIT,ONEPLUS,EXIT
+
+;Z .A u -- print unsigned as 4 hex digits
+; DUP >< .HH .HH 20 EMIT ;
+ head DOTA,2,.A,docolon
+ DW DUP,SWAB,DOTHH,DOTHH,lit,20h,EMIT,EXIT
+
+;X DUMP addr u -- dump u locations at addr
+; 0 DO
+; I 15 AND 0= IF CR DUP .A THEN
+; .B
+; LOOP DROP ;
+ head DUMP,4,DUMP,docolon
+ DW LIT,0,XDO
+DUMP2: DW II,LIT,15,AND,ZEROEQUAL,qbranch,DUMP1
+ DW CR,DUP,DOTA
+DUMP1: DW DOTB,XLOOP,DUMP2,DROP,EXIT
+
+;Z ZQUIT -- endless dump for testing
+; 0 BEGIN 0D EMIT 0A EMIT DUP .A
+; .B .B .B .B .B .B .B .B
+; .B .B .B .B .B .B .B .B
+; AGAIN ;
+ head ZQUIT,5,ZQUIT,docolon
+ DW lit,0
+zquit1: DW lit,0dh,EMIT,lit,0ah,EMIT,DUP,DOTA
+ DW DOTB,DOTB,DOTB,DOTB,DOTB,DOTB,DOTB,DOTB
+ DW DOTB,DOTB,DOTB,DOTB,DOTB,DOTB,DOTB,DOTB
+ DW branch,zquit1
diff --git a/Source/HBIOS/Forth/camldump.azm b/Source/HBIOS/Forth/camldump.azm
new file mode 100644
index 00000000..7be431d5
--- /dev/null
+++ b/Source/HBIOS/Forth/camldump.azm
@@ -0,0 +1,7 @@
+;Z DUMP adr n -- +++TEMP+++
+; 1 UMAX 0 DO .B LOOP DROP ;
+ head DUMP,4,DUMP,docolon
+ DW LIT,1,UMAX,LIT,0,XDO
+DUMP1: DW DOTB,XLOOP,DUMP1
+ DW DROP,EXIT
+
diff --git a/Source/HBIOS/Forth/copying b/Source/HBIOS/Forth/copying
new file mode 100644
index 00000000..94a9ed02
--- /dev/null
+++ b/Source/HBIOS/Forth/copying
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ Copyright (C)
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+.
diff --git a/Source/HBIOS/Forth/glosshi.txt b/Source/HBIOS/Forth/glosshi.txt
new file mode 100644
index 00000000..0c83f8fa
--- /dev/null
+++ b/Source/HBIOS/Forth/glosshi.txt
@@ -0,0 +1,184 @@
+ TABLE 1. GLOSSARY OF "HIGH LEVEL" WORDS
+ (files CAMEL80D.AZM and CAMEL80H.AZM)
+
+NAME stack in -- stack out description
+
+ Guide to stack diagrams: R: = return stack,
+ c = 8-bit character, flag = boolean (0 or -1),
+ n = signed 16-bit, u = unsigned 16-bit,
+ d = signed 32-bit, ud = unsigned 32-bit,
+ +n = unsigned 15-bit, x = any cell value,
+ i*x j*x = any number of cell values,
+ a-addr = aligned adrs, c-addr = character adrs
+ p-addr = I/O port adrs, sys = system-specific.
+ Refer to ANS Forth document for more details.
+
+ ANS Forth Core words
+These are required words whose definitions are
+specified by the ANS Forth document.
+
+# ud1 -- ud2 convert 1 digit of output
+#S ud1 -- ud2 convert remaining digits
+#> ud1 -- c-addr u end conv., get string
+' -- xt find word in dictionary
+( -- skip input until )
+* n1 n2 -- n3 signed multiply
+*/ n1 n2 n3 -- n4 n1*n2/n3
+*/MOD n1 n2 n3 -- n4 n5 n1*n2/n3, rem & quot
++LOOP adrs -- L: 0 a1 a2 .. aN --
+, x -- append cell to dict
+/ n1 n2 -- n3 signed divide
+/MOD n1 n2 -- n3 n4 signed divide, rem & quot
+: -- begin a colon definition
+; end a colon definition
+<# -- begin numeric conversion
+>BODY xt -- a-addr adrs of param field
+>IN -- a-addr holds offset into TIB
+>NUMBER ud adr u -- ud' adr' u'
+ convert string to number
+2DROP x1 x2 -- drop 2 cells
+2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells
+2OVER x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 per diag
+2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 per diagram
+2! x1 x2 a-addr -- store 2 cells
+2@ a-addr -- x1 x2 fetch 2 cells
+ABORT i*x -- R: j*x -- clear stack & QUIT
+ABORT" i*x 0 -- i*x R: j*x -- j*x print msg &
+ i*x x1 -- R: j*x -- abort,x1<>0
+ABS n1 -- +n2 absolute value
+ACCEPT c-addr +n -- +n' get line from terminal
+ALIGN -- align HERE
+ALIGNED addr -- a-addr align given addr
+ALLOT n -- allocate n bytes in dict
+BASE -- a-addr holds conversion radix
+BEGIN -- adrs target for backward branch
+BL -- char an ASCII space
+C, char -- append char to dict
+CELLS n1 -- n2 cells->adrs units
+CELL+ a-addr1 -- a-addr2 add cell size to adrs
+CHAR -- char parse ASCII character
+CHARS n1 -- n2 chars->adrs units
+CHAR+ c-addr1 -- c-addr2 add char size to adrs
+COUNT c-addr1 -- c-addr2 u counted->adr/len
+CR -- output newline
+CREATE -- create an empty definition
+DECIMAL -- set number base to decimal
+DEPTH -- +n number of items on stack
+DO -- adrs L: -- 0 start of DO..LOOP
+DOES> -- change action of latest def'n
+ELSE adrs1 -- adrs2 branch for IF..ELSE
+ENVIRONMENT? c-addr u -- false system query
+EVALUATE i*x c-addr u -- j*x interpret string
+FIND c-addr -- c-addr 0 ..if name not found
+ xt 1 ..if immediate
+ xt -1 ..if "normal"
+FM/MOD d1 n1 -- n2 n3 floored signed division
+HERE -- addr returns dictionary pointer
+HOLD char -- add char to output string
+IF -- adrs conditional forward branch
+IMMEDIATE -- make last def'n immediate
+LEAVE -- L: -- adrs exit DO..LOOP
+LITERAL x -- append numeric literal to dict.
+LOOP adrs -- L: 0 a1 a2 .. aN --
+MAX n1 n2 -- n3 signed maximum
+MIN n1 n2 -- n3 signed minimum
+MOD n1 n2 -- n3 signed remainder
+MOVE addr1 addr2 u -- smart move
+M* n1 n2 -- d signed 16*16->32 multiply
+POSTPONE -- postpone compile action of word
+QUIT -- R: i*x -- interpret from keyboard
+RECURSE -- recurse current definition
+REPEAT adrs1 adrs2 -- resolve WHILE loop
+SIGN n -- add minus sign if n<0
+SM/REM d1 n1 -- n2 n3 symmetric signed division
+SOURCE -- adr n current input buffer
+SPACE -- output a space
+SPACES n -- output n spaces
+STATE -- a-addr holds compiler state
+S" -- compile in-line string
+." -- compile string to print
+S>D n -- d single -> double precision
+THEN adrs -- resolve forward branch
+TYPE c-addr +n -- type line to terminal
+UNTIL adrs -- conditional backward branch
+U. u -- display u unsigned
+. n -- display n signed
+WHILE -- adrs branch for WHILE loop
+WORD char -- c-addr n parse word delim by char
+[ -- enter interpretive state
+[CHAR] -- compile character literal
+['] -- find word & compile as literal
+] -- enter compiling state
+
+ ANS Forth Extensions
+These are optional words whose definitions are
+specified by the ANS Forth document.
+
+.S -- print stack contents
+/STRING a u n -- a+n u-n trim string
+AGAIN adrs -- uncond'l backward branch
+COMPILE, xt -- append execution token
+DABS d1 -- +d2 absolute value, dbl.prec.
+DNEGATE d1 -- d2 negate, double precision
+HEX -- set number base to hex
+PAD -- a-addr user PAD buffer
+TIB -- a-addr Terminal Input Buffer
+WITHIN n1|u1 n2|u2 n3|u3 -- f test n2<=n1) -- run-time action of DOES>
+(S") -- c-addr u run-time code for S"
+,BRANCH xt -- append a branch instruction
+,CF adrs -- append a code field
+,DEST dest -- append a branch address
+,EXIT -- append hi-level EXIT action
+>COUNTED src n dst -- copy to counted str
+>DIGIT n -- c convert to 0..9A..Z
+>L x -- L: -- x move to Leave stack
+?ABORT f c-addr u -- abort & print msg
+?DNEGATE d1 n -- d2 negate d1 if n negative
+?NEGATE n1 n2 -- n3 negate n1 if n2 negative
+?NUMBER c-addr -- n -1 convert string->number
+ -- c-addr 0 if convert error
+?SIGN adr n -- adr' n' f get optional sign
+ advance adr/n if sign; return NZ if negative
+CELL -- n size of one cell
+COLD -- cold start Forth system
+COMPILE -- append inline execution token
+DIGIT? c -- n -1 ..if c is a valid digit
+ -- x 0 ..otherwise
+DP -- a-addr holds dictionary ptr
+ENDLOOP adrs xt -- L: 0 a1 a2 .. aN --
+HIDE -- "hide" latest definition
+HP -- a-addr HOLD pointer
+IMMED? nfa -- f fetch immediate flag
+INTERPRET i*x c-addr u -- j*x
+ interpret given buffer
+L0 -- a-addr bottom of Leave stack
+LATEST -- a-addr last word in dictionary
+LP -- a-addr Leave-stack pointer
+L> -- x L: x -- move from Leave stack
+NFA>CFA nfa -- cfa name adr -> code field
+NFA>LFA nfa -- lfa name adr -> link field
+R0 -- a-addr end of return stack
+REVEAL -- "reveal" latest definition
+S0 -- a-addr end of parameter stack
+TIBSIZE -- n size of TIB
+U0 -- a-addr current user area adrs
+UD* ud1 d2 -- ud3 32*16->32 multiply
+UD/MOD ud1 u2 -- u3 ud4 32/16->32 divide
+UINIT -- addr initial values for user area
+UMAX u1 u2 -- u unsigned maximum
+UMIN u1 u2 -- u unsigned minimum
+
diff --git a/Source/HBIOS/Forth/glosslo.txt b/Source/HBIOS/Forth/glosslo.txt
new file mode 100644
index 00000000..c46a5498
--- /dev/null
+++ b/Source/HBIOS/Forth/glosslo.txt
@@ -0,0 +1,112 @@
+ TABLE 1. GLOSSARY OF WORDS IN CAMEL80.AZM
+ Words which are (usually) written in CODE.
+
+NAME stack in -- stack out description
+
+ Guide to stack diagrams: R: = return stack,
+ c = 8-bit character, flag = boolean (0 or -1),
+ n = signed 16-bit, u = unsigned 16-bit,
+ d = signed 32-bit, ud = unsigned 32-bit,
+ +n = unsigned 15-bit, x = any cell value,
+ i*x j*x = any number of cell values,
+ a-addr = aligned adrs, c-addr = character adrs
+ p-addr = I/O port adrs, sys = system-specific.
+ Refer to ANS Forth document for more details.
+
+ ANS Forth Core words
+These are required words whose definitions are
+specified by the ANS Forth document.
+
+! x a-addr -- store cell in memory
++ n1/u1 n2/u2 -- n3/u3 add n1+n2
++! n/u a-addr -- add cell to memory
+- n1/u1 n2/u2 -- n3/u3 subtract n1-n2
+< n1 n2 -- flag test n1 n1 n2 -- flag test n1>n2, signed
+>R x -- R: -- x push to return stack
+?DUP x -- 0 | x x DUP if nonzero
+@ a-addr -- x fetch cell from memory
+0< n -- flag true if TOS negative
+0= n/u -- flag return true if TOS=0
+1+ n1/u1 -- n2/u2 add 1 to TOS
+1- n1/u1 -- n2/u2 subtract 1 from TOS
+2* x1 -- x2 arithmetic left shift
+2/ x1 -- x2 arithmetic right shift
+AND x1 x2 -- x3 logical AND
+CONSTANT n -- define a Forth constant
+C! c c-addr -- store char in memory
+C@ c-addr -- c fetch char from memory
+DROP x -- drop top of stack
+DUP x -- x x duplicate top of stack
+EMIT c -- output character to console
+EXECUTE i*x xt -- j*x execute Forth word 'xt'
+EXIT -- exit a colon definition
+FILL c-addr u c -- fill memory with char
+I -- n R: sys1 sys2 -- sys1 sys2
+ get the innermost loop index
+INVERT x1 -- x2 bitwise inversion
+J -- n R: 4*sys -- 4*sys
+ get the second loop index
+KEY -- c get character from keyboard
+LSHIFT x1 u -- x2 logical L shift u places
+NEGATE x1 -- x2 two's complement
+OR x1 x2 -- x3 logical OR
+OVER x1 x2 -- x1 x2 x1 per stack diagram
+ROT x1 x2 x3 -- x2 x3 x1 per stack diagram
+RSHIFT x1 u -- x2 logical R shift u places
+R> -- x R: x -- pop from return stack
+R@ -- x R: x -- x fetch from rtn stk
+SWAP x1 x2 -- x2 x1 swap top two items
+UM* u1 u2 -- ud unsigned 16x16->32 mult.
+UM/MOD ud u1 -- u2 u3 unsigned 32/16->16 div.
+UNLOOP -- R: sys1 sys2 -- drop loop parms
+U< u1 u2 -- flag test u1 x1 x2 -- flag test not equal
+BYE i*x -- return to CP/M
+CMOVE c-addr1 c-addr2 u -- move from bottom
+CMOVE> c-addr1 c-addr2 u -- move from top
+KEY? -- flag return true if char waiting
+M+ d1 n -- d2 add single to double
+NIP x1 x2 -- x2 per stack diagram
+TUCK x1 x2 -- x2 x1 x2 per stack diagram
+U> u1 u2 -- flag test u1>u2, unsigned
+
+ Private Extensions
+These are words which are unique to CamelForth.
+Many of these are necessary to implement ANS
+Forth words, but are not specified by the ANS
+document. Others are functions I find useful.
+
+(do) n1|u1 n2|u2 -- R: -- sys1 sys2
+ run-time code for DO
+(loop) R: sys1 sys2 -- | sys1 sys2
+ run-time code for LOOP
+(+loop) n -- R: sys1 sys2 -- | sys1 sys2
+ run-time code for +LOOP
+>< x1 -- x2 swap bytes
+?branch x -- branch if TOS zero
+BDOS DE C -- A call CP/M BDOS
+branch -- branch always
+lit -- x fetch inline literal to stack
+PC! c p-addr -- output char to port
+PC@ p-addr -- c input char from port
+RP! a-addr -- set return stack pointer
+RP@ -- a-addr get return stack pointer
+SCAN c-addr1 u1 c -- c-addr2 u2
+ find matching char
+SKIP c-addr1 u1 c -- c-addr2 u2
+ skip matching chars
+SP! a-addr -- set data stack pointer
+SP@ -- a-addr get data stack pointer
+S= c-addr1 c-addr2 u -- n string compare
+ n<0: s10: s1>s2
+USER n -- define user variable 'n'
+
\ No newline at end of file
diff --git a/Source/HBIOS/Forth/readme.z80 b/Source/HBIOS/Forth/readme.z80
new file mode 100644
index 00000000..a4b64040
--- /dev/null
+++ b/Source/HBIOS/Forth/readme.z80
@@ -0,0 +1,166 @@
+ CAMELFORTH FOR THE Z80 - BETA TEST VERSION - 16 APRIL 1995
+ ==========================================================
+
+This is a BETA TEST version of CamelForth/80, an ANSI Standard Forth for
+the Zilog Z80 microprocessor and the CP/M operating system. This means
+that, although I have tested the bulk of this code for correct
+functioning, and have fixed several bugs, you may discover new bugs.
+I'd appreciate hearing of any such, either
+
+ by Internet: bj@camelforth.com
+
+I'll also answer questions and try to solve problems.
+
+ * * *
+
+As distributed, CamelForth will assemble to run under CP/M 2.x. It
+determines the highest available RAM location from CP/M, and places its
+data areas (stacks, user area, etc.) immediately below that. The
+CamelForth program resides in the bottom of the CP/M program area
+(100h), and any user definitions are added immediately after. CP/M's
+default command buffer at 80h is used for the Terminal Input Buffer.
+
+To start CamelForth under CP/M, type the command
+
+ CAMEL80 ...any Forth commands...
+
+CamelForth will execute the rest of the CP/M command line as a Forth
+statement, and then enter the Forth interpreter. To return to CP/M, use
+the command
+
+ BYE
+
+Note that CamelForth is CASE SENSITIVE, and all Forth words are in UPPER
+CASE.
+
+ MODIFICATION FOR STANDALONE USE
+
+CamelForth can be easily assembled for a standalone or embedded Z80.
+About 6K of PROM and 640 bytes of RAM are used by CamelForth, plus
+whatever additional PROM and RAM is needed by your program. You will
+probably need to provide the Z80 reset vector, e.g.
+
+ org 0
+ jp reset
+
+You must also add any required hardware initialization, and the Forth
+words KEY KEY? and EMIT for your hardware. You should modify the
+'reset' routine to use an equate for end of RAM, e.g.
+
+reset: ld hl,ramend ; end of available memory (EM)
+ dec h ; EM-100h
+ ld sp,hl ; = top of param stack
+ inc h ; EM
+ etc.
+
+If you are putting CamelForth in PROM, but want to have a Forth
+dictionary in RAM (so you can add new definitions), you'll have to
+change the 'enddict' equate (at the end of camel80.azm) to the your
+starting RAM address. Do NOT change the 'lastword' equate.
+
+The Terminal Input Buffer must be moved to a new location in RAM. The
+usual CamelForth usage is 80h bytes below the user area. TIB can be
+redefined as
+
+;X tib -- a-addr Terminal Input Buffer
+; HEX -80 USER TIB below user area
+ head TIB,3,TIB,douser
+ dw -80h
+
+You should also delete the line
+
+ DW LIT,80h,COUNT,INTERPRET
+
+from the routine COLD. This line causes the CP/M command "tail" to be
+executed as a Forth command...inapplicable in a standalone system.
+
+ * * *
+
+This program was written using the Z80MR macro assembler under CP/M.
+Z80MR is a freeware assembler, available from GEnie and several other
+CP/M archives. Assemble the CamelForth source files with the commands
+
+ z80mr camel80
+ load camel80
+
+Z80MR produces an Intel hex file camel80.hex, and LOAD generates the
+file camel80.com. (Note: do NOT use the version of Z80MR that directly
+outputs a .COM file; that version of the assembler has bugs.) For
+embedded applications you probably can skip the LOAD, since most PROM
+programmers, PROM emulators, and debug programs will accept Intel hex
+files.
+
+If you don't have CP/M, you can use the MYZ80 emulator on an IBM PC, or
+you can rewrite the source code for your Z80 macro assembler.
+
+There are TWO WAYS to write embedded programs in CamelForth:
+
+1. If you have CamelForth running on an embedded Z80, you can download
+Forth code directly to CamelForth. This lets you type new words from
+the keyboard, test them as they are defined, and re-define them to make
+changes. Or you can edit an ASCII text file, and use a program such as
+Procomm to send this file over the serial port to your Z80. It can take
+a few seconds to compile each line, so be sure to leave plenty of delay
+after the line. (I'm working on handshaking to improve this.) Also be
+sure that no line exceeds 80 characters.
+
+2. If you you want to burn your program into PROM, you can add your code
+to the file CAMEL80.ASM. (I recommend creating a separate file and
+using the *INCLUDE directive.) This requires you to convert your Forth
+code to assembler code. To show how this is done, every high-level
+Forth word in the file is shown with its equivalent Forth code in a
+comment. Be especially careful with control structures (IF..ELSE..THEN,
+BEGIN..UNTIL, DO..LOOP, and the like), and with the Forth word headers.
+Reassemble CAMEL80.AZM and burn a PROM (or download to a PROM emulator
+or debug monitor), then test. This is a much slower process, and is
+best saved for the final stage when you have a tested & debugged program
+that you want to put in PROM.
+
+Disk I/O is not yet supported under CP/M. However, CamelForth v1.2 will
+accept commands from a CP/M SUBMIT file using the XSUB utility. The
+SUBMIT file should contain the commands
+
+ XSUB
+ CAMEL80
+ ...Forth source code...
+
+This will run CamelForth/80 under XSUB, which will feed the rest of the
+file to CamelForth as terminal input. You can automatically return to
+CP/M by putting the CamelForth BYE command in the file. Then you can
+save the modified CamelForth image with the CP/M command
+
+ SAVE nn CAMELNEW.COM
+
+'nn' is the decimal number of pages occupied by the CamelForth
+dictionary. You can determine this value while in CamelForth with the
+statement
+
+ DECIMAL HERE 0 256 UM/MOD NIP .
+
+Unfortunately, at the moment there's no way to totally automate this as
+part of the SUBMIT file. And I'm reluctant to add SAVE to CamelForth
+when CP/M has a perfectly good SAVE command.
+
+ * * *
+
+--------------------------- LICENSE TERMS ------------------------------
+CamelForth for the Zilog Z80 Copyright 1994,1995 Bradford J. Rodriguez.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program. If not, see .
+
+Commercial inquiries should be directed to the author at
+115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
+or via email to bj@camelforth.com
+------------------------------------------------------------------------
+
diff --git a/Source/HBIOS/imgpad.asm b/Source/HBIOS/imgpad.asm
index 3846a294..8ca47e5d 100644
--- a/Source/HBIOS/imgpad.asm
+++ b/Source/HBIOS/imgpad.asm
@@ -9,4 +9,4 @@ MON_STACK .EQU $
.ECHO SLACK
.ECHO " bytes.\n"
- .END
\ No newline at end of file
+ .END
diff --git a/Source/HBIOS/imgpad0.asm b/Source/HBIOS/imgpad0.asm
index 31ef6b96..e2822918 100644
--- a/Source/HBIOS/imgpad0.asm
+++ b/Source/HBIOS/imgpad0.asm
@@ -1,6 +1,6 @@
#INCLUDE "std.asm"
;
-SLACK .EQU ($8000-BAS_SIZ-TBC_SIZ)
+SLACK .EQU ($8000-BAS_SIZ-TBC_SIZ-FTH_SIZ)
.FILL SLACK,00H
;
MON_STACK .EQU $
diff --git a/Source/HBIOS/romldr.asm b/Source/HBIOS/romldr.asm
index 175bc4fc..04e7c208 100644
--- a/Source/HBIOS/romldr.asm
+++ b/Source/HBIOS/romldr.asm
@@ -7,22 +7,8 @@
;
#INCLUDE "std.asm"
;
-; osimg.bin
-;
-;LDRIMG .EQU $0000 ;SIZE 0A00 > 0000-0A00
-MONIMG .EQU $0A00 ;SIZE 1000 > 0A00-1A00
-CPMIMG .EQU $1A00 ;SIZE 3000 > 1A00-4A00
-ZSYSIMG .EQU $4A00 ;SIZE 3000 > 4A00-7A00
-EGGIMG .EQU $7A00 ;SIZE 0200 > 7A00-7C00
-;
-; osimg1.bin
-;
-BASIMG .EQU $0000 ;SIZE 2000 > 0000-2000
-TBCIMG .EQU $2000 ;SIZE 0900 > 2000-2900
-;
INT_IM1 .EQU $FF00
;
-
.ORG 0
;
;==================================================================================================
@@ -70,7 +56,7 @@ INT_IM1 .EQU $FF00
LD SP,BL_STACK ; SETUP STACK
;
; BANNER
- LD DE,STR_BANNER
+ LD DE,STR_BANNER
CALL WRITESTR
;
@@ -133,250 +119,201 @@ INT_IM1 .EQU $FF00
;________________________________________________________________________________________________________________________________
;
DOBOOTMENU:
-; CALL NEWLINE
- LD DE,STR_BOOTMENU
- CALL WRITESTR
- CALL PRTALL
- CALL PC_COLON
-
+ CALL NEWLINE
+;
#IF (DSKYENABLE)
- LD HL,BOOT ; POINT TO BOOT MESSAGE
- CALL SEGDISPLAY ; DISPLAY MESSAGE
+ LD HL,BOOT ; POINT TO BOOT MESSAGE
+ CALL SEGDISPLAY ; DISPLAY MESSAGE
#ENDIF
-
+;
#IF (BOOTTYPE == BT_AUTO)
- LD BC,100 * BOOT_TIMEOUT
- LD (BL_TIMEOUT),BC
+ LD BC,100 * BOOT_TIMEOUT
+ LD (BL_TIMEOUT),BC
#ENDIF
+;
+ LD B,MENU_N ; DISPLAY ALL ROM MENU ENTRIES
+ LD DE,MENU_S
+ LD HL,MENU_V
+MENU_L: PUSH DE
+WRITE_M:PUSH BC
+ PUSH HL
+ PUSH DE
+ POP HL
+ LD BC,10
+ ADD HL,BC ; HL POINTS TO MENU KEY
+WRITEM1:LD A,(DE)
+ CP '$' ; TEST FOR STRING TERMINATOR
+ JP Z,WRITEM2
+ CP (HL)
+ JR NZ,WRITEM3
+ LD A,'('
+ CALL COUT
+ LD A,(DE)
+ CALL COUT
+ LD A,')'
+WRITEM3:CALL COUT
+ INC DE
+ JR WRITEM1
+WRITEM2:POP HL
+ POP BC
+
+ POP DE
+ EX DE,HL
+ ADD HL,DE
+ EX DE,HL
+ DJNZ MENU_L ; NEXT MENU ITEM
+
+ CALL NEWLINE ; DISPLAY AVAILABLE DRIVES
+ CALL PRTALL
+ CALL PC_COLON
DB_BOOTLOOP:
-;
-; CHECK FOR CONSOLE BOOT KEYPRESS
-;
- CALL CST
- OR A
- JP Z,DB_CONEND
- CALL CINUC
- CP 'B' ; NASCOM BASIC
- JP Z,GOBASIC
- CP 'C' ; CP/M BOOT FROM ROM
- JP Z,GOCPM
- CP 'E' ; CP/M BOOT FROM ROM
- JP Z,GOEASTA
- CP 'M' ; MONITOR
- JP Z,GOMONSER
-; CP 'L' ; LIST DRIVES
-; JP Z,GOLIST
- CP 'T' ; TASTY BASIC
- JP Z,GOTBAS
- CP 'Z' ; ZSYSTEM BOOT FROM ROM
- JP Z,GOZSYS
- CP '0' ; 0-9, DISK DEVICE
- JP C,DB_INVALID
- CP '9' + 1
- JP NC,DB_INVALID
- SUB '0'
- JP GOBOOTDISK
-DB_CONEND:
-;
-; CHECK FOR DSKY BOOT KEYPRESS
-;
+
+ CALL CST ; CHECK CONSOLE INPUT
+ OR A
+ JR NZ,GOTK1
+
#IF (DSKYENABLE)
- CALL KY_STAT ; GET KEY FROM KB INTO A
- OR A
- JP Z,DB_DSKYEND
- CALL KY_GET
- CP KY_GO ; GO = MONITOR
- JP Z,GOMONDSKY
- CP KY_BO ; BO = BOOT ROM
- JP Z,GOCPM
-; CP 0AH ; A-F, DISK BOOT
-; JP C,DB_INVALID
- CP 0FH + 1 ; 0-F, DISK BOOT
-; JP NC,DB_INVALID
-; SUB 0AH
- JP GOBOOTDISK
-; LD HL,BOOT ; POINT TO BOOT MESSAGE
-; LD A,00H ; BLANK OUT SELECTION,IT WAS INVALID
-; LD (HL),A ; STORE IT IN DISPLAY BUFFER
-; CALL SEGDISPLAY ; DISPLAY THE BUFFER
-DB_DSKYEND:
+ CALL KY_STAT ; CHECK DSKY INPUR
+ OR A
+ JR Z,GOTNK
+
+ CALL KY_GET
+ JR MENU_A
#ENDIF
-;
-; IF CONFIGURED, CHECK FOR AUTOBOOT TIMEOUT
-;
+
+GOTNK: ; CHECK AUTOBOOT TIMEOUT
+
#IF (BOOTTYPE == BT_AUTO)
+ LD DE,625 ; DELAY FOR 10MS TO MAKE TIMEOUT CALC EASY
+ CALL VDELAY ; 16US * 625 = 10MS
+ LD BC,(BL_TIMEOUT) ; CHECK/INCREMENT TIMEOUT
+ DEC BC
+ LD (BL_TIMEOUT),BC
+ LD A,B
+ OR C
+ JP NZ,DB_BOOTLOOP
+
+ LD A,BOOT_DEFAULT ; TIMEOUT EXPIRED,
+ JR MENU_A ; PERFORM DEFAULT BOOT ACTION
+#ENDIF
+ JR DB_BOOTLOOP
+
+GOTK1: CALL CINUC
- ; DELAY FOR 10MS TO MAKE TIMEOUT CALC EASY
- LD DE,625 ; 16US * 625 = 10MS
- CALL VDELAY
+MENU_A: LD B,MENU_N
+ LD DE,MENU_S+10-MENU_V
+ LD HL,MENU_V
+MENU_C: EX DE,HL
+ ADD HL,DE
+ CP (HL)
+ EX DE,HL
+ JR Z,MENU_X
+ DJNZ MENU_C ; FALL THRU IF IT DOES NOT MATCH ROM MENU
+
+; CHECK FOR DRIVE EXECUTION
- ; CHECK/INCREMENT TIMEOUT
- LD BC,(BL_TIMEOUT)
- DEC BC
- LD (BL_TIMEOUT),BC
- LD A,B
- OR C
- JP NZ,DB_BOOTLOOP
+ CP '0' ; 0-9, DISK DEVICE
+ JP C,DB_INVALID
+ CP '9' + 1
+ JP NC,DB_INVALID
+ SUB '0'
+ JP GOBOOTDISK
+
+MENU_X: CALL NEWLINE
+ EX DE,HL ; WE HAVE A VALID ROM MENU OPTION
+ INC HL
+ LD E,(HL)
+ INC HL
+ LD D,(HL)
+ EX DE,HL
+ JP (HL) ; JUMP TO THE ROUTINE TO EXECUTE IT
- ; TIMEOUT EXPIRED, PERFORM DEFAULT BOOT ACTION
- LD A,BOOT_DEFAULT
- CP 'B' ; NASCOM BASIC
- JP Z,GOBASIC
- CP 'C' ; CP/M BOOT FROM ROM
- JP Z,GOCPM
- CP 'E' ; CP/M BOOT FROM ROM
- JP Z,GOEASTA
- CP 'M' ; MONITOR
- JP Z,GOMONSER
-; CP 'L' ; LIST DRIVES
-; JP Z,GOLIST
- CP 'T' ; TASTY BASIC
- JP Z,GOTBAS
- CP 'Z' ; ZSYSTEM BOOT FROM ROM
- JP Z,GOZSYS
- CP '0' ; 0-9, DISK DEVICE
- JP C,DB_INVALID
- CP '9' + 1
- JP NC,DB_INVALID
- SUB '0'
- JP GOBOOTDISK
+#DEFINE MENU_L(M1,M2,M3,M4,M5,M6,M7,M8,M9,M10) \
+#DEFCONT \ .DB M1
+#DEFCONT \ .DB M2
+#DEFCONT \ .DW M3
+#DEFCONT \ .DB M4
+#DEFCONT \ .DW M5
+#DEFCONT \ .DW M6
+#DEFCONT \ .DW M7
+#DEFCONT \ .DW M8
+#DEFCONT \ .DB M9
+#DEFCONT \ .DB M10
+;
+; name menu exec source-bank dest-exec source-addr dest-addr img-size dest-bank desc
+; DB DB DW DB DW DW DW DW DB DB
+MENU_S: MENU_L("MONITOR $$", "M", GOROM, BID_BIOSIMG, MON_SERIAL, 0A00h, MON_LOC, MON_SIZ, BID_USR, "Monitor$12345")
+MENU_1: MENU_L("CP/M $ $", "C", GOROM, BID_BIOSIMG, CPM_ENT, 1A00h, CPM_LOC, CPM_SIZ, BID_USR, "CP/M 80 2.2$ ")
+ MENU_L("Z-SYSTEM $", "Z", GOROM, BID_BIOSIMG, CPM_ENT, 4A00h, CPM_LOC, CPM_SIZ, BID_USR, "ZSDOS V1.1 $ ")
+ MENU_L("$ $", "E", GOROM, BID_BIOSIMG, EGG_LOC, 7A00h, EGG_LOC, EGG_SIZ, BID_USR, "Easter Egg $ ")
+ MENU_L("FORTH $ $", "R", GOROMB, BID_OSIMG, FTH_LOC, 0000h, FTH_LOC, FTH_SIZ, BID_USR, "Camel Forth$ ")
+ MENU_L("BASIC $ $", "B", GOROMB, BID_OSIMG, BAS_LOC, 1700h, BAS_LOC, BAS_SIZ, BID_USR, "Nascom BASIC$")
+ MENU_L("T-BASIC $$", "T", GOROMB, BID_OSIMG, TBC_LOC, 3700h, TBC_LOC, TBC_SIZ, BID_USR, "Tasty BASIC$ ")
+
+#IF (DSKYENABLE)
+ MENU_L("DSKY-MON $", "D", GOROM, BID_BIOSIMG, MON_DSKY, 0A00h, MON_LOC, MON_SIZ, BID_USR, DSKY Monitor$")
#ENDIF
+
+MENU_E:
- JP DB_BOOTLOOP
-;
+MENU_V .EQU MENU_1-MENU_S ; LENGTH OF EACH MENU RECORD
+MENU_N .EQU (MENU_E-MENU_S)/MENU_V ; NUMBER OF MENU ITEMS
+ ;
; BOOT OPTION PROCESSING
;
DB_INVALID:
- LD DE,STR_INVALID
- CALL WRITESTR
- JP DOBOOTMENU
-;
-GOBASIC:
- LD DE,STR_BOOTBAS ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
- ; COPY BASIC FROM BASIC FROM OSIMG0 IN ROM BANK TO THIS RAM BANKS
- LD B,BF_SYSSETCPY ; HBIOS FUNC: SETUP BANK COPY
- LD D,BID_USR ; D = DEST BANK = USER BANK
- LD E,BID_OSIMG ; E = SRC BANK = BIOS BANK
- LD HL,BAS_SIZ ; HL = COPY LEN = 1 PAGE = 256 BYTES
- RST 08 ; DO IT
- LD DE,STR_LOADING
- CALL WRITESTR ; WRITE IT TO CONSOLE
- LD B,BF_SYSBNKCPY ; HBIOS FUNC: PERFORM BANK COPY
- LD HL,BASIMG ; COPY FROM
- LD DE,BAS_LOC ; COPY TO
- RST 08 ; DO IT
- LD DE,STR_LAUNCH
- CALL WRITESTR
- LD HL,BAS_LOC
- JP CHAIN
-
-; LD HL,BAS_LOC ; FIRST BANK CODE
-; PUSH HL
-; LD DE,STR_BOOTBAS ; DE POINTS TO MESSAGE
-; CALL WRITESTR ; WRITE IT TO CONSOLE
-; ; COPY IMAGE TO EXEC ADDRESS
-; LD HL,BASIMG ; HL := BASIC IMAGE ADDRESS
-; LD DE,BAS_LOC ; DE := BASIC EXEC ADDRESS
-; LD BC,BAS_SIZ ; BC := BASIC SIZE
-; LDIR ; COPY BASIC CODE TO EXEC ADDRESS
-; POP HL ; RECOVER ENTRY ADDRESS
-; JR CHAIN ; AND CHAIN TO IT
-
-GOEASTA:
+ LD DE,STR_INVALID
+ CALL WRITESTR
+ JP DOBOOTMENU
+;
+GOROM: EX DE,HL
+ INC HL ; HL POINTS TO source-bank
+; LD A,(HL)
+; CP BID_BIOSIMG
+; JP Z,DOBOOTMENU; ONLY CURRENT BANK SUPPORTED
- LD HL,EGG_LOC
- PUSH HL
- LD DE,STR_LAUNCH ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
- ; COPY IMAGE TO EXEC ADDRESS
- LD HL,EGGIMG ; HL := BASIC IMAGE ADDRESS
- LD DE,EGG_LOC ; DE := BASIC EXEC ADDRESS
- LD BC,EGG_SIZ ; BC := BASIC SIZE
- LDIR ; COPY BASIC CODE TO EXEC ADDRESS
- POP HL ; RECOVER ENTRY ADDRESS
- JR CHAIN ; AND CHAIN TO IT
+ LD B,4 ;
+GOROM_1:INC HL
+ LD E,(HL)
+ INC HL
+ LD D,(HL)
+ PUSH DE
+ DJNZ GOROM_1
+
+ POP BC ; SIZE
+ POP DE ; DEST
+ POP HL ; SOURCE
+ LDIR
+ JR CHAIN
+
+GOROMB: EX DE,HL
+ INC HL ; HL POINTS TO source-bank
+; LD A,(HL)
+; CP BID_BIOSIMG
+; JP Z,DOBOOTMENU; ONLY CURRENT BANK SUPPORTED
+
+ LD B,4
+GOROMB1:INC HL
+ LD E,(HL)
+ INC HL
+ LD D,(HL)
+ PUSH DE
+ DJNZ GOROMB1
+
+ POP HL ; SIZE
+ LD B,BF_SYSSETCPY ; HBIOS FUNC: SETUP BANK COPY
+ LD D,BID_USR ; D = DEST BANK = USER BANK
+ LD E,BID_OSIMG ; E = SRC BANK = BIOS BANK
+ RST 08
+
+ POP DE ; DEST
+ POP HL ; SOURCE
+ LD B,BF_SYSBNKCPY ; HBIOS FUNC: PERFORM BANK COPY
+ RST 08 ; DO IT
+
+CHAIN: ; EXPECT EXEC ADDRESS ON TOP OF STACK
-GOTBAS:
- LD DE,STR_BOOTTBC ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
- ; COPY BASIC FROM BASIC FROM OSIMG0 IN ROM BANK TO THIS RAM BANKS
- LD B,BF_SYSSETCPY ; HBIOS FUNC: SETUP BANK COPY
- LD D,BID_USR ; D = DEST BANK = USER BANK
- LD E,BID_OSIMG ; E = SRC BANK = BIOS BANK
- LD HL,TBC_SIZ ; HL = COPY LEN = 1 PAGE = 256 BYTES
- RST 08 ; DO IT
- LD DE,STR_LOADING
- CALL WRITESTR ; WRITE IT TO CONSOLE
- LD B,BF_SYSBNKCPY ; HBIOS FUNC: PERFORM BANK COPY
- LD HL,TBCIMG ; COPY FROM
- LD DE,TBC_LOC ; COPY TO
- RST 08 ; DO IT
- LD DE,STR_LAUNCH
- CALL WRITESTR
- LD HL,TBC_LOC
- JP CHAIN
-
-; LD HL,TBC_LOC ; FIRST BANK CODE
-; PUSH HL
-; LD DE,STR_BOOTTBC ; DE POINTS TO MESSAGE
-; CALL WRITESTR ; WRITE IT TO CONSOLE
-; ; COPY IMAGE TO EXEC ADDRESS
-; LD HL,TBCIMG ; HL := BASIC IMAGE ADDRESS
-; LD DE,TBC_LOC ; DE := BASIC EXEC ADDRESS
-; LD BC,TBC_SIZ ; BC := BASIC SIZE
-; LDIR ; COPY BASIC CODE TO EXEC ADDRESS
-; POP HL ; RECOVER ENTRY ADDRESS
-; JR CHAIN ; AND CHAIN TO IT
-
-GOMONSER:
- LD HL,MON_SERIAL ; MONITOR SERIAL INTERFACE ENTRY ADDRESS TO HL
- JR GOMON ; LOAD AND RUN MONITOR
-;
-GOMONDSKY:
- LD HL,MON_DSKY ; MONITOR DSKY INTERFACE ENTRY ADDRESS TO HL
- JR GOMON ; LOAD AND RUN MONITOR
-;
-GOMON:
- LD DE,STR_BOOTMON ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
-;
- PUSH HL ; SAVE DESIRED MONITOR ENTRY ADDRESS
-;
- ; COPY MONITOR IMAGE TO EXEC ADDRESS
- LD HL,MONIMG ; HL := MONITOR IMAGE ADDRESS
- LD DE,MON_LOC ; DE := MONITOR EXEC ADDRESS
- LD BC,MON_SIZ ; BC := MONITOR SIZE
- LDIR ; COPY MONITOR CODE TO EXEC ADDRESS
-;
- POP HL ; RECOVER ENTRY ADDRESS
- JR CHAIN ; AND CHAIN TO IT
-;
-GOCPM:
- LD DE,STR_BOOTCPM ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
- LD HL,CPMIMG ; SET HL TO CPM IMAGE ADDRESS
- JR GOOS ; LOAD AND RUN OS
-;
-GOZSYS:
- LD DE,STR_BOOTZSYS ; DE POINTS TO MESSAGE
- CALL WRITESTR ; WRITE IT TO CONSOLE
- LD HL,ZSYSIMG ; SET HL TO ZSYS IMAGE ADDRESS
- JR GOOS ; LOAD AND RUN OS
-;
-GOOS:
- ; COPY OS IMAGE TO EXEC ADDRESS
- LD DE,CPM_LOC ; DE := MONITOR EXEC ADDRESS
- LD BC,CPM_SIZ ; BC := MONITOR SIZE
- LDIR ; COPY MONITOR CODE TO EXEC ADDRESS
-;
- LD HL,CPM_ENT
- ;JR CHAIN ; CHAIN TO ENTRY ADDRESS IN USER BANK
-;
-CHAIN:
- PUSH HL ; SAVE ENTRY ADDRESS
-;
#IF (PLATFORM == PLT_UNA)
LD BC,$00FB ; GET LOWER PAGE ID
RST 08 ; DE := LOWER PAGE ID == BOOT ROM PAGE
@@ -403,21 +340,12 @@ CHAIN:
CALL HB_BNKCALL ; AND GO
HALT ; WE SHOULD NEVER RETURN!!!
#ENDIF
-
-;
-GOLIST:
- LD DE,STR_LIST
- CALL WRITESTR
- LD DE,STR_DRVLIST
- CALL WRITESTR
- CALL PRTALL
- JP DOBOOTMENU
;
GOBOOTDISK:
LD (BL_BOOTID),A
LD DE,STR_BOOTDISK
CALL WRITESTR
- JP BOOTDISK
+; JP BOOTDISK
;
; BOOT FROM DISK DRIVE
;
@@ -849,12 +777,7 @@ DEV15 .EQU DEVUNK
;
STR_BOOTDISK .DB "BOOT FROM DISK\r\n$"
STR_BOOTDISK1 .DB "\r\nReading disk information...$"
-STR_BOOTMON .DB "START MONITOR FROM ROM\r\n$"
-STR_BOOTBAS .DB "START BASIC FROM ROM\r\n$"
-STR_BOOTTBC .DB "START TASTYBASIC FROM ROM\r\n$"
-STR_BOOTCPM .DB "BOOT CPM FROM ROM\r\n$"
-STR_BOOTZSYS .DB "BOOT ZSYSTEM FROM ROM\r\n$"
-STR_LIST .DB "LIST DEVICES\r\n$"
+;STR_LIST .DB "LIST DEVICES\r\n$"
STR_INVALID .DB "INVALID SELECTION\r\n$"
STR_SETUP .DB "SYSTEM SETUP\r\n$"
STR_SIG .DB "SIGNATURE=$"
@@ -862,20 +785,15 @@ STR_CPMLOC .DB "LOC=$"
STR_CPMEND .DB "END=$"
STR_CPMENT .DB "ENT=$"
STR_LABEL .DB "LABEL=$"
-STR_DRVLIST .DB "\r\nDisk Devices:\r\n$"
+;STR_DRVLIST .DB "\r\nDisk Devices:\r\n$"
STR_PREFIX .DB "($"
-;STR_PREFIX .DB "\r\n $"
STR_LOADING .DB "\r\nLoading...$"
STR_NODISK .DB "\r\nNo disk!$"
STR_NOBOOT .DB "\r\nDisk not bootable!$"
STR_BOOTERR .DB "\r\nBoot failure!$"
-STR_ITSRAM .DB "\r\n\RAM$"
-STR_LAUNCH .DB "\r\nLaunching ...$"
-;
-STR_BANNER .DB "\r\n", PLATFORM_NAME, " Boot Loader$"
-STR_BOOTMENU .DB "\r\n"
- .DB "\r\nROM Boot: (B)ASIC, (C)PM, (M)onitor, (T)ASTYBASIC, (Z)System.\r\n"
- .DB "Disk Boot: $"
+;STR_LAUNCH .DB "\r\nLaunching ...$"
+STR_BANNER .DB "\r\n", PLATFORM_NAME, " Boot Loader"
+STR_NL .DB "\r\n$"
;
.IF DSKYENABLE
BOOT:
diff --git a/Source/HBIOS/std.asm b/Source/HBIOS/std.asm
index 8b388074..1cd38747 100644
--- a/Source/HBIOS/std.asm
+++ b/Source/HBIOS/std.asm
@@ -382,6 +382,10 @@ EGG_LOC .EQU $0A00 ; EASTER EGG
EGG_SIZ .EQU $0200
EGG_END .EQU EGG_LOC + EGG_SIZ
+FTH_LOC .EQU $0A00 ; CAMEL FORTH
+FTH_SIZ .EQU $1700
+FTH_END .EQU FTH_LOC + FTH_SIZ
+
MON_DSKY .EQU MON_LOC + (0 * 3) ; MONITOR ENTRY (DSKY)
MON_SERIAL .EQU MON_LOC + (1 * 3) ; MONITOR ENTRY (SERIAL PORT)
;
diff --git a/Source/HBIOS/tastybasic.asm b/Source/HBIOS/tastybasic.asm
index 07e3516a..b38b87e2 100644
--- a/Source/HBIOS/tastybasic.asm
+++ b/Source/HBIOS/tastybasic.asm
@@ -1539,7 +1539,7 @@ chkio:
POP HL
POP DE
POP BC
- ret z ; no, return
+ RET Z ; no, return
PUSH BC
PUSH DE
PUSH HL
diff --git a/Tools/cpm/bin/Z80MR.COM b/Tools/cpm/bin/Z80MR.COM
new file mode 100644
index 00000000..0bdda14d
Binary files /dev/null and b/Tools/cpm/bin/Z80MR.COM differ