;	Disassembled by:
;		DASMx object code disassembler
;		(c) Copyright 1996-2003   Conquest Consultants
;		Version 1.40 (Oct 18 2003)
;	File:		forth.pgm
;	Size:		17145 bytes
;	Checksum:	17E2
;	CRC-32:		2DA3FE38
;
;	Date:		Thu Feb 05 16:27:57 2009
;
;	CPU:		Signetics 2650 (2650 family)
;
;	I'll try to reassemble Forth one day.   Richard Rogers, VK7RO, Feb 2009
;	Start by putting in some of the original names.
;	I should add in my "corrections".   The addresses don't matter as they will be repaced by names.
;	Prefix my own comments with R09?
;	Disassembler produces H'nn' for hex and loda,r0 stk+1,r1,- etc
;	replace all with $nn & stk+1,r1- etc
;	Assembler does not understand 2650 paging.   Use:
;	addr1 . . .   for branch address and   addr equ addr1 & $1FFF   for load/store address
;	Assembler is intelligent and dislikes   abs, base, word, width, end, endif, repeat, hi, lo, mod so replace them with
;	abs2, base2, word2, width2, end2, endif2, repeat2, hi2, lo2, mod2
;
;
eq	equ	0
gt	equ	1
lt	equ	2
un	equ	3
cy	equ	$01	;R09 psl carry
ovf	equ	$04	;R09 overflow
wc	equ	$08	;R09 psl with carry
rs	equ	$10	;R09 psl register select
; R09 Dave had A, X, Y, S for regs r0, r1, r2, r3	was he copying a 6502?

CPLDRE	equ	00h ; CPLD MAP register
UARTC	equ	08h	; UART control register ( write )
UARTS	equ	08h	; UART status register ( read )
UARTTX	equ	09h	; UART transmit register ( write )
UARTRX	equ	09h	; UART receive register ( read )

RDRF	equ	1			; if '1' data is ready in the RX register
TDRE	equ 2			; if '1' the TX register is empty

CPLDROM	equ 0		; write to this, first 8K = ROM
CPLDRAM	equ 8		; write to this, first 8K = RAM

;CRLF	equ	$0024
;HXOT	equ	$006A
;WRBL	equ	$0170
;KBIN	equ	$030F
;WCHR	equ	$0396

;
; disk parameters
ssize	equ	$0080
nbuf	equ	$8
sectr	equ	$320
sectl	equ	$640
bmag	equ	$420

;
; memory assignments
mem	equ	$6000
uarea	equ	$5780	;R1982 get put in first and limit?
darea	equ	$5360	;
;-------------------------------------------------------------------------
        org     $1200

;$1200:
;BOOT:	lodi,r0	CPLDRAM
;		wrte,r0 CPLDRE
;		bcta,UN enter

WCHR:
		; Writes the char contained in R3
		lodz R3				; copy R3 in R0
w_loop2	rede,R3	UARTS		; let be sure we can transmit first
		andi,R3	TDRE		; check the transmitter empty bit
		bctr,EQ	w_loop2		; if zero, wait until it gets '1'
							; now we can transmit the byte
		wrte,R0	UARTTX		; send the character
		retc,UN				; unconditional return

HXOT:	; Writes the HEX byte contained in R2
		lodz R2				; copy R2 in R0
		rrr,R0
		rrr,R0
		rrr,R0
		rrr,R0
		andi,R0	0fH			; get the high nibble and mask it
		addi,R0	'0'			; sum this
		comi,R0 58			; is the result < 58 ?
		bctr,LT dig1gd		; if yes we are ok
		addi,R0 7			; otherwise we need 7 more to be "A" "F"
dig1gd	bsta,UN w_loop2		; write the high nibble

		; lower nibble, same story
		lodz R2 			; get R2 again
		andi,R0	0fH			; get the low nibble and mask it
		addi,R0	'0'			; sum this
		comi,R0 58			; is the result < 58 ?
		bctr,LT dig2gd		; if yes we are ok
		addi,R0 7			; otherwise we need 7 more to be "A" "F"
dig2gd	bsta,UN w_loop2		; write the low nibble
		retc,UN				; unconditional return

WRBL:	; writes a blank i.e. 'space' char
		lodi,R3	' '
		bcta,UN	WCHR

CRLF:	; Writes CR LF
		lodi,R3	0dH
		bsta,UN WCHR
		lodi,R3	0aH
		bcta,UN WCHR

KBIN:	; waits for a char from the keyboard, echo it and return in R3
		rede,R3	UARTS		; let's check the UART status
		andi,R3	RDRF		; any char in the RX buffer ?
		bctr,EQ	KBIN		; if not just wait again
		; we have some char
		rede,R3	UARTRX
		bsta,UN WCHR		; echo it
		strz R3				; get it back into R3
		retc,UN				; unconditional return

;-------------------------------------------------------------------------

        org     $2000

;-------------------------------------------------------------------------
;$2000:

;$2000:
;orig    equ 0
orig	equ $2000

;
enter	nop
	bcta,un	cold+2
renter	nop
	bcta,un	warm
;	system info
	dw	4
	dw	0	;monitor
sys1	dw	ntop
sys equ sys1 & $1FFF        ;R09 initial dictionary pointer idic equ ntop
	dw	8	;backspace character
orig2	dw	uarea
orig1   equ orig2   & $1FFF
	dw	$F8	;init tos
	dw	$F8	;init return tos
	dw	tibx
	dw	$1F	;init name field width
	dw	0	;disks
ifence	dw	top	;fence
itop	dw	top
ivocab	dw	alo	;init verb link
;	system stacks
rstk1	ds	$FF,0
rstk    equ rstk1   & $1FFF
rs01	ds	1,0
rs0 equ rs01   & $1FFF
stk1	ds	$FF,0
stk equ stk1   & $1FFF
ss01	ds	1,0
ss0 equ ss01   & $1FFF
;terminal input buffer
tibx	ds	$54,0	;84 bytes
; ******* local byte variables *******
n1	ds	8,0	;scratch variables
n   equ n1   & $1FFF
xsave1	ds	1,0
xsave   equ xsave1   & $1FFF
ysave1	ds	1,0
ysave   equ ysave1   & $1FFF
;system pointers
ip1	ds	2,0
ip  equ ip1   & $1FFF
up1	ds	2,0
up  equ up1   & $1FFF
w1	ds	2,0
w   equ w1   & $1FFF
temp1	ds	2,0
temp    equ temp1   & $1FFF
;
;inc ip by amount in r2		R09 was y
incip	cpsl	cy
	adda,r2	ip+1
	stra,r2	ip+1
	tpsl	cy
	bcfr,eq	inc1
	loda,r0	ip
	addi,r0	1
	stra,r0	ip
inc1	lodi,r2	0
	retc,un
;
; lit
lithd	db	$83,'LI',$D4
	dw	0	;link R09 end of list marker
lit	dw	litp
litp	loda,r0	*ip,r2	;push integer to p stack
	addi,r2	1
	stra,r0	stk,r1-
	loda,r0	*ip,r2
	addi,r2	1
	stra,r0	stk,r1-
	bsta,un	incip
;
next	lodi,r2	0
	bsta,un	trace + orig
	loda,r0	*ip,r2	;get code field address
	addi,r2	1
	stra,r0	w
	loda,r0	*ip,r2
	addi,r2	1
	stra,r0	w+1
	bsta,un	incip
	loda,r0	*w,r2
	addi,r2	1
	stra,r0	temp
	loda,r0	*w,r2
	addi,r2	1
	stra,r0	temp+1
	lodi,r2	0
	bcta,un	*temp1						;INFO: indirect jump
;
; clit byte literal
clithd	db	$84,'CLI',$D4
	dw	lithd
clit	dw	clitp
clitp	eorz	r0			;R09 can't test from keyboard?
	stra,r0	stk,r1-
	loda,r0	*ip,r2
	addi,r2	1
	stra,r0	stk,r1-
	bsta,un	incip
	bcta,un	next
;
; trace routine
xw1	ds	2,0
xw  equ xw1   & $1FFF
np1	ds	2,0
np  equ np1   & $1FFF
trace1	ds	1,$17;77		;R09 equivalent to ppsl rs	;save regs
trace   equ trace1   & $1FFF
	db	rs		;    as need to write to trace	r1=data/parameter stack pointer
	bsta,un	CRLF		;				r2=dunno
	loda,r2	ip	;print ip			 	r3=return stack pointer
	bsta,un	HXOT
	loda,r2	ip+1
	bsta,un	HXOT
	bsta,un	WRBL
	lodi,r2	0	;get next code field pointer
	loda,r0	*ip,r2
	addi,r2	1
	stra,r0	xw
	stra,r0	np
	loda,r0	*ip,r2
	addi,r2	1
	stra,r0	xw+1
	stra,r0	np+1
	bsta,un	prnam
	loda,r2	xw	;print code field address
	bsta,un	HXOT
	loda,r2	xw+1
	bsta,un	HXOT
	bsta,un	WRBL
	cpsl	rs	;write param stack pointer
	lodz	r1
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	bsta,un	WRBL
	cpsl	rs	;R09 added stack contents display
	loda,r0	stk+1,r1
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	cpsl	rs
	loda,r0	stk,r1
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	bsta,un	WRBL
	cpsl	rs	;write return stack pointer
	lodz	r3
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	bsta,un	WRBL
	cpsl	rs	;R09 added return stack contents display
	loda,r0	rstk+1,r3
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	cpsl	rs
	loda,r0	rstk,r3
	ppsl	rs
	strz	r2
	bsta,un	HXOT
	bsta,un	WRBL
