Special Feature: ColorForth Commentary

COLOR.ASM: Editor

Original file

NOTICE: This is a work in progress. Parts of my commentary are still very rough. However, I have it up on the web because even in this rough form it may be useful to ColorForth enthusiasts. Expect the contents of these files to change frequently.

Keyboard handling

ColorForth draws a keyboard map in the lower-right corner of the screen, so that the user can see what characters will appear as he types. ColorForth draws the map from one of the following four tables. ColorForth also uses the tables to determine what character to generate when a particular key is pressed.

Any reference to one of these tables is actually a reference to an address four bytes before the table, e.g., "alpha-4", "graphics-4", etc. The reason for this is that the key codes 4 through 27 are used as offsets into these tables.

The byte values in these tables are ColorForth character codes (octal values 0 through 57o).

(Say when each of the four tables is active, e.g., what keys have to be held down or pressed.)

alpha
;[Refs: board, acceptn, alph0, alph]
	db 15o, 12o,  1 , 14o ;   g c r l
	db 24o,  2 ,  6 , 10o ;   h t n s
	db 23o, 11o, 17o, 21o ;   b m w v
	db 22o, 13o, 16o,  7  ;   p y f i
	db  5 ,  3 ,  4 , 26o ;   a o e u
	db 27o, 44o, 25o, 20o ;   q k x d

graphics
;[Refs: star0, graph]
	db 31o, 32o, 33o,  0  ;   1 2 3
	db 34o, 35o, 36o, 30o ;   4 5 6 0
	db 37o, 40o, 41o, 57o ;   7 8 9 ?
	db 51o, 50o, 52o, 54o ;   : ; ! @
	db 46o, 42o, 45o, 56o ;   z j . ,
	db 55o, 47o, 53o, 43o ;   * / + -

numbers
;[Refs: decimal]
	db 31o, 32o, 33o,  0  ;   1 2 3
	db 34o, 35o, 36o, 30o ;   4 5 6 0
	db 37o, 40o, 41o,  0  ;   7 8 9
	db  0,   0 ,  0 ,  0
	db  0,   0 ,  0 ,  0
	db  0,   0 ,  0 ,  0

octals
;[Refs: hex]
	db 31o, 32o, 33o,  0  ;   1 2 3
	db 34o, 35o, 36o, 30o ;   4 5 6 0
	db 37o, 40o, 41o,  0  ;   7 8 9
	db  0 ,  5 , 23o, 12o ;     a b c
	db  0 , 20o,  4 , 16o ;     d e f
	db  0 ,  0 ,  0 ,  0

Letter is passed a ColorForth key code (pulled from keys). If the key pressed is either an undefined key (code=0), the N key (code=1), the spacebar (code=2), or either Alt key (code=3), then letter replaces the key code with [edx+eax] = [board+code]. Otherwise, letter returns the key code unchanged.

letter:
;[Refs: word1, number3]
	cmp	al, 4
	js	@f
	mov	edx, board
	mov	al, [edx][eax]
@@:	ret

Reading the keyboard

The key routine reads Set 1 scan codes from the keyboard controller, subtracts sixteen (20o or 0x10), and uses the result as an offset into the keys table, which contains ColorForth-specific key codes. ColorForth recognizes only Set 1 scan codes in the range 0x10 through 0x39 (20o through 71o in octal), a range containing forty-one keys. In fact, ColorForth recognizes only twenty-seven of these keys.

keys
;[Refs: key]
	db 16, 17, 18, 19,  0,  0,  4,  5 ; 20   ; Keys: QWER--UI
	db  6,  7,  0,  0,  0,  0, 20, 21        ;       OP----AS
	db 22, 23,  0,  0,  8,  9, 10, 11 ; 40   ;       DF--JKL;
	db  0,  0,  0,  0, 24, 25, 26, 27        ;       ----ZXCV
	db  0,  1, 12, 13, 14, 15,  0,  0 ; 60 n ;       -NM<>?--
	db  3,  2 ; alt space                    ;       [Alt] [Space]

There are twenty-eight ColorForth-specific key codes. The blue cells are for keys you press with your right thumb; the green, for keys you press with the four fingers on your right hand; the red, for keys you press with the four fingers on your left hand.