tbreak	bsta,un	KBIN	;trace freeze
	comi,r3	$13	;cntrl S	was r3
	bctr,eq	tcont
tbrk	bsta,un	KBIN
	comi,r3	$03	;cntrl C	was r3
	bctr,eq	tcont
	comi,r3	$11	;cntrl Q	was r3
	bcfr,eq	tbrk
	bsta,un	troff
tcont	cpsl	rs	;restore regs r1, r2, r3
	retc,un
;
; trace colon
tcolon1	ds	1,$17;77		;R09 equivalent to  ppsl rs	;save regs
tcolon  equ tcolon1   & $1FFF
	db	rs		;    as need to write to tcolon
	loda,r0	w
	stra,r0	np
	loda,r0	w+1
	stra,r0	np+1
	bsta,un	CRLF
	lodi,r3	':'
	bsta,un	WCHR
	bsta,un	WRBL
	bsta,un	prnam
	bcta,un	tbreak
;
; print name
prnam	bsta,un	decnp
	bsta,un	decnp
	bsta,un	decnp
pn1	bsta,un	decnp
	loda,r0	*np	;find start
	bcfr,lt	pn1
	lodi,r2	0
pn2	loda,r0	*np,r2+
	andi,r0	$7F
	strz	r3
	bsta,un	WCHR
	loda,r0	*np,r2
	bcfr,lt	pn2
	bsta,un	WRBL
	retc,un
;
decnp	ppsl	cy
	loda,r0	np+1
	subi,r0	1
	stra,r0	np+1
	ppsl	wc
	loda,r0	np
	subi,r0	0
	stra,r0	np
	cpsl	wc
	retc,un
;
; pop r0 integers from stack so they can be used as pointers
setup	addz	r0	;times 2
	strz	r2
setup1	loda,r0	stk,r1
	addi,r1	1
	subi,r2	1
	stra,r0	n,r2
	bcfr,eq	setup1
	retc,un
;
; execute
exechd	db	$87,'EXECUT',$C5
	dw	clithd
exec	dw	execp
execp	loda,r0	stk,r1		;lsb
	stra,r0	w+1
	loda,r0	stk+1,r1	;msb
	stra,r0	w
	loda,r0	*w,r2+		;lsb
	stra,r0	temp+1
	loda,r0	*w,r2-		;msb
	stra,r0	temp
	addi,r1	2		;pop address
	bcta,un	*temp1
;
; branch
branhd	db	$86,'BRANC',$C8
	dw	exechd
bran	dw	branp
branp	loda,r0	*ip,r2		;msb rel offset
	stra,r0	rstk,r3-	;save it
	loda,r0	*ip,r2+		;lsb
	cpsl	cy
	adda,r0	ip+1
	stra,r0	ip+1
	loda,r0	rstk,r3
	ppsl	wc
	adda,r0	ip
	cpsl	wc
	stra,r0	ip
	addi,r3	1
	bcta,un	next
;
; 0branch
zbrahd	db	$87,'0BRANC',$C8
	dw	branhd
zbran	dw	zbranp
zbranp	loda,r0	stk,r1		;lsb
	iora,r0	stk,r1+		;msb
	addi,r1	1
	iorz	r0		;cc's	R1982 Dave had lodz,r0
	bcta,eq	branp
	lodi,r2	2		;skip offset
	bsta,un	incip
	bcta,un	next
;
; (loop)
plophd	db	$86,'(LOOP',$A9
	dw	zbrahd
ploop	dw	ploopp
ploopp	loda,r0	rstk,r3
	addi,r0	1		;inc loop counter
	stra,r0	rstk,r3
	bcfr,eq	pl1
	loda,r0	rstk+1,r3
	addi,r0	1
	stra,r0	rstk+1,r3
pl1:	ppsl	wc
	cpsl	cy		;n-i-1
	loda,r0	rstk+2,r3
	suba,r0	rstk,r3
	loda,r0	rstk+3,r3
	suba,r0	rstk+1,r3
	cpsl	wc
pl2:	bcfa,lt	branp
	addi,r3	$04		;pop i,n
	lodi,r2	2		;exit loop
	bsta,un	incip
	bcta,un	next
;
; (+loop)
pplohd	db	$87,'(+LOOP',$A9
	dw	plophd
pploo	dw	pploop
pploop	ppsl	wc
	cpsl	cy
	loda,r0	stk,r1		;i+inc
	adda,r0	rstk,r3
	stra,r0	rstk,r3
	loda,r0	stk+1,r1
	adda,r0	rstk+1,r3
	stra,r0	rstk+1,r3
	cpsl	wc
	loda,r0	stk+1,r1	;get sign of inc
	addi,r1	2		;pop inc
	iorz	r0		;get sign back	R1982 Dave had lodz,r0
	bcfa,lt	pl1		;go & compare i,n
	ppsl	wc
	cpsl	cy
	loda,r0	rstk,r3		;i-n-1
	suba,r0	rstk+2,r3		;R09 result not saved?
	loda,r0	rstk+1,r3
	suba,r0	rstk+3,r3
	cpsl	wc
	bcta,un	pl2
;
; (do)
pdohd	db	$84,'(DO',$A9
	dw	pplohd
pdo	dw	pdop
pdop	loda,r0	stk+3,r1
	stra,r0	rstk,r3-
	loda,r0	stk+2,r1
	stra,r0	rstk,r3-
	loda,r0	stk+1,r1
	stra,r0	rstk,r3-
	loda,r0	stk,r1
	stra,r0	rstk,r3-
	addi,r1	$04
	bcta,un	next
;
; i
ihd	db	$81, $C9
	dw	pdohd
i	dw	rp		;use r's code
;
; digit
dighd	db	$85,'DIGI',$D4
	dw	ihd
digit	dw	digitp
digitp	loda,r0	stk+2,r1	;get char
	subi,r0	$30
	bctr,lt	digit2
	comi,r0	$0A
	bctr,lt	digit1
	subi,r0	$07
	comi,r0	$0A
	bctr,lt	digit2
digit1	coma,r0	stk,r1		;base
	bcfr,lt	digit2
	stra,r0	stk+2,r1	;ret converted char
	addi,r1	2
true	lodi,r0	0
	stra,r0	stk,r1-
	lodi,r0	1
	stra,r0	stk,r1-
	bcta,un	next
digit2	addi,r1	$04		;pop base, char
false	lodi,r0	0
	stra,r0	stk,r1-
	stra,r0	stk,r1-
	bcta,un	next
;
; (find)
pfinhd	db	$86,'(FIND',$A9
	dw	dighd
pfind	dw	pfindp
pfindp	lodi,r0	2
	bsta,un	setup
	stra,r1	xsave
;	n is address of search str.   n+2 is list pointer
pfind1:	lodi,r2	0		;compare lengths
	loda,r0	*n+2,r2
	eora,r0	*n,r2
	andi,r0	$3F
	bcfr,eq	pfind4
pfind2:	addi,r2	1		;compare chars
	loda,r0	*n+2,r2
	eora,r0	*n,r2
	addz	r0
	bcfr,eq	pfind3
	tpsl	cy
	bcfr,eq	pfind2
; found it  prepare to xit
	loda,r1	xsave
	subi,r1	$04		;make return params
	lodz	r2
	addi,r0	$05		;point to pfa
	cpsl	cy
	adda,r0	n+3
	stra,r0	stk+2,r1
	lodi,r2	0
	lodz	r2
	ppsl	wc
	adda,r0	n+2
	cpsl	wc
	stra,r0	stk+3,r1
	eorz	r0		;return length of name
	stra,r0	stk+1,r1
	loda,r0	*n+2,r2		;R1982	Dave had loda,r0 *n,r2
	stra,r0	stk,r1
	bcta,un	true
pfind3:	tpsl	cy		;last char test
	bctr,eq	pfind5
pfind4:	loda,r0	*n+2,r2+	;span over str to link field
	bcfr,lt	pfind4
pfind5:	loda,r0	*n+2,r2+	;next in list
	strz	r1
	loda,r0	*n+2,r2+
	stra,r0	n+3
	stra,r1	n+2
	iora,r0	n+2		;check for end of list
	bcfa,eq	pfind1
	loda,r1	xsave		;not found exit
	cpsl	wc
	bcta,un	false
;
; enclose
enclhd	db	$87,'ENCLOS',$C5
	dw	pfinhd
encl	dw	enclp
enclp:	lodi,r0	2		;pop top 2 integers
	bsta,un	setup
	subi,r1	$08		;make room for addr, n1, n2, n3
	eorz	r0
	stra,r0	stk+3,r1	;zero high byte of n2, n3
	stra,r0	stk+1,r1
	subi,r2	1
encl1:	loda,r0	*n,r2+		;skip any delimiters
	coma,r0	n+3
	bctr,eq	encl1
	lodz	r2
	stra,r0	stk+4,r1	;n1
encl2: 	loda,r0	*n,r2		;skip non delimiters
	bctr,eq	nullex
	addi,r2	1
	coma,r0	n+3		;com to delim
	bcfr,eq	encl2
	lodz	r2
	stra,r0	stk,r1		;n3
	subi,r0	1
	stra,r0	stk+2,r1
	bcta,un	next
nullex:	lodz	r2
	stra,r0	stk+2,r1	;n2	null exit
	stra,r0	stk,r1		;n3
	coma,r0	stk+4,r1	;n1
	bcfr,eq	encl3
	loda,r0	stk+2,r1	;n2=n2+1
	addi,r0	1
	stra,r0	stk+2,r1
encl3:	bcta,un	next
;
; emit
emithd	db	$84,'EMI',$D4
	dw	enclhd
emit	dw	xemit
;
; key
keyhd	db	$83,'KE',$D9
	dw	emithd
key	dw	xkey
;
; ?terminal
qterhd	db	$89,'?TERMINA',$CC
	dw	keyhd
qterm	dw	docol, clit	 ;R1982 Dave had only xqter	temporarily don't look at terminal
	db	$00
	dw	semis
;
; cr
crhd	db	$82,'C',$D2
	dw	qterhd
cr	dw	xcr
;
; cmove
cmovhd	db	$85,'CMOV',$C5
	dw	crhd
cmove	dw	cmovp
cmovp	lodi,r0	$03
	bsta,un	setup
; n holds from, to, count
cmove1:	coma,r2	n+5		;count1=0?
	bcfr,eq	cmove2
	loda,r0	n+4		;dec count msb
	subi,r0	1
	stra,r0	n+4
	bcfr,lt	cmove2
	bcta,un	next
cmove2:	loda,r0	*n,r2
	stra,r0	*n+2,r2
	birr,r2	cmove1
	loda,r0	n		;bump msb's
	addi,r0	1
	stra,r0	n
	loda,r0	n+2
	addi,r0	1
	stra,r0	n+2
	bctr,un	cmove1
;
; u*
ustahd	db	$82,'U',$AA
	dw	cmovhd
ustar	dw	ustarp
ustarp	loda,r0	stk+2,r1
	stra,r0	n
	eorz	r0		;0
	stra,r0	stk+2,r1
	loda,r0	stk+3,r1
	stra,r0	n+1
	eorz	r0
	stra,r0	stk+3,r1
	lodi,r2	$10
ustar1:	loda,r0	stk+2,r1
	addz	r0
	ppsl	wc		;R1982 this was two instr up
	stra,r0	stk+2,r1
	loda,r0	stk+3,r1
	rrl,r0
	stra,r0	stk+3,r1
	loda,r0	stk,r1
	rrl,r0
	stra,r0	stk,r1
	loda,r0	stk+1,r1
	rrl,r0
	stra,r0	stk+1,r1
	tpsl	cy
	bcfr,eq	ustar2
	cpsl	cy
	loda,r0	n
	adda,r0	stk+2,r1
	stra,r0	stk+2,r1
	loda,r0	n+1
	adda,r0	stk+3,r1
	stra,r0	stk+3,r1
	eorz	r0
	adda,r0	stk,r1
	stra,r0	stk,r1
ustar2:	bdrr,r2	ustar1
	cpsl	wc
	bcta,un	next
;
; u/
uslahd	db	$82,'U',$AF
	dw	ustahd
uslas	dw	uslasp
uslasp	loda,r0	stk+4,r1
	strz	r2
	loda,r0	stk+2,r1
	stra,r0	stk+4,r1
	lodz	r2
	addz	r0
	ppsl	wc			;R1982 this was 6 instr up
	stra,r0	stk+2,r1
	loda,r0	stk+5,r1
	strz	r2
	loda,r0	stk+3,r1
	stra,r0	stk+5,r1
	lodz	r2
	rrl,r0
	stra,r0	stk+3,r1
	lodi,r0	$10
	stra,r0	n
uslas1:	loda,r0	stk+4,r1
	rrl,r0
	stra,r0	stk+4,r1
	loda,r0	stk+5,r1
	rrl,r0
	stra,r0	stk+5,r1
	ppsl	cy
	loda,r0	stk+4,r1
	suba,r0	stk,r1
	strz	r2
	loda,r0	stk+5,r1
	suba,r0	stk+1,r1
	tpsl	cy
	bcfr,eq	uslas2
	stra,r0	stk+5,r1
	lodz	r2
	stra,r0	stk+4,r1
uslas2:	loda,r0	stk+2,r1
	rrl,r0
	stra,r0	stk+2,r1
	loda,r0	stk+3,r1
	rrl,r0
	stra,r0	stk+3,r1
	loda,r0	n			;R1982 I changed this section
	bdrr,r0	uslas3			;
	cpsl	wc			;
	addi,r1	2			;
	bcta,un	next			;
uslas3:	stra,r0	n			;
	bcta,un	uslas1			;
;
; and
andhd	db	$83,'AN',$C4
	dw	uslahd
andd	dw	anddp
anddp	loda,r0	stk,r1
	anda,r0	stk+2,r1
	stra,r0	stk+2,r1
	loda,r0	stk+1,r1
	anda,r0	stk+3,r1
	stra,r0	stk+3,r1
	addi,r1	2
	bcta,un	next
;
; or
orhd	db	$82,'O',$D2
	dw	andhd
or	dw	orp
orp	loda,r0	stk,r1
	iora,r0	stk+2,r1
	stra,r0	stk+2,r1
	loda,r0	stk+1,r1
	iora,r0	stk+3,r1
	stra,r0	stk+3,r1
	addi,r1	2
	bcta,un	next
;
; xor
xorhd	db	$83,'XO',$D2
	dw	orhd
xor	dw	xorp
xorp	loda,r0	stk,r1
	eora,r0	stk+2,r1
	stra,r0	stk+2,r1
	loda,r0	stk+1,r1
	eora,r0	stk+3,r1
	stra,r0	stk+3,r1
	addi,r1	2
	bcta,un	next
;
; sp@
spathd	db	$83,'SP',$C0
	dw	xorhd
spat	dw	spatp
;	eorz	r0		;R1982 this changes sp before storing it
;	stra,r0	stk,r1-
;	lodz	r2

spatp	lodz	r1		;so try this
	strz	r2
	eorz	r0
	stra,r0	stk,r1-
	lodz	r2
	stra,r0	stk,r1-
	bcta,un	next
;
; sp!
spsthd	db	$83,'SP',$A1
	dw	spathd
spsto	dw	spstop
spstop	lodi,r2	$07
	loda,r0	*up,r2
	strz	r1
	bcta,un	next
;
; rp!
rpsthd	db	$83,'RP',$A1
	dw	spsthd
rpsto	dw	rpstop
rpstop	lodi,r2	$09
	loda,r0	*up,r2
	strz	r3
	bcta,un	next
;
; ;s
semshd	db	$82,';',$D3
	dw	rpsthd
semis	dw	semip
semip	loda,r0	rstk,r3
	stra,r0	ip+1
	loda,r0	rstk+1,r3
	stra,r0	ip
	addi,r3	2
	bcta,un	next
;
; leave
leavhd	db	$85,'LEAV',$C5
	dw	semshd
leave	dw	leavep
leavep	loda,r0	rstk,r3
	stra,r0	rstk+2,r3
	loda,r0	rstk+1,r3
	stra,r0	rstk+3,r3
	bcta,un	next
;
; >r
torhd	db	$82,'>',$D2
	dw	leavhd
tor	dw	torp
torp	loda,r0	stk+1,r1
	stra,r0	rstk,r3-
	loda,r0	stk,r1
	stra,r0	rstk,r3-
	addi,r1	2
	bcta,un	next
;
; r>
rfrohd	db	$82,'R',$BE
	dw	torhd
rfrom	dw	rfromp
rfromp	loda,r0	rstk+1,r3
	stra,r0	stk,r1-
	loda,r0	rstk,r3
	stra,r0	stk,r1-
	addi,r3	2
	bcta,un	next
;
; r
rhd	db	$81,$D2
	dw	rfrohd
r	dw	rp
rp	loda,r0	rstk+1,r3
	stra,r0	stk,r1-
	loda,r0	rstk,r3
	stra,r0	stk,r1-
	bcta,un	next
;
; 0=
zequhd	db	$82,'0',$BD
	dw	rhd
zequ	dw	zequp
zequp	loda,r0	stk,r1
	iora,r0	stk+1,r1
	addi,r1	2		;R1982 added this line
	iorz	r0
	bcta,eq	true
	bcta,un	false
;
; 0<
zleshd	db	$82,'0',$BC
	dw	zequhd
zless	dw	zlessp
zlessp	loda,r0	stk+1,r1
	addi,r1	2
	iorz	r0
	bcta,lt	true
	bcta,un	false
;
; +
plushd	db	$81,$AB
	dw	zleshd
plus	dw	plusp
plusp	ppsl	wc
	cpsl	cy		;R1982 was ppsl cy
	loda,r0	stk,r1
	adda,r0	stk+2,r1
	stra,r0	stk+2,r1
	loda,r0	stk+1,r1
	adda,r0	stk+3,r1
	stra,r0	stk+3,r1
	cpsl	wc
	addi,r1	2
	bcta,un	next
;
; d+
dpluhd	db	$82,'D',$AB
	dw	plushd