Key codeKey
0Unused key
1N
2Space
3Alt
4U
5I
6O
7P
8J
9K
10L
11;
12M
13<
14>
15?
16Q
17W
18E
19R
20A
21S
22D
23F
24Z
25X
26C
27V

So we can see what characters are produced for each of the four keyboard modes. In alpha mode, the keyboard looks like this (the large character is the one produced by the key; the small character is the one printed on the key; the gray cells indicate keys that don't produce any characters):

p
Q
y
W
f
E
i
R
  
T
  
Y
g
U
c
I
r
O
l
P
a
A
o
S
e
D
u
F
  
G
  
H
h
J
t
K
n
L
s
;
q
Z
k
X
x
C
d
V
  
B
 
N
b
M
m
<
w
>
v
?
 
Alt
 
Space
 
Alt

 

In graphics mode, the keyboard looks like this:

:
Q
;
W
!
E
@
R
  
T
  
Y
1
U
2
I
3
O
  
P
z
A
j
S
.
D
,
F
  
G
  
H
4
J
5
K
6
L
0
;
*
Z
/
X
+
C
-
V
  
B
 
N
7
M
8
<
9
>
?
?
 
Alt
 
Space
 
Alt

 

In numbers mode, the keyboard looks like this:

  
Q
  
W
  
E
  
R
  
T
  
Y
1
U
2
I
3
O
  
P
  
A
  
S
  
D
  
F
  
G
  
H
4
J
5
K
6
L
0
;
  
Z
  
X
  
C
  
V
  
B
 
N
7
M
8
<
9
>
  
?
 
Alt
 
Space
 
Alt

 

In octals mode, the keyboard looks like this:

  
Q
a
W
b
E
c
R
  
T
  
Y
1
U
2
I
3
O
  
P
  
A
d
S
e
D
f
F
  
G
  
H
4
J
5
K
6
L
0
;
  
Z
  
X
  
C
  
V
  
B
 
N
7
M
8
<
9
>
  
?
 
Alt
 
Space
 
Alt

 

Key waits for a key, then returns the key code (a number in the range 0..27). It first calls pause to let the other task run, then checks the key port to see if a key has been pressed. If not, key keeps calling pause and checking the key port until a key is pressed.

If a key is pressed, the scan code must be between 20o (0x10) and 71o (0x39), or else the key is ignored — key calls pause and checks the key port again. If the scan code is acceptable, key uses it to grab the ColorForth key code from the keys table.

key:
;[Refs: accept1, word0, number3, e, pad]
	dup_
	xor	eax, eax
@@:	call	pause
	in	al, 144o
	test	al, 1
	jz	@b
	in	al, 140o
	test	al, 360o     ; If scan code is 0..15,
	jz	@b           ;   ignore it.
	cmp	al, 72o      ; If scan code >= 72o (0x3A = caps lock),
	jnc	@b           ;   ignore it.
	mov	al, [keys-20o+eax]
	ret

-- 6 tables, pointed to by shift -- these deal only with the "shift" keys, 0=undefined key, 1=N, 2=space, 3=alt -- db bytes are probably CF char codes --

align 4
graph0
;[Refs: star0]
	dd offset nul0, offset nul0, offset nul0, offset alph0
	db  0 ,  0 ,  5 , 0 ;	a

graph1
;[Refs: graph]
	dd offset word0, offset x, offset lj, offset alph
	db 25o, 45o,  5 , 0 ; x . a

alpha0
;[Refs: shift, acceptn, alph0, e, eout]
	dd offset nul0, offset nul0, offset number, offset star0
	db  0 , 41o, 55o, 0 ;   9 *

alpha1
;[Refs: alph]
	dd offset word0, offset x, offset lj, offset graph
	db 25o, 45o, 55o, 0 ; x . *

numb0
;[Refs: decimal, hex, octal]
	dd offset nul0, offset minus, offset alphn, offset octal
	db 43o,  5 , 16o, 0 ; - a f

numb1
;[Refs: number2]
	dd offset number0, offset xn, offset endn, offset number0
	db 25o, 45o,  0 , 0 ; x .

-- probably a pointer to four bytes before the characters to print as the keyboard guide in the lower-right corner of the editor screen

board
;[Refs: keyboard, letter, accept1, decimal, hex, graph, e, pad]
	dd offset alpha-4

Shift generally points to one of the following tables: alpha0, alpha1, graph0, graph1, numb0, numb1.

shift
;[Refs: keyboard, acceptn, accept1, word1, decimal, hex, number3, number2,
;       alph0, star0, alph, graph, first, e, pad]
	dd offset alpha0

ColorForth displays numbers in one of two formats — decimal and hexadecimal. Decimal stores 10 here; hex stores 16 here. Therefore routines with "cmp base, 10 : jz base10" fall into handling hexadecimal.

base
;[Refs: decimal, hex, number3, qdot, format, format2]
	dd 10

"current" not changed, always points to decimal

current
;[Refs: octal, number]
	dd offset decimal

current key color?

keyc
;[Refs: keyboard, actn, e, eout]
	dd yellow

chars
;[Refs: word_, word1]
	dd 1

aword
;[Refs: first, act7, actv, eout]
	dd offset ex1

anumber
;[Refs: endn, e, eout]
	dd offset nul

words
;[Refs: ex1, full, x, word_, actv, destack, insert0, insert1, format, format2]
	dd 1

nul0:
;[Refs: graph0, alpha0, numb0, eout]
	drop
	jmp	@f

accept:
;[Refs: start1, abort1, forth2, x, first, actn, eout, insert]
acceptn:
;[Refs: xn, endn]
	mov	shift, offset alpha0
	lea	edi, alpha-4

"Key" returns in AL a number 0..27. If number is 4..27, jump to first -- otherwise convert AL into an offset into whichever of the six tables [each with four DD's] "shift" is pointing to, and jump to the address in the table.

accept1:
;[Refs: star0]
	mov	board, edi
@@:	call	key
	cmp	al, 4
	jns	first
	mov	edx, shift
	jmp	dword ptr [edx+eax*4]

Pre-parsing words

Pack takes a single character (first item on stack), converts it into a pre-parsed-source bit pattern, and adds the bit pattern to a pre-parsed word (second item on stack), assuming that the word isn't full already.

bits
;[Refs: pack, lj0, full, word_]
	db 28

;This is part of the "pack" routine.
@@:	add	eax, 120o
	mov	cl, 7
	jmp	@f

pack:
;[Refs: word1]
	cmp	al, 20o                ; If character is 20o or higher,
	jnc	@b                     ;   go to section above.
	mov	cl, 4                  ; Assume character size of 4 bits.
	test	al, 10o                ; If character is 10o..17o, then
	jz	@f
	inc	ecx                    ;   set character size to 5 bits and
	xor	al, 30o                ;   change character to bitpattern.
@@:	mov	edx, eax               ; (save) ???
	mov	ch, cl                 ; (save) ???
@@:	cmp	bits, cl
	jnc	@f
	shr	al, 1
	jc	full
	dec	cl
	jmp	@b
@@:	shl	dword ptr [esi], cl ;
	xor	[esi], eax
	sub	bits, cl
	ret

lj0:
;"Left-justifies" bits by shifting them left,
;  so that the leftmost bit is in bit 31.
;[Refs: lj, full]
	mov	cl, bits
	add	cl, 4
	shl	dword ptr [esi], cl
	ret

lj:
;[Refs: graph1, alpha1]
	call	lj0
	drop
	ret

full:
;Finish packing a pre-parsed word.
;[Refs: pack]
	call	lj0
	inc	words
	mov	bits, 28
	sub	bits, ch
	mov	eax, edx
	dup_
	ret

x:
;[Refs: graph1, alpha1]
	call	right
	mov	eax, words
	lea	esi, [eax*4+esi]
	drop
	jmp	accept

word_:
;[Refs: first]
	call	right
	mov	words, 1
	mov	chars, 1
	dup_
	mov	dword ptr [esi], 0
	mov	bits, 28

word1:
;[Refs: word0]
	call	letter
	jns	@f
	mov	edx, shift
	jmp	dword ptr [edx+eax*4]
@@:	test	al, al
	jz	word0
	dup_
	call	echo_
	call	pack
	inc	chars

word0:
;[Refs: graph1, alpha1, word1, graph]
	drop
	call	key
	jmp	word1

decimal:
;[Refs: current, octal]
	mov	base, 10
	mov	shift, offset numb0
	mov	board, offset numbers-4
	ret

hex:
;[Refs: octal]
	mov	base, 16
	mov	shift, offset numb0 ; oct0
	mov	board, offset octals-4
	ret

octal:
;[Refs: numb0]
	xor	current, (offset decimal-offset start)<-
		         xor (offset hex-offset start)
	xor	byte ptr numb0+18, 41o xor 16o ; f vs 9
	call	current
	jmp	number0

xn:
;[Refs: numb1]
	drop
	drop
	jmp	acceptn
;	db  0,  0,  0,  0

digit
;[Refs: number3]
	db 14, 10,  0,  0
	db  0,  0, 12,  0,  0,  0, 15,  0
	db 13,  0,  0, 11,  0,  0,  0,  0
	db  0,  1,  2,  3,  4,  5,  6,  7
	db  8,  9

sign
;[Refs: minus, number, number3]
	db 0

minus:
;[Refs: numb0]
	; mov	al, 43o ; -
	mov	sign, al
	jmp	number2

number0:
;[Refs: numb1, octal, number3]
	drop
	jmp	number3

number:
;[Refs: alpha0]
	call	current
	mov	sign, 0
	xor	eax, eax

number3:
;[Refs: number2, number0]
	call	key
	call	letter
	jns	@f
	mov	edx, shift
	jmp	dword ptr [edx+eax*4]
@@:	test	al, al
	jz	number0
	mov	al, [digit-4+eax]
	test	sign, 37o
	jz	@f
	neg	eax
@@:	mov	edx, [esi]
	imul	edx, base
	add	edx, eax
@@:	mov	[esi], edx

number2:
;[Refs: minus]
	drop
	mov	shift, offset numb1
	jmp	number3

endn:
;[Refs: numb1]
	drop
	call	[anumber]
	jmp	acceptn

alphn:
;[Refs: numb0]
	drop

alph0:
;[Refs: graph0]
	mov	shift, offset alpha0
	lea	edi, alpha-4
	jmp	@f

star0:
;[Refs: alph0]
	mov	shift, offset graph0
	lea	edi, graphics-4
@@:	drop
	jmp	accept1

alph:
;[Refs: graph1]
	mov	shift, offset alpha1
	lea	edi, alpha-4
	jmp	@f

graph:
;[Refs: alpha1]
	mov	shift, offset graph1
	lea	edi, graphics-4
@@:	mov	board, edi
	jmp	word0

first:
;[Refs: accept1]
	add	shift, 4*4+4
	call	word_
	call	[aword]
	jmp	accept

Printing numbers

hicon
;Character codes for the sixteen hexadecimal digits.
;[Refs: edig]
	db 30o, 31o, 32o, 33o, 34o, 35o, 36o, 37o ; 01234567
	db 40o, 41o,  5 , 23o, 12o, 20o,  4 , 16o ; 89abcdef

Edig1 ( n -- n ) and edig ( n -- ) emit a hexadecimal digit. The top item on the stack is expected to be a number between 0 and 15, which is used as an offset into the hicon table.

edig1:
;[Refs: d_1, d_2]
	dup_

edig: ;"digit"
;[Refs: forth2, hdot, dot]
	push	ecx
	mov	al, hicon[eax]
	call	emit
	pop	ecx
	ret

Odig ( x -- y n ) converts the next four bits in a 32-bit number into a value between 0 and 15 (suitable for being passed to edig). Note that, immediately after the call to odig, the caller can test the zero flag to see if the value is zero.

odig:
;[Refs: hdot, dot]
	rol	eax, 4
	dup_
	and	eax, 0fh
	ret

??? Print only bottom N hex digits of number ???

hdotn: ;"h.n"
;[Refs: forth2]
	mov	edx, eax
	neg	eax
	lea	ecx, [32+eax*4]
	drop
	rol	eax, cl
	mov	ecx, edx
	jmp	@f

Print 32-bit number onto screen as eight-digit hexadecimal number (pad with leading zeroes if necessary).

hdot: ;"h."
;[Refs: forth2]
	mov	ecx, 8
@@:	call	odig
	call	edig
	next	@b
	drop
	ret

Print 32-bit number onto screen as hexadecimal number without leading zeroes.

dot:
;[Refs: debug, qdot, ref1]
	mov	ecx, 7
@@:	call	odig
	jnz	@h         ; Branch on first nonzero digit.
	drop	           ; Drop leading zero.
	next	@b
	inc	ecx        ; If number = 0, digit count = 1 (print "0").

@@:	call	odig       ; Get next hexadecimal digit.
@h1:	call	edig       ; Output digit.
	next	@b         ; Continue until there are no more digits.
	call	space
	drop
	ret

@h:	inc	ecx        ; (Go from handling leading zeroes
	jmp	@h1        ;   to handling nonzero digits.)

Print 32-bit number onto screen without leading zeroes — as a decimal or a hexadecimal number, depending on the current base.

qdot:
;[Refs: stack]
	cmp	base, 10
	jnz	dot

dot10: ;"."
;(?)Prints a decimal number.
;[Refs: forth2, gnw1, nw1, ref1, bas]
	mov	edx, eax
	test	edx, edx
	jns	@f
	neg	edx          ; Negate number.
	dup_
	mov	eax, 43o     ; Print minus sign.
	call	emit
@@:	mov	ecx, 8
@@:	mov	eax, edx
	xor	edx, edx
	div	tens[ecx*4] ; NASM "div [tens+ecx*4]
	test	eax, eax
	jnz	d_1
	dec	ecx
	jns	@b
	jmp	d_2
@@:	mov	eax, edx
	xor	edx, edx
	div	tens[ecx*4] ; NASM "div [tens+ecx*4]

d_1:
;[Refs: dot10]
	call	edig1
	dec	ecx
	jns	@b

d_2:
;[Refs: dot10]
	mov	eax, edx
	call	edig1
	call	space ; spcr
	drop
	ret

Display routines

unpack

You push a "word" (a 32-bit cell of pre-parsed source code) onto the stack before calling unpack. Unpack removes the first character from this word (e.g., "pack" becomes "ack") but leaves the word on the stack. Unpack then pushes the removed character onto the stack.

unpack: ; ( w -- w c )
;[Refs: forth2, cap, caps, type2]
	dup_
	test	eax, eax            ; Four-bit character begins with 0.
	js	@f                  ; Branch if character begins with 1.
	shl	dword ptr [esi], 4  ; Remove 4-bit character from word.
	rol	eax, 4              ; Convert character into character
	and	eax, 7              ;   code (0..7).
	ret

@@:	shl	eax, 1              ; Five-bit character begins with 10.
	js	@f                  ; Branch if character begins with 11.
	shl	dword ptr [esi], 5  ; Remove 5-bit character from word.
	rol	eax, 4              ; Convert character into character
	and	eax, 7              ;   code (10o..17o).
	xor	al, 10o             ; (Flip bit 3 = set bit 3 = add 8.)
	ret

@@:	shl	dword ptr [esi], 7  ; Remove 7-bit character from word.
	rol	eax, 6              ; Convert character into character
	and	eax, 77o            ;   code (20o..57o).
	sub	al, 20o
	ret

qring and ring -- I believe the "ring" is character 60o -- [ring] -- ColorForth uses this instead of a blinking cursor to indicate where the next word will appear in the editor

qring:
;[Refs: type0, ref1]
	dup_
	inc	dword ptr [esi]
	cmp	curs, edi ; from abort, insert
	jnz	@f
	mov	curs, eax		
@@:	cmp	eax, curs
	jz	ring
	jns	@f
	mov	pcad, edi
@@:	drop
	ret

ring:
;[Refs: qring]
	mov	cad, edi
	sub	xy, iw*10000h ; bksp
	dup_
	mov	eax, 0e04000h
	call	color
	mov	eax, 60o
	mov	cx, word ptr xy+2
	cmp	cx, word ptr rm
	js	@f
	call	emit
	sub	xy, iw*10000h ; bksp
	ret
@@:	jmp	emit

The refresh routine (actually ref1) relies on thirteen other routines (not counting nul, which does nothing) to display pre-parsed words on the screen. These routines correspond to the thirteen colors defined in the pre-parsed word specs.

Color numberColorMeaningLabelProbable label meaning
0N/AExtensionTYPE0Show type-0 word
1YellowExecute wordwWShow word as Word
2YellowExecute "long" numbernWShow number as Word
3RedDefine wordrWShow red Word
4GreenCompile wordgWShow green Word
5GreenCompile "long" numbergnWShow green number as Word
6GreenCompile "short" numbergsWShow green short number as Word
7CyanCompile macro wordmWShow macro Word
8YellowExecute "short" numbersWShow short number as Word
9WhiteComment (lowercase)textShow text
10WhiteComment (Capitalized)CapShow text Capitalized
11WhiteComment (ALL CAPS)CAPSShow text in ALL CAPS
12MagentaVariablevarShow variable
 

Displaying words

rw:
;[Refs: display]
	mov	cx, word ptr xy+2
	cmp	cx, word ptr lm
	jz	@f
	call	cr
@@:	call	red
	jmp	type_

gw:
;[Refs: display]
	call	green
	jmp	type_

mw:
;[Refs: display]
	call	cyan
	jmp	type_

ww:
;[Refs: display]
	dup_
	mov	eax, yellow
	call	color
	jmp	type_

Displaying word extensions

type0:
;[Refs: display]
	sub	xy, iw*10000h ; call bspcr
	test	dword ptr [-4+edi*4], -20o
	jnz	type1
	dec	edi
	mov	lcad, edi
	call	space
	call	qring
	pop	edx ; end of block ; [RST]
	drop
	jmp	keyboard

Displaying comments

cap:
;[Refs: display]
	call	white
	dup_
	mov	eax, [-4+edi*4]
	and	eax, -20o
	call	unpack
	add	al, 48
	call	emit
	jmp	type2

caps:
;[Refs: display]
	call	white
	dup_
	mov	eax, [-4+edi*4]
	and	eax, -20o
@@:	call	unpack
	jz	@f
	add	al, 48
	call	emit
	jmp	@b

text:
;[Refs: display]
	call	white

Unpacking and printing characters

type_:
;[Refs: var, rw, gw, mw, ww]
type1:
;[Refs: type0]
	dup_
	mov	eax, [-4+edi*4]
	and	eax, -20o

type2:
;[Refs: cap, type2]
	call	unpack
	jz	@f
	call	emit
	jmp	type2
@@:	call	space
	drop
	drop
	ret

Displaying numbers

gsw:
;[Refs: display]
	mov	edx, [-4+edi*4]
	sar	edx, 5
	jmp	gnw1

var:
;[Refs: display]
	call	magenta
	call	type_

gnw:
;[Refs: display]
	mov	edx, [edi*4]
	inc	edi

gnw1:
;[Refs: gsw]
	dup_
	mov	eax, 0f800h ; green
	cmp	bas, offset dot10
	jz	@f		
	mov	eax, 0c000h ; dark green
	jmp	@f

sw:
;[Refs: display]
	mov	edx, [-4+edi*4]
	sar	edx, 5
	jmp	nw1

nw:
;[Refs: display]
	mov	edx, [edi*4]
	inc	edi

nw1:
;[Refs: sw]
	dup_
	mov	eax, yellow
	cmp	bas, offset dot10
	jz	@f		
	mov	eax, 0c0c000h ; dark yellow
@@:	call	color
	dup_
	mov	eax, edx
	jmp	[bas]

Refresh

refresh:
;[Refs: e]
	call	show
	call	blank
	call	text1
	dup_			; counter
	mov	eax, lcad
	mov	cad, eax ; for curs beyond end
	xor	eax, eax
	mov	edi, blk
	shl	edi, 10-2
	mov	pcad, edi ; for curs=0

ref1:
;[Refs: ref1]
	test	dword ptr [edi*4], 0fh
	jz	@f
	call	qring
@@:	mov	edx, [edi*4]
	inc	edi
	mov	bas, offset dot10
	test	dl, 20o
	jz	@f
	mov	bas, offset dot
@@:	and	edx, 17o
	call	display[edx*4]
	jmp	ref1

The display-routine table

align 4
display
;Offsets to display routines.
;[Refs: ref1]
	dd offset type0, offset ww, offset nw, offset rw
	dd offset gw, offset gnw, offset gsw, offset mw
	dd offset sw, offset text, offset cap, offset caps
	dd offset var, offset nul, offset nul, offset nul

tens
;[Refs: dot10]
	dd 10, 100, 1000, 10000, 100000, 1000000
	dd 10000000, 100000000, 1000000000

bas
;[Refs: gnw1, nw1, ref1]
	dd offset dot10

blk is the current block

blk
;[Refs: abort, copy, refresh, pblk, mblk, shadow, edit, e]
	dd 18

curs
;[Refs: abort, qring, (refresh,) mcur, pcur, mmcur, ppcur, insert1]
	dd 0

cad
;[Refs: ring, refresh, insert1, del, enstack]
	dd 0

pcad
;[Refs: qring, refresh, del, enstack]
	dd 0

lcad
;[Refs: type0, refresh, insert0, insert1, del]
	dd 0

trash
;[Refs: destack, enstack]
	dd buffer*4

(27 keys in keyboard; 28 offsets in "ekeys" table)

ekeys
;[Refs: e]
	dd offset nul, offset del, offset eout, offset destack
	dd offset act1, offset act3, offset act4, offset shadow
	dd offset mcur, offset mmcur, offset ppcur, offset pcur
	dd offset mblk, offset actv, offset act7, offset pblk
	dd offset nul, offset act11, offset act10, offset act9
	dd offset nul, offset nul, offset nul, offset nul

ekbd0
;[Refs: e]
	dd offset nul, offset nul, offset nul, offset nul
	db 25o, 45o,  7 ,  0  ;   x  .  I

ekbd
;[Refs: e]
	db 17o,  1 , 15o, 55o ;   w  r  g  *
	db 14o, 26o, 20o,  1  ;   l  u  d  r
	db 43o, 11o, 12o, 53o ;   -  m  c  +
	db  0 , 70o, 72o,  2  ;	     s  c  t
	db  0 ,  0 ,  0 ,  0
	db  0 ,  0 ,  0 ,  0

actc
;Action colors.
;[Refs: act7]
	dd yellow, 0, 0ff0000h, 0c000h, 0, 0, 0ffffh
		; 1=yellow (0xFFFF00), --, 3=red (0xFF0000),
		; 4=green (0x00C000), --, --, 7=cyan (0x00FFFF)
	dd 0, 0ffffffh, 0ffffffh, 0ffffffh, 8080ffh
		; --, 9..11=white (0xFFFFFF), 12=light blue??? (0x8080FF)

vector
;[Refs: pad]
	dd 0

These "actxxx" routines and variables wouldn't be connected with act, would they?

action
;[Refs: act7, actv, insert, format, format2]
	db 1

act1:
;[Refs: ekeys]
	mov	al, 1                ; 1 = execute (yellow word)
	jmp	@f

act3:
;[Refs: ekeys]
	mov	al, 3                ; 3 = define (red word)
	jmp	@f

act4:
;[Refs: ekeys]
	mov	al, 4                ; 4 = compile (green word)
	jmp	@f

act9:
;[Refs: ekeys]
	mov	al, 9                ; 9 = comment (white word)
	jmp	@f

act10:
;[Refs: ekeys]
	mov	al, 10               ; 10 = Capitalized Comment
	jmp	@f

act11:
;[Refs: ekeys]
	mov	al, 11               ; 11 = COMMENT IN ALL CAPS
	jmp	@f

act7:
;[Refs: ekeys]
	mov	al, 7                ; 7 = compile macro (cyan word)
@@:	mov	action, al
	mov	eax, [actc-4+eax*4]
	mov	aword, offset insert

actn:
;[Refs: actv]
	mov	keyc, eax
	pop	eax ; [RST]
	drop
	jmp	accept

actv:
;[Refs: ekeys]
	mov	action, 12           ; 12 = variable (magenta word)
	mov	eax, 0ff00ffh ; magenta
	mov	aword, offset @f
	jmp	actn
@@:	dup_
	xor	eax, eax
	inc	words
	jmp	insert

Cursor and block routines

mcur:
;[Refs: ekeys, del]
	dec	curs
	jns	@f

pcur:
;[Refs: ekeys]
	inc	curs
@@:	ret

mmcur:
;[Refs: ekeys]
	sub	curs, 8
	jns	@f
	mov	curs, 0
@@:	ret

ppcur:
;[Refs: ekeys]
	add	curs, 8
	ret

pblk:
;[Refs: ekeys]
	add	blk, 2
	add	dword ptr [esi], 2
	ret

mblk:
;[Refs: ekeys]
	cmp	blk, 20
	js	@f
	sub	blk, 2
	sub	dword ptr [esi], 2
@@:	ret

shadow:
;Toggles between code (even-numbered)
;and documentation (odd-numbered) blocks.
;[Refs: ekeys]
	xor	blk, 1
	xor	dword ptr [esi], 1
	ret

e0:
;[Refs: e]
	drop
	jmp	@f

edit:
;Start editor at block given in TOS.
;[Refs: forth2]
	mov	blk, eax
	drop

e:
;Restart editor at current block.
;[Refs: forth2]
	dup_
	mov	eax, blk
	mov	anumber, offset format
	mov	byte ptr alpha0+4*4, 45o ; .
	mov	alpha0+4, offset e0
	call	refresh
@@:	mov	shift, offset ekbd0
	mov	board, offset ekbd-4
	mov	keyc, yellow
@@:	call	key
	call	ekeys[eax*4]
	drop
	jmp	@b

eout:
;[Refs: ekeys]
	pop	eax ; [RST]
	drop
	drop
	mov	aword, offset ex1
	mov	anumber, offset nul
	mov	byte ptr alpha0+4*4, 0
	mov	alpha0+4, offset nul0
	mov	keyc, yellow
	jmp	accept

destack:
;[Refs: ekeys]
	mov	edx, trash
	cmp	edx, buffer*4
	jnz	@f
	ret
@@:	sub	edx, 2*4
	mov	ecx, [edx+1*4]
	mov	words, ecx
@@:	dup_
	mov	eax, [edx]
	sub	edx, 1*4
	next	@b
	add	edx, 1*4
	mov	trash, edx

insert0:
;[Refs: insert]
	mov	ecx, lcad ; room available?
	add	ecx, words
	xor	ecx, lcad
	and	ecx, -100h
	jz	insert1
	mov	ecx, words ; no
@@:	drop
	next	@b
	ret

insert1:
;[Refs: insert0]
	push	esi
	mov	esi, lcad
	mov	ecx, esi
	dec	esi
	mov	edi, esi
	add	edi, words
	shl	edi, 2
	sub	ecx, cad
	js	@f
	shl	esi, 2
	std
	rep	movsd
	cld
@@:	pop	esi
	shr	edi, 2
	inc	edi
	mov	curs, edi ; like abort
	mov	ecx, words
@@:	dec	edi
	mov	[edi*4], eax
	drop ; requires cld
	next	@b
	ret

insert:
;[Refs: qring, act7, actv, format, format2]
	call	insert0
	mov	cl, action
	xor	[edi*4], cl
	jmp	accept

format:
;( ?? -- ) ??
;[Refs: e]
	test	action, 12o ; ignore 3 and 9
	jz	@f
	drop
	ret
@@:	mov	edx, eax
	and	edx, 0fc000000h
	jz	@f
	cmp	edx, 0fc000000h
	jnz	format2
@@:	shl	eax, 5
	xor	al, 2 ; 6
	cmp	action, 4
	jz	@f
	xor	al, 13o ; 8
@@:	cmp	base, 10
	jz	@f
	xor	al, 20o
@@:	mov	words, 1
	jmp	insert

format2:
;[Refs: format]
	dup_
	mov	eax, 1 ; 5
	cmp	action, 4
	jz	@f
	mov	al, 3 ; 2
@@:	cmp	base, 10
	jz	@f
	xor	al, 20o
@@:	xchg	eax, [esi]
	mov	words, 2
	jmp	insert

del:
;[Refs: ekeys]
	call	enstack
	mov	edi, pcad
	mov	ecx, lcad
	sub	ecx, edi
	shl	edi, 2
	push	esi
	mov	esi, cad
	shl	esi, 2
	rep	movsd
	pop	esi
	jmp	mcur

enstack:
;[Refs: del]
	dup_
	mov	eax, cad
	sub	eax, pcad
	jz	ens
	mov	ecx, eax
	xchg	eax, edx
	push	esi
	mov	esi, cad
	lea	esi, [esi*4-4]
	mov	edi, trash
@@:	std
	lodsd
	cld
	stosd
	next	@b
	xchg	eax, edx
	stosd
	mov	trash, edi
	pop	esi

ens:
;[Refs: enstack]
	drop
	ret

pad:
;[Refs: forth2]
	pop	edx        ; [RST] ; Move return address into vector.
	mov	vector, edx
	add	edx, 28*5
	mov	board, edx
	sub	edx, 4*4
	mov	shift, edx
@@:	call	key                ; (task switch)
	mov	edx, vector
	add	edx, eax           ; ?? add CF key code to vector ??
	lea	edx, [5+eax*4+edx]
	add	edx, [-4+edx]
	drop
	call	edx
	jmp	@b

org (1200h-1)*4
	dd 0
end start

Check the index for other entries.