dplus	dw	dplusp
dplusp	ppsl	wc
	cpsl	cy
	loda,r0	stk+2,r1
	adda,r0	stk+6,r1
	stra,r0	stk+6,r1
	loda,r0	stk+3,r1
	adda,r0	stk+7,r1
	stra,r0	stk+7,r1
	loda,r0	stk,r1
	adda,r0	stk+4,r1
	stra,r0	stk+4,r1
	loda,r0	stk+1,r1
	adda,r0	stk+5,r1
	stra,r0	stk+5,r1
	cpsl	wc
	addi,r1	$04
	bcta,un	next
;
; minus
minuhd	db	$85,'MINU',$D3
	dw	dpluhd
minus	dw	minusp
minusp	ppsl	wc
	ppsl	cy
minus1:	eorz	r0
	suba,r0	stk,r1
	stra,r0	stk,r1
	eorz	r0
	suba,r0	stk+1,r1
	stra,r0	stk+1,r1
	cpsl	wc
	bcta,un	next
;
; dminus
dminhd	db	$86,'DMINU',$D3
	dw	minuhd
dminu	dw	dminp
dminp	ppsl	wc
	ppsl	cy
	eorz	r0
	suba,r0	stk+2,r1
	stra,r0	stk+2,r1
	eorz	r0
	suba,r0	stk+3,r1
	stra,r0	stk+3,r1
	bcta,un	minus1
;
; over
overhd	db	$84,'OVE',$D2
	dw	dminhd
over	dw	overp
overp	loda,r0	stk+3,r1
	stra,r0	stk,r1-
	loda,r0	stk+3,r1
	stra,r0	stk,r1-
	bcta,un	next
;
; drop
drophd	db	$84,'DRO',$D0
	dw	overhd
drop	dw	dropp
dropp	addi,r1	2
	bcta,un	next
;
; swap
swaphd	db	$84,'SWA',$D0
	dw	drophd
swap	dw	swapp
swapp	loda,r0	stk+2,r1
	strz	r2
	loda,r0	stk,r1
	stra,r0	stk+2,r1
	lodz	r2
	stra,r0	stk,r1
	loda,r0	stk+3,r1
	strz	r2
	loda,r0	stk+1,r1
	stra,r0	stk+3,r1
	lodz	r2
	stra,r0	stk+1,r1
	bcta,un	next
;
; dup
duphd	db	$83,'DU',$D0
	dw	swaphd
dup	dw	dupp
dupp	loda,r0	stk+1,r1
	stra,r0	stk,r1-
	loda,r0	stk+1,r1
	stra,r0	stk,r1-
	bcta,un	next
;
; +!
pstrhd	db	$82,'+',$A1
	dw	duphd
pstor	dw	pstorp
pstorp	lodi,r0	1
	bsta,un	setup
	ppsl	wc
	cpsl	cy
	loda,r0	*n,r2+		;lsb
	adda,r0	stk,r1
	stra,r0	*n,r2
	loda,r0	*n,r2-		;msb
	adda,r0	stk+1,r1
	stra,r0	*n,r2
	cpsl	wc
	addi,r1	2
	bcta,un	next
;
; toggle
togghd	db	$86,'TOGGL',$C5
	dw	pstrhd
toggl	dw	togglp
togglp	lodi,r0	2
	bsta,un	setup
	loda,r0	*n,r2
	eora,r0	n+3
	stra,r0	*n,r2
	bcta,un	next
; @
athd	db	$81,$C0
	dw	togghd
at	dw	atp
atp	lodi,r0	1
	bsta,un	setup
	loda,r0	*n,r2
	stra,r0	stk,r1-
	loda,r0	*n,r2+
	stra,r0	stk,r1-
	bcta,un	next
;
; c@
cathd	db	$82,'C',$C0
	dw	athd
cat	dw	catp
catp	lodi,r0	1
	bsta,un	setup
	eorz	r0
	stra,r0	stk,r1-
	loda,r0	*n,r2
	stra,r0	stk,r1-
	bcta,un	next
;
; !
storhd	db	$81,$A1
	dw	cathd
store	dw	storep
storep	lodi,r0	2
	bsta,un	setup
	loda,r0	n		;msb
	stra,r0	*n+2,r2
	loda,r0	n+1		;lsb
	stra,r0	*n+2,r2+
	bcta,un	next
;
; c!
cstohd	db	$82,'C',$A1
	dw	storhd
cstor	dw	cstorp
cstorp	lodi,r0	2
	bsta,un	setup
	loda,r0	n+1
	stra,r0	*n+2
	bcta,un	next
;
; :
colohd	db	$C1,$BA
	dw	cstohd
colon	dw	docol, qexec, scsp, curr, at, con, store, create
	dw	rbrac, pscod
docol	loda,r0	ip
	stra,r0	rstk,r3-
	loda,r0	ip+1
	stra,r0	rstk,r3-
	bsta,un	tcolon + orig
	loda,r0	w
	stra,r0	ip
	loda,r0	w+1
	stra,r0	ip+1
	lodi,r2	2
	bsta,un	incip
	bcta,un	next
;
; ;
semihd	db	$C1,$BB
	dw	colohd
semcol	dw	docol, qcsp, comp, semis, smudg, lbrac, semis
;
; constant
conshd	db	$88,'CONSTAN',$D4
	dw	semihd
const	dw	docol, create, smudg, comma, pscod
docon	lodi,r2	2
	loda,r0	*w,r2
	stra,r0	stk,r1-
	loda,r0	*w,r2+
	stra,r0	stk,r1-
	bcta,un	next
;
; variable
varhd	db	$88,'VARIABL',$C5
	dw	conshd
var	dw	docol, const, pscod
dovar	subi,r1	2
	loda,r0	w+1
	addi,r0	2
	stra,r0	stk,r1
	ppsl	wc
	eorz	r0
	adda,r0	w
	cpsl	wc
	stra,r0	stk+1,r1
	bcta,un	next
;
; user
userhd	db	$84,'USE',$D2
	dw	varhd
user	dw	docol, const, pscod
douse	lodi,r2	3			;R1982 was lodi,r2 2
	subi,r1	2
	loda,r0	*w,r2
	adda,r0	up+1
	stra,r0	stk,r1
	eorz	r0
	ppsl	wc
	adda,r0	up
	cpsl	wc
	stra,r0	stk+1,r1
	bcta,un	next
;
; 0
zerohd	db	$81,$B0
	dw	userhd
zero	dw	docon, $0000
;
; 1
onehd	db	$81,$B1
	dw	zerohd
one	dw	docon, $0001
;
; 2
twohd	db	$81,$B2
	dw	onehd
two	dw	docon, $0002
;
; 3
threhd	db	$81,$B3
	dw	twohd
three	dw	docon, $0003
;
; bl
blhd	db	$82,'B',$CC
	dw	threhd
bl	dw	docon, $0020
;
; c/l
csllhd	db	$83,'C/',$CC
	dw	blhd
csll	dw	docon, $0040
;
; first
firshd	db	$85,'FIRS',$D4
	dw	csllhd
first	dw	docon, darea
;
; limit
limihd	db	$85,'LIMI',$D4
	dw	firshd
limit	dw	docon, uarea
;
; b/buf
bbufhd	db	$85,'B/BU',$C6
	dw	limihd
bbuf	dw	docon, ssize
;
; b/scr
bscrhd	db	$85,'B/SC',$D2
	dw	bbufhd
bscr	dw	docon, $0008
;
; +origin
porihd	db	$87,'+ORIGI',$CE
	dw	bscrhd
porig	dw	docol, lit, orig, plus, semis
;
; tib
tibhd	db	$83,'TI',$C2
	dw	porihd
tib	dw	douse, $000A
;
; width
widthd	db	$85,'WIDT',$C8
	dw	tibhd
width2	dw	douse, $000C
;
; warning
warnhd	db	$87,'WARNIN',$C7
	dw	widthd
warn	dw	douse, $000E
;
; fence
fenchd	db	$85,'FENC',$C5
	dw	warnhd
fence	dw	douse, $0010
;
; dp
dphd	db	$82,'D',$D0
	dw	fenchd
dp	dw	douse, $0012
;
; voc-link
voclhd	db	$88,'VOC-LIN',$CB
	dw	dphd
vocl	dw	douse, $0014
;
; blk
blkhd	db	$83,'BL',$CB
	dw	voclhd
blk	dw	douse,	$0016
;
; in
inhd	db	$82,'I',$CE
	dw	blkhd
in	dw	douse, $0018
;
; out
outhd	db	$83,'OU',$D4
	dw	inhd
out	dw	douse, $001A
;
; scr
scrhd	db	$83,'SC',$D2
	dw	outhd
scr	dw	douse, $001C
;
; offset
offshd	db	$86,'OFFSE',$D4			;R1982 was $83?
	dw	scrhd
ofset	dw	douse, $001E
;
; context
conhd	db	$87,'CONTEX',$D4
	dw	offshd
con	dw	douse, $0020
;
; current
currhd	db	$87,'CURREN',$D4
	dw	conhd
curr	dw	douse, $0022
;
; state
stathd	db	$85,'STAT',$C5
	dw	currhd
state	dw	douse, $0024
;
; base
basehd	db	$84,'BAS',$C5
	dw	stathd
base2	dw	douse, $0026
;
; dpl
dplhd	db	$83,'DP',$CC
	dw	basehd
dpl	dw	douse, $0028
;
; fld
fldhd	db	$83,'FL',$C4
	dw	dplhd
fld	dw	douse,	$002A
;
; csp
csphd	db	$83,'CS',$D0
	dw	fldhd
csp	dw	douse, $002C
;
; r#
rnumhd	db	$82,'R',$A3
	dw	csphd
rnum	dw	douse, $002E
;
; hld
hldhd	db	$83,'HL',$C4
	dw	rnumhd
hld	dw	douse, $0030
;
; 1+
onephd	db	$82,'1',$AB
	dw	hldhd
onep	dw	docol, one, plus, semis
;
; 2+
twophd	db	$82,'2',$AB
	dw	onephd
twop	dw	docol, two, plus, semis
;
; here
herehd	db	$84,'HER',$C5
	dw	twophd
here	dw	docol, dp, at, semis
;
; allot
allohd	db	$85,'ALLO',$D4
	dw	herehd
allot	dw	docol, dp, pstor, semis
;
; ,
commhd	db	$81,$AC
	dw	allohd
comma	dw	docol, here, store, two, allot, semis
;
; c,
ccomhd	db	$82,'C',$AC
	dw	commhd
ccomm	dw	docol, here, cstor, one, allot, semis
;
; -
subhd	db	$81,$AD
	dw	ccomhd
sub	dw	docol, minus, plus, semis
;
; =
equahd	db	$81,$BD
	dw	subhd
equal	dw	docol, sub, zequ, semis
;
; u<
uleshd	db	$82,'U',$BC
	dw	equahd
uless	dw	docol, sub, zless, semis
;
; <
lesshd	db	$81,$BC
	dw	uleshd
less	dw	lessp
lessp	ppsl	wc
	ppsl	cy
	loda,r0	stk+2,r1
	suba,r0	stk,r1
	loda,r0	stk+3,r1
	suba,r0	stk+1,r1
	cpsl	wc
	tpsl	ovf
	bcfr,eq	less1		;R09 try this
	addi,r1	4		;R09
	bcta,un	true		;R09
less1	addi,r1	4		;R09
	bcta,un	false
;
;	bcfr,eq	less1		;instead of this
;	eori,r0	$80
;less1:	addi,r1	$04
;	iorz	r0		;R1982 was lodz r0
;	bcfa,lt	false
;	bcta,un	true
;
; >
greahd	db	$81,$BE
	dw	lesshd
great	dw	docol, swap, less, semis
;
; rot
rothd	db	$83,'RO',$D4
	dw	greahd
rot	dw	docol, tor, swap, rfrom, swap, semis
;
; space
spachd	db	$85,'SPAC',$C5
	dw	rothd
space	dw	docol, bl, emit, semis
;
; -dup
dduphd	db	$84,'-DU',$D0
	dw	spachd
ddup	dw	docol, dup, zbran, $0004	;ddup1
	dw	dup
ddup1	dw	semis
;
; traverse
travhd	db	$88,'TRAVERS',$C5
	dw	dduphd
trav	dw	docol, swap
trav1	dw	over, plus, clit
	db	$7F
	dw	over, cat, less, zbran, $FFF1	;trav1
	dw	swap, drop, semis
;
;latest
latehd	db	$86,'LATES',$D4
	dw	travhd
lates	dw	docol, curr, at, at, semis
;
; lfa
lfahd	db	$83,'LF',$C1
	dw	latehd
lfa	dw	docol, clit
	db	$04
	dw	sub, semis
;
; cfa
cfahd	db	$83,'CF',$C1
	dw	lfahd
cfa	dw	docol, two, sub, semis
;
; nfa
nfahd	db	$83,'NF',$C1
	dw	cfahd
nfa	dw	docol, clit
	db	$05
	dw	sub, lit, $FFFF, trav, semis
;
; pfa
pfahd	db	$83,'PF',$C1
	dw	nfahd
pfa	dw	docol, one, trav, clit
	db	$05
	dw	plus, semis
;
; !csp
scslhd	db	$84,'!CS',$D0
	dw	pfahd
scsp	dw	docol, spat, csp, store, semis
;
; ?error
qerrhd	db	$86,'?ERRO',$D2
	dw	scslhd
qerr	dw	docol, swap, zbran, $0008	;qerr1
	dw	error, bran, $0004		;qerr2
qerr1	dw	drop
qerr2	dw	semis
;
; ?comp
qcomhd	db	$85,'?COM',$D0
	dw	qerrhd
qcomp	dw	docol, state, at, zequ, clit
	db	$11
	dw	qerr, semis
;
; ?exec
qexehd	db	$85,'?EXE',$C3
	dw	qcomhd
qexec	dw	docol, state, at, clit
	db	$12
	dw	qerr, semis
;
; ?pairs
qpaihd	db	$86,'?PAIR',$D3
	dw	qexehd
qpair	dw	docol, sub, clit
	db	$13
	dw	qerr, semis
;
; ?csp
qcsphd	db	$84,'?CS',$D0
	dw	qpaihd
qcsp	dw	docol, spat, csp, at, sub, clit
	db	$14
	dw	qerr, semis
;
; ?loading
qloahd	db	$88,'?LOADIN',$C7
	dw	qcsphd
qload	dw	docol, blk, at, zequ, clit
	db	$16
	dw	qerr, semis
;
; compile
comphd	db	$87,'COMPIL',$C5
	dw	qloahd
comp	dw	docol, qcomp, rfrom, dup, twop, tor, at, comma, semis
;
; [
lbrahd	db	$C1,$DB
	dw	comphd
lbrac	dw	docol, zero, state, store, semis
;
; ]
rbrahd	db	$81,$DD
	dw	lbrahd
rbrac	dw	docol, clit
	db	$C0
	dw	state, store, semis
;
; smudge
smudhd	db	$86,'SMUDG',$C5
	dw	rbrahd
smudg	dw	docol, lates, clit
	db	$20
	dw	toggl, semis
;
; hex
hexhd	db	$83,'HE',$D8
	dw	smudhd
hex	dw	docol, clit
	db	$10
	dw	base2, store, semis
;
; decimal
decihd	db	$87,'DECIMA',$CC
	dw	hexhd
decim	dw	docol, clit
	db	$0A
	dw	base2, store, semis
;
; (;code)
pscohd	db	$87,'(;CODE',$A9
	dw	decihd
pscod	dw	docol, rfrom, lates, pfa, cfa, store, semis
;
; ;code
scodhd	db	$C5,';COD',$C5
	dw	pscohd
scod	dw	docol, qcsp, comp, pscod, lbrac, assm, semis
;
; <builds
builhd	db	$87,'<BUILD',$D3
	dw	scodhd
build	dw	docol, zero, const, semis
;
; does>
doeshd	db	$85,'DOES',$BE
	dw	builhd
does	dw	docol, rfrom, lates, pfa, store, pscod
dodoe	loda,r0	ip
	stra,r0	rstk,r3-
	loda,r0	ip+1
	stra,r0	rstk,r3-
	lodi,r2	2
	loda,r0	*w,r2
	stra,r0	ip
	loda,r0	*w,r2+
	stra,r0	ip+1
	subi,r1	2
	loda,r0	w+1
	addi,r0	4
	stra,r0	stk,r1
	loda,r0	w
	ppsl	wc
	addi,r0	0
	cpsl	wc
	stra,r0	stk+1,r1
	bcta,un	next
;
;count
counhd	db	$85,'COUN',$D4
	dw	doeshd
count	dw	docol, dup, onep, swap, cat, semis
;
; type
typehd	db	$84,'TYP',$C5
	dw	counhd
type	dw	docol, ddup, zbran, $001D	;R09 was $0018	;type2
	dw	over, plus, swap, pdo
type1	dw	i, cat, clit			;R1982 clit, $7F, andd added
	db	$7F
	dw	andd, emit, ploop, $FFF3	;type1	R1982	was $FFF8 changed because of above
	dw	bran, $0004			;type3
type2	dw	drop
type3	dw	semis
;
; -trailing
dtrahd	db	$89,'-TRAILIN',$C7
	dw	typehd
dtrai	dw	docol, dup, zero, pdo, over, over, plus
	dw	one, sub, cat, bl, great, zbran, $0008	;dtrai2
	dw	leave, bran, $0006			;dtrai3
dtrai2	dw	one, sub
dtrai3	dw	ploop, $FFE0				;dtrai1
	dw	semis
;
; (.")
pdothd	db	$84,'(."',$A9
	dw	dtrahd
pdotq	dw	docol, r, count, dup, onep, rfrom, plus, tor
	dw	type, semis
;
; ."
dotqhd	db	$81,'.',$A2
	dw	pdothd
dotq	dw	docol, clit
	db	$22
	dw	state, at, zbran, $0014				;dotq1
	dw	comp, pdotq, word2, here, cat, onep, allot
	dw	bran, $000A					;dotq2
dotq1	dw	word2, here, count, type
dotq2	dw	semis			;R09 is this where dotq2 label belongs?
;
; beep
bephd	db	$84,'BEE',$D0
	dw	dotqhd
bep	dw	bepp
bepp	bcta,un	next
;
; traceoff
trofhd	db	$88,'TRACEOF',$C6
	dw	bephd
traoff	dw	traofp
traofp	bsta,un	troff
	bcta,un	next
troff	lodi,r0	$17		;retc,un
	stra,r0	trace
	stra,r0	tcolon
	retc,un
;
; traceon
tronhd	db	$87,'TRACEO',$CE
	dw	trofhd
traon	dw	traonp
traonp	bsta,un	tron
	bcta,un	next
tron	lodi,r0	$77		;ppsl
	stra,r0	trace
	stra,r0	tcolon
	retc,un
;
; tracecolon
tcolhd	db	$8A,'TRACECOLO',$CE
	dw	tronhd
tracol	dw	trcolp
trcolp	bsta,un	trcol
	bcta,un	next
trcol	lodi,r0	$77
	stra,r0	tcolon
	retc,un
;
; query
querhd	db	$85,'QUER',$D9
	dw	tcolhd
query	dw	docol, tib, at, clit
	db	$50
	dw	expect, zero, in, store, semis
;
; fill
fillhd	db	$84,'FIL',$CC
	dw	querhd
fill	dw	docol, swap, tor, over, cstor, dup
	dw	onep, rfrom, one, sub, cmove, semis
;
; erase
erashd	db	$85,'ERAS',$C5
	dw	fillhd
erase	dw	docol, zero, fill, semis
;
; blanks
blanhd	db	$86,'BLANK',$D3
	dw	erashd
blank	dw	docol, bl, fill, semis
;
; hold
holdhd	db	$84,'HOL',$C4
	dw	blanhd
hold	dw	docol, lit, $FFFF, hld, pstor, hld, at, cstor, semis
;
; pad
padhd	db	$83,'PA',$C4
	dw	holdhd
pad	dw	docol, here, clit
	db	$44
	dw	plus, semis
;
; word
wordhd	db		$84,'WOR',$C4
	dw	padhd
word2	dw	docol, blk, at, zbran, $000C			;word21
	dw	blk, at, block, bran, $0006			;word22
word21	dw	tib, at
word22	dw	in, at, plus, swap, encl, here, clit
	db	$22
	dw	blank, in, pstor, over, sub, tor, r, here
	dw	cstor, plus, here, onep, rfrom, cmove, semis
;
; (number)
pnumhd	db	$88,'(NUMBER',$A9
	dw	wordhd
pnumb	dw	docol
pnum1	dw	onep, dup, tor, cat, base2, at, digit, zbran, $002C	;pnum3
	dw	swap, base2, at, ustar, drop, rot, base2, at, ustar
	dw	dplus, dpl, at, onep, zbran, $0008			;pnum2
	dw	one, dpl, pstor
pnum2	dw	rfrom, bran, $FFC6					;pnum1?
pnum3	dw	rfrom
	dw	semis
;
; number
numbhd	db	$86,'NUMBE',$D2
	dw	pnumhd
number	dw	docol, zero, zero, rot, dup, onep, cat, clit
	db	$2D	;R09 "-"
	dw	equal, dup, tor, plus, lit, $FFFF
num1	dw	dpl, store, pnumb, dup, cat, bl, sub, zbran, $0015	;num2
	dw	dup, cat, clit
	db	$2E	;R09 "."
	dw	sub, zero, qerr, zero, bran, $FFDD			;num1
num2	dw	drop, rfrom, zbran, $0004				;num3
	dw	dminu
num3	dw	semis
;
; -find
dfinhd	db	$85,'-FIN',$C4
	dw	numbhd
dfind	dw	docol, bl, word2, here, con, at, at, pfind
	dw	dup, zequ, zbran, $000A					;dfind1
	dw	drop, here, lates, pfind
dfind1	dw	semis
;
; (abort)
pabohd	db	$87,'(ABORT',$A9
	dw	dfinhd
pabor	dw	docol, abort, semis
;
; error
errohd	db	$85,'ERRO',$D2
	dw	pabohd
error	dw	docol, warn, at, zless, zbran, $0004			;error1
	dw	pabor
error1	dw	here, count, type, pdotq
	db	$04,'  ? '
	dw	mess, spsto, drop, drop, in, at, blk, at, quit, semis
;
; id.
iddohd	db	$83,'ID',$AE
	dw	errohd
iddot	dw	docol, pad, clit
	db	$20
	dw	clit
	db	$5F			;R09 this points to start message
	dw	fill, dup, pfa, lfa,  over, sub, pad
	dw	swap, cmove, pad, count, clit
	db	$1F
	dw	andd, type, space, semis
;
; create
creahd	db	$86,'CREAT',$C5
	dw	iddohd
create	dw	docol, tib, here, clit
	db	$A0
	dw	plus, uless, two, qerr, dfind, zbran, $000F		;creat1
	dw	drop, nfa, iddot, clit
	db	$04							;was $0004 but clit needs $04
	dw	mess, space
creat1	dw	here, dup, cat, width2, at, min, onep
	dw	allot, dup, clit
	db	$A0
	dw	toggl, here, one, sub, clit
	db	$80
	dw	toggl, lates, comma, curr, at, store, here, twop, comma, semis
;
; [compile]
bcomhd	db	$C9,'[COMPILE',$DD
	dw	creahd
bcomp	dw	docol, dfind, zequ, zero, qerr, drop, cfa, comma, semis
;
; literal
litehd	db	$C7,'LITERA',$CC
	dw	bcomhd
liter	dw	docol, state, at, zbran, $0008				;liter1
	dw	comp, lit, comma
liter1	dw	semis
;
; dliteral
dlithd	db	$C8,'DLITERA',$CC
	dw	litehd
dlit	dw	docol, state, at, zbran, $0008				;dllit1
	dw	swap, liter, liter
dlit1	dw	semis
;
; ?stack
qstahd	db	$86,'?STAC',$CB
	dw	dlithd
qstac	dw	docol, clit
	db	$F8	;try F8	F6 FA					;R1982 was $50
	dw	spat, uless, one, qerr, spat, clit
	db	$08					;R1982 was $55	R09 ditto
	dw	uless, clit
	db	$07
	dw	qerr, semis
;
; interpret
intehd	db	$89,'INTERPRE',$D4
	dw	qstahd
inter	dw	docol
int1	dw	dfind, zbran, $001E					;int4
	dw	state, at, less, zbran, $000A				;int2
	dw	cfa, comma, bran, $0006					;int3
int2	dw	cfa, exec
int3	dw	qstac, bran, $001C					;int7
int4	dw	here, number, dpl, at, onep, zbran, $0008		;int5
	dw	dlit, bran, $0006					;int6
int5	dw	drop, liter
int6	dw	qstac
int7	dw	bran, $FFC2						;int1
;
; immediate
immehd	db	$89,'IMMEDIAT',$C5
	dw	intehd
immed	dw	docol, lates, clit
	db	$40
	dw	toggl, semis
;
; vocabulary
vocahd	db	$8A,'VOCABULAR',$D9
	dw	immehd
vocab	dw	docol, build, lit, link, comma, curr, at, cfa, comma	;link was $A081 ???
	dw	here, vocl, at, comma, vocl, store, does
dovoc	dw	twop, con, store, semis
;
; forth
forthd	db	$C5,'FORT',$C8
	dw	vocahd
forth	dw	dodoe, dovoc
forth4	dw	link
;
; R09 what's this?
;
xfor1	ds	2,0		;R09 ntop stored here
xfor    equ xfor1   & $1FFF
vlo1	ds	2,0
vlo equ vlo1   & $1FFF
;link1	ds	2,0				;vocab link
;link   equ link1   & $1FFF
link	dw	alo	;expehd		;R09 perhaps this should point to the last forth dictionary entry?
;
; definitions
defihd	db	$8B,'DEFINITION',$D3
	dw	forthd
defin	dw	docol, con, at, curr, store, semis
;
; (
clbrhd	db	$C1,$A8
	dw	defihd
clbrac	dw	docol, clit
	db	$29
	dw	word2, semis
;
; quit
quithd	db	$84,'QUI',$D4
	dw	clbrhd
quit	dw	docol, zero, blk, store, lbrac
quit1	dw	rpsto, cr, query, inter	;, pdotq		;added pdotq etc - never gets here - lost in interpret
;	db	8,'GOT HERE'
	dw	state, at, zequ, zbran, $0007	;quit2
	dw	pdotq
	db	$04
	db	'  OK'
quit2	dw	bran, $FFE7						;quit1
	dw	semis
;
; abort
aborhd	db	$85,'ABOR',$D4
	dw	quithd
abort	dw	docol
aborph	equ	$ / $100
aborpl	equ	$ mod $100
	dw	spsto, decim, dr0, cr, pdotq
	db	$2F
	db	'2650 FORTH  1.0  COPYRIGHT 1981 D. P. HILDYARD '
	dw	forth, defin, quit
;
; cold
coldhd	db	$84,'COL',$C4
	dw	aborhd
cold	dw	coldp
coldp	lodi,r0	$60	;R09 tape o/p high, no interrupts, proc stack zero
	lpsu		;R1982 was spsu
	lodi,r0	$02	;logical compare, rs=0, cy=0
	lpsl		;R1982 was spsl
	loda,r0	sys	;reset ntop
	stra,r0	xfor	;R09 was forth+6
	loda,r0	sys+1
	stra,r0	xfor+1	;R09 was forth+7
	lodi,r2	$15
	bcfr,eq	warm1
warm	lodi,r2	$0F
warm1	loda,r0	orig1	;initial user area
	stra,r0	up
	loda,r0	orig1+1
	stra,r0	up+1
warm2	loda,r0	sys,r2
	stra,r0	*up,r2
	subi,r2	1
	bcfr,lt	warm2
	lodi,r0	aborph	;was $34
	stra,r0	ip
	lodi,r0	aborpl	;was $5F
	stra,r0	ip+1
	bcta,un	rpsto+2
;
; S2	cassette save low level		R09 do I need these?
;
;					    let's skip tape stuff
;
;	org	$3512	;org here to make addresses the same as original for checking
;			remove it because it confuses my simple HEXtoPGM program?
;
; s->d
stodhd	db	$84,'S->',$C4
	dw	coldhd			;skip tape stuff
stod	dw	docol, dup, zless, minus, semis
;
; +-
pmhd	db	$82,'+',$AD
	dw	stodhd
pm	dw	docol, zless, zbran, $0004	;pm1
	dw	minus
pm1	dw	semis
;
; d+-
dpmhd	db	$83,'D+',$AD
	dw	pmhd
dpm	dw	docol, zless, zbran, $0004	;dpm1
	dw	dminu
dpm1	dw	semis
;
; abs
abshd	db	$83,'AB',$D3
	dw	dpmhd
abs2	dw	docol, dup, pm, semis
;
; dabs
dabshd	db	$84,'DAB',$D3
	dw	abshd
dabs	dw	docol, dup, dpm, semis
;
; min
minhd	db	$83,'MI',$CE
	dw	dabshd
min	dw	docol, over, over, great, zbran, $0004	;min1
	dw	swap
min1	dw	drop, semis
;
; max
maxhd	db	$83,'MA',$D8
	dw	minhd
max	dw	docol, over, over, less, zbran, $0004	;max1
	dw	swap
max1	dw	drop, semis
;
; m*
mstahd	db	$82,'M',$AA
	dw	maxhd
mstar	dw	docol, over, over, xor, tor, abs2, swap, abs2, ustar, rfrom, dpm, semis
;
; m/
mslahd	db	$82,'M',$AF
	dw	mstahd
mslas	dw	docol, over, tor, tor, dabs, r, abs2, uslas, rfrom, r, xor, pm, swap, rfrom, pm, swap, semis
;
; *
starhd	db	$81,$AA
	dw	mslahd
star	dw	docol, ustar, drop, semis
;
; /mod
slmohd	db	$84,'/MO',$C4
	dw	starhd
slmod	dw	docol, tor, stod, rfrom, mslas, semis
;
; /
slashd	db	$81,$AF
	dw	slmohd
slash	dw	docol, slmod, swap, drop, semis

;
; mod
modhd	db	$83,'MO',$C4
	dw	slashd
mod2	dw	docol, slmod, drop, semis
;
; */mod
ssmohd	db	$85,'*/MO',$C4
	dw	modhd
ssmod	dw	docol, tor, mstar, rfrom, mslas, semis
;
; */
sslahd	db	$82,'*',$AF
	dw	ssmohd
sslas	dw	docol, ssmod, swap, drop, semis
;
; m/mod
msmohd	db	$85,'M/MO',$C4
	dw	sslahd
msmod	dw	docol, tor, zero, r, uslas, rfrom, swap, tor, uslas, rfrom, semis
;
; use
usehd	db	$83,'US',$C5
	dw	msmohd
use	dw	dovar, darea
;
; prev
prevhd	db	$84,'PRE',$D6
	dw	usehd
prev	dw	dovar, darea
;
; +buf
pbufhd	db	$84,'+BU',$C6
	dw	prevhd
pbuf	dw	docol, lit, ssize+4, plus, dup, limit, equal, zbran, $0006	;pbuf1
	dw	drop, first
ppbuf1	dw	dup, prev, at, sub, semis
;
; update
updahd	db	$86,'UPDAT',$C5
	dw	pbufhd
updat	dw	docol, prev, at, at, lit, $8000			;R09 top of memory?
	dw	or, prev, at, store, semis
;
; empty-buffers
embuhd	db	$8D,'EMPTY-BUFFER',$D3
	dw	updahd
	dw	docol, first, limit, over, sub, erase, semis
;
; dr0
dr0hd	db	$83,'DR',$B0
	dw	embuhd
dr0	dw	docol, zero, ofset, store, semis
;
; dr1
dr1hd	db	$83,'DR',$D1				;needed if disk drive?
	dw	dr0hd
dr1	dw	docol, lit, sectr, ofset, store, semis

; buffer
buffhd	db	$86,'BUFFE',$D2
	dw	dr0hd				;was dr1hd
buffr	dw	docol, use, at, dup, tor
buffr1	dw	pbuf, zbran, $FFFC			;buffr1
	dw	use, store, r, at, zless, zbran, $0014	;buffr2
	dw	r, twop, r, at, lit, $7FFF, andd, zero, rslw, r, store, r, prev, store, rfrom, twop, semis
;
; block
blochd	db	$85,'BLOC',$CB
	dw	buffhd
block	dw	docol, ofset, at, plus, tor, prev, at, dup, at, r
	dw	sub, dup, plus, zbran, $0034			;block3
block1	dw	pbuf, zequ, zbran, $0014			;block2
	dw	drop, r, buffr, dup, r, one, rslw, two, sub
block2	dw	dup, at, r, sub, dup, plus, zequ, zbran, $FFD6	;R1982 block1
	dw	dup, prev, store
block3	dw	rfrom, drop, twop, semis
;
; flush
flushd	db	$85,'FLUS',$C8
	dw	blochd
flush	dw	docol, limit, first, sub, bbuf, clit
	db	$04
	dw	plus, slash, onep, zero, pdo
flush1	dw	lit, $7FFF, buffr, drop, ploop, $FFF6		;flush1
	dw	semis
;
; (line)
plinhd	db	$86,'(LINE',$A9
	dw	flushd
pline	dw	docol, tor, csll, bbuf, ssmod, rfrom, bscr, star
	dw	plus, block, plus, csll, semis
;
; .line
dlinhd	db	$85,'.LIN',$C5
	dw	plinhd
dline	dw	docol, pline, dtrai, type, semis
;
; message
messhd	db	$87,'MESSAG',$C5
	dw	dlinhd
mess	dw	docol, warn, at, zbran, $001B		;mess2	R09 check these comments?
	dw	ddup, zbran, $0011			;mess1
	dw	clit
	db	$01
mess1	dw	ofset, at, bscr, slash, sub, dline
	dw	bran, $000D				;mess3
mess2	dw	pdotq
	db	$06,'MSG # '
	dw	dot
mess3	dw	semis
;
; load
loadhd	db	$84,'LOA',$C4
	dw	messhd
load	dw	docol, blk, at, tor, in, at, tor, zero, in, store, bscr, star
	dw	blk, store, inter, rfrom, in, store, rfrom, blk, store, semis
;
; -->
nscrhd	db	$83,'--',$BE
	dw	loadhd
nscr	dw	docol, qload, zero, in, store, bscr, blk, at, over
	dw	mod2, sub, blk, pstor, semis
;
; -bcd
dbcdhd	db	$84,'-BC',$C4
	dw	nscrhd
dbcd	dw	docol, zero, clit
	db	$0A
	dw	uslas, clit
	db	$10
	dw	star, or, semis
;
; lo
lohd	db	$82,'L',$CF
	dw	dbcdhd
lo2	dw	dovar, $6000		;was $4000
;
; hi
hihd	db	$82,'H',$C9
	dw	lohd
hi2	dw	dovar, $8000		;was $6000
;
; r/w
rslwhd	db	$83,'R/',$D7
	dw	hihd
rslw	dw	docol, tor, dup, clit
	db	$08
	dw	less, clit
	db	$06
	dw	qerr, clit
	db	$08
	dw	sub, bbuf, star, lo2, at, plus, dup, hi2, at
	dw	great, clit
	db	$6
	dw	qerr, rfrom, zbran, $0004		;rslw1
	dw	swap
rslw1	dw	bbuf, cmove, semis
;
; '
tickhd	db	$C1,$A7
	dw	rslwhd
tick	dw	docol, dfind, zequ, zero, qerr, drop, liter, semis
;
; forget
forghd	db	$86,'FORGE',$D4
	dw	tickhd
forg	dw	docol, tick, nfa, dup, fence, at, uless, clit
	db	$15
	dw	qerr, tor, vocl, at
forg1	dw	r, over, uless, zbran, $0012				;forg2
	dw	forth, defin, at,dup, vocl, store, bran, $FFE8		;forg1
forg2	dw	dup, clit
	db	$04
	dw	sub
forg3	dw	pfa, lfa, at, dup, r, uless, zbran, $FFF2		;forg3
	dw	over, two, sub, store, at, ddup, zequ, zbran, $FFD9	;forg2
	dw	rfrom, dp, store, semis
;
; back
backhd	db	$84,'BAC',$CB
	dw	forghd
back	dw	docol, here, sub, comma, semis
;
; begin
begihd	db	$C5,'BEGI',$CE
	dw	backhd
begin	dw	docol, qcomp, here, one, semis
;
; endif
endihd	db	$C5,'ENDI',$C6
	dw	begihd
endif2	dw	docol, qcomp, two, qpair, here, over, sub
	dw	swap, store, semis
;
; then
thenhd	db	$C4,'THE',$CE
	dw	endihd
then	dw	docol, endif2, semis
;
; do
dohd	db	$C2,'D',$CF
	dw	thenhd
do	dw	docol, comp, pdo, here, three, semis
;
; loop
loophd	db	$C4,'LOO',$D0
	dw	dohd
loop	dw	docol, three, qpair, comp, ploop, back, semis
;
; +loop
plslhd	db	$C5,'+LOO',$D0
	dw	loophd
pluspp	dw	docol, three, qpair, comp, pploo, back, semis
;
; until
untihd	db	$C5,'UNTI',$CC
	dw	plslhd
until	dw	docol, one, qpair, comp, zbran, back, semis
;
; end2
endhd	db	$C3,'EN',$C4
	dw	untihd
end2	dw	docol, until, semis
;
; again
agaihd	db	$C5,'AGAI',$CE
	dw	endhd
again	dw	docol, one, qpair, comp, bran, back, semis
;
; repeat
repehd	db	$C6,'REPEA',$D4
	dw	agaihd
repeat2	dw	docol, tor, tor, again, rfrom, rfrom, two
	dw	sub, endif2, semis
;
; if
ifhd	db	$C2,'I',$C6
	dw	repehd
if2	dw	docol, comp, zbran, here, zero, comma, two, semis
;
; else
elsehd	db	$C4,'ELS',$C5
	dw	ifhd
else2	dw	docol, two, qpair, comp, bran, here, zero, comma
	dw	swap, two, endif2, two, semis
;
; while
whihd	db	$C5,'WHIL',$C5
	dw	elsehd
while	dw	docol, if2, twop, semis
;
; spaces
spcshd	db	$86,'SPACE',$D3
	dw	whihd
spacs	dw	docol, zero, max, ddup, zbran, $000C	;spacs2
	dw	zero, pdo
spacs1	dw	space, ploop, $FFFC			;spacs1
spacs2	dw	semis
;
; <#
bdighd	db	$82,'<',$A3
	dw	spcshd
bdigs	dw	docol, pad, hld, store, semis
;
; #>
edighd	db	$82,'#',$BE
	dw	bdighd
edigs	dw	docol, drop, drop, hld, at, pad, over, sub, semis
;
; sign
signhd	db	$84,'SIG',$CE
	dw	edighd
sign	dw	docol, rot, zless, zbran, $0007		;sign1
	dw	clit
	db	$2D
	dw	hold
sign1	dw	semis
;
; #
dghd	db	$81,$A3
	dw	signhd
dig	dw	docol, base2, at, msmod, rot, clit
	db	$09
	dw	over, less, zbran, $0007		;dig1
	dw	clit
	db	$07
	dw	plus
dig1	dw	clit
	db	$30
	dw	plus, hold, semis
;
; #s
digshd	db	$82,'#',$D3
	dw	dghd
digs	dw	docol
digs1	dw	dig, over, over, or, zequ, zbran, $FFF4		;digs1
	dw	semis
;
; d.r
ddtrhd	db	$83,'D.',$D2
	dw	digshd
ddotr	dw	docol, tor, swap, over, dabs, bdigs, digs, sign, edigs, rfrom, over, sub, spacs, type, semis
;
; d.
ddothd	db	$82,'D',$AE
	dw	ddtrhd
ddot	dw	docol, zero, ddotr, space, semis
;
; .r
dotrhd	db	$82,'.',$D2
	dw	ddothd
dotr	dw	docol, tor, stod, rfrom, ddotr, semis
;
; .
dothd	db	$81,$AE
	dw	dotrhd
dot	dw	docol, stod, ddot, semis
;
; ?
queshd	db	$81,$BF
	dw	dothd
ques	dw	docol, at, dot, semis
;
; list
listhd	db	$84,'LIS',$D4
	dw	queshd
list2	dw	docol, decim, cr, dup, scr, store, pdotq
	db	$06,'SCR # '
	dw	dot, clit
	db	$10
	dw	zero, pdo, cr, i, three, dotr, space, i, scr, at, dline, ploop, $FFEC	;list1
	dw	cr, semis
; index
indehd	db	$85,'INDE',$D8
	dw	listhd
index	dw	docol, cr, onep, swap, pdo
index1	dw	cr, i, three, dotr, space, zero, i, dline, qterm, zbran, $0004		;index2
	dw	leave
index2	dw	ploop, $FFE6								;index1
	dw	semis
;
; triad
triahd	db	$85,'TRIA',$C4
	dw	indehd
triad	dw	docol, dup, three, plus, swap, pdo
triad1	dw	cr, i, list2, ploop, $FFF8		;triad1
	dw	cr, clit
	db	$0F
	dw	mess, cr, semis
;
; vlist
vlishd	db	$85,'VLIS',$D4
	dw	triahd
vlist	dw	docol, clit
	db	$80
	dw	out, store, con, at, at
vlist1	dw	out, at, csll, great, zbran, $000A	;vlist2
	dw	cr, zero, out, store
vlist2	dw	dup, iddot, space, space, pfa, lfa, at, dup, zequ, qterm, or, zbran, $FFD4	;vlist1
	dw	drop, semis
;
xemit	loda,r0	stk,r1
	addi,r1	2
	ppsl	rs
	strz	r3			;R1982
	bsta,un	WCHR
	cpsl	rs
	bcta,un	next
;
xkey	redd,r0				;R09 like KBIN, but no echo via WCHR
	tmi,r0	$80
	bctr,eq	xkey
xkey1	redd,r0
	tmi,r0	$80
	bcfr,eq	xkey1
	bsta,un	push0A
	bcta,un	next
;
push0A	subi,r1	2
	stra,r0	stk,r1
	eorz	r0
	stra,r0	stk+1,r1
	retc,un
;
xcr	ppsl	rs
	bsta,un	CRLF
	cpsl	rs
	bcta,un	next
;
xqter	nop
	bcta,un	next
;
; 2dup
tduphd	db	$84,'2DU',$D0
	dw	vlishd
tdup	dw	docol, over, over, semis
;
; expect
expehd	db	$86,'EXPEC',$D4
	dw	tduphd
expect	dw	expecp
expecp	loda,r0	stk,r1		;field length
	stra,r0	xdelp				;R1982 was *xdelp
	loda,r0	stk+3,r1
	stra,r0	bufptr,r2			;R1982 was *bufptr
	loda,r0	stk+2,r1
	stra,r0	bufptr,r2+			;R1982	was *bufptr
	addi,r1	4
	ppsl	rs
	bsta,un	getlin
	cpsl	rs
	bcta,un	next
;
getlin	lodi,r2	0		;R1982
gtlin1	subi,r2	1		;
gtlin2	bsta,un	KBIN		;
	comi,r3	$08		;R09 backspace was 7F (need to step back on screen)
	bctr,eq	gtlin1		;
	lodz	r3		;
	comi,r0	$0D		;R09 = CR?
	bcfr,eq	gtlin3		;
	eorz	r0		;
gtlin3	stra,r0	*bufptr,r2+	;
	iorz	r0		;
	bcfr,eq	gtlin2		;
	retc,un			;
;
xdelp1	ds	1,0
xdelp   equ xdelp1   & $1FFF
bufptr1	ds	2,0
bufptr  equ bufptr1   & $1FFF
;
; x	ascii null			;do I need these?
nullhd	db	$C1, $80
	dw	expehd
null	dw	docol, blk, at, zbran, $002A			;null2
	dw	one, blk, pstor, zero, in, store, blk, at
	dw	zero, bscr, uslas, drop, zequ, zbran,$0008	;null1
	dw	qexec, rfrom, drop
null1	dw	bran, $0006					;null3
null2	dw	rfrom, drop
null3	dw	semis
; put
; scrad
; get
; sget
sgethd	db	$84,'SGE',$D4
	dw	nullhd		;put these in so it assembles
sget	equ	$
; syscold
; syssave
; cload
; editor
edtrhd	db	$C6,'EDITO',$D2
	dw	sgethd
editor	dw	dodoe, dovoc, link, etop	;I put link instead of $A081
elo	dw	vlo		;R09 is this correct?
;
		;stuff above editor which is at $4000 has wrong code?????
; where
; myself
mysehd	db	$C6,'MYSEL',$C6
	dw	edtrhd
;
; assembler vocab
assmhd	db	$C9,'ASSEMBLE',$D2
	dw	mysehd
assm	dw	dodoe, dovoc, link, atop	;I put link instead  of $A081 (also in vocab came from 6502 fig-forth?)
alo	dw	elo
;
; code
ntop	equ	$
codehd	db	$C4,'COD',$C5
	dw	assmhd
code	dw	docol, qexec, scsp, create, assm, semis
;
; text
; line
line	equ	$
; -move
ee	equ	$
; h
; e
; s
; d
; t
; l
; r
; p
; i
; clear
; copy
; edit
edit	equ	$
; fix
etop	equ	$
fixhd	db	$83,'FI',$D8
	dw	codehd				;was edithd
fix	dw	docol, dup, pad, clit
	db	$50
	dw	zero, fill, line, csll, dtrai, pad, swap, cmove
	dw	dup, ee, clit
	db	$3
	dw	dotr, space, pad, csll, edit, rot, line, swap, semis
;
; ;a
atop	equ	$
semahd	db	$C2,';',$C1
	dw	fixhd
semia	dw	docol, qcsp, smudg
top	ds	1,1
;
	end
