├── orig
    ├── COLOR.COM
    ├── README.md
    ├── discf.py
    ├── asmcf.py
    ├── discfcolor.py
    ├── GEN.ASM
    ├── BOOT.ASM
    ├── forth.txt
    └── COLOR.ASM
├── color.html
├── README.md
├── storage.js
├── keyb.js
├── edit.js
├── icons.js
├── gfx.js
├── init.js
└── main.js


/orig/COLOR.COM:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/aiju/jsColorForth/HEAD/orig/COLOR.COM


--------------------------------------------------------------------------------
/color.html:
--------------------------------------------------------------------------------
1 | <script src="init.js"></script>
2 | <script src="main.js"></script>
3 | <script src="gfx.js"></script>
4 | <script src="keyb.js"></script>
5 | <script src="edit.js"></script>
6 | <script src="storage.js"></script>
7 | <script src="icons.js"></script>
8 | <canvas id="canvas" width="1024" height="768" tabindex="1" style="image-rendering: pixelated"></canvas>
9 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | jsColorForth
 2 | =============
 3 | 
 4 | This is a port of Chuck Moore's [colorForth](https://colorforth.github.io/cf.htm) to Javascript.
 5 | I derived it from the original assembly and Forth code, trying to stay fairly to the original.
 6 | 
 7 | Notable changes made:
 8 | 
 9 | - Since I can't compile to machine code, I compile to a bytecode ("wordcode") that gets JIT compiled to Javascript (Webassembly would be interesting to try as an alternative)
10 | - Naturally, all the PC hardware specific code is gone.
11 | - Currently the 'VM' is Harvard architecture and the wordcode is compiled to an append-only array.
12 | 


--------------------------------------------------------------------------------
/orig/README.md:
--------------------------------------------------------------------------------
 1 | This is the source code of the original colorForth, for reference.
 2 | There are three parts:
 3 | - Assembly language code in `*.ASM` files
 4 | - Icons
 5 | - colorForth code
 6 | 
 7 | The latter two are only distributed as part of the `COLOR.COM` image.
 8 | `forth.txt` contains the decompiled colorForth code in text form, using idiosyncratic syntax instead of colours.
 9 | `forth.html` is the same, but in Technicolor.
10 | 
11 | My script `discf.py` decompiles the colorForth code.
12 | It uses a ASCII representation for the colorForth.
13 | `discfcolor.py` decompiles into colors (terminal or HTML).
14 | 
15 | `asmcf.py` assembles the ASCII form back into binary format.
16 | 


--------------------------------------------------------------------------------
/orig/discf.py:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/python3
  2 | def dechuck(w):
  3 | 	s = ""
  4 | 	while True:
  5 | 		if w >> 31 == 0:
  6 | 			c = w >> 28
  7 | 			w = w << 4 & 0xffffffff
  8 | 			if c == 0:
  9 | 				return s
 10 | 			s += " rtoeani"[c]
 11 | 		elif w >> 30 == 2:
 12 | 			c = w >> 27 & 7
 13 | 			w = w << 5 & 0xffffffff
 14 | 			s += "smcylgfw"[c]
 15 | 		else:
 16 | 			c = w >> 25 & 31
 17 | 			w = w << 7 & 0xffffffff
 18 | 			s += "dvpbhxuq0123456789j-k.z/;:!+@*,?"[c]
 19 | def sx(n):
 20 | 	return (n & (1<<26) - 1) - (n & 1<<26) & 0xffffffff
 21 | 
 22 | f = open('COLOR.COM', 'rb')
 23 | for i in range(63):
 24 | 	block = f.read(1024)
 25 | 	if i < 18: continue
 26 | 	print('#{}'.format(i))
 27 | 	words = [block[4*j] | block[4*j+1] << 8 | block[4*j+2] << 16 | block[4*j+3] << 24 for j in range(256)]
 28 | 	j = 0
 29 | 	line = 0
 30 | 	comment = False
 31 | 	execute = False
 32 | 	cyan = False
 33 | 	while j < len(words):
 34 | 		w = words[j]
 35 | 		j += 1
 36 | 		if w == 0:
 37 | 			break
 38 | 		m = w & 15
 39 | 		s = dechuck(w & -16)
 40 | 		if m in [1,3,4,7,9,10,11]:
 41 | 			while j < len(words) and words[j] != 0 and (words[j] & 15) == 0:
 42 | 				s += dechuck(words[j] & -16)
 43 | 				j += 1
 44 | 		if m == 8 or m == 6:
 45 | 			if w & 0x10:
 46 | 				dec = '${:x}'.format(sx(w>>5))
 47 | 			else:
 48 | 				dec = str(sx(w>>5))
 49 | 		elif m == 2 or m == 5:
 50 | 			if j  == len(words):
 51 | 				raise ValueError
 52 | 			else:
 53 | 				if w & 0x10:
 54 | 					dec = '${:x}'.format(words[j])
 55 | 				else:
 56 | 					dec = str(words[j])
 57 | 				j += 1
 58 | 		elif m == 10:
 59 | 			dec = s.capitalize()
 60 | 		elif m == 11:
 61 | 			dec = s.upper()
 62 | 		else:
 63 | 			dec = s
 64 | 		pre = ''
 65 | 		if not m in [2,5,6,8,9,10,11] and dec.isdigit():
 66 | 			dec = '$$' + dec
 67 | 		if m in [9,10,11]:
 68 | 			if not comment:
 69 | 				pre += '( '
 70 | 				comment = True
 71 | 		else:
 72 | 			if comment:
 73 | 				pre += ') '
 74 | 				comment = False
 75 | 			if m in [1,2,8]:
 76 | 				if not execute:
 77 | 					pre += '[ '
 78 | 					execute = True
 79 | 			else:
 80 | 				if execute:
 81 | 					pre += '] '
 82 | 					execute = False
 83 | 				if m == 7:
 84 | 					if not cyan:
 85 | 						pre += '[[ '
 86 | 						cyan = True
 87 | 				else:
 88 | 					if cyan:
 89 | 						pre += ']] '
 90 | 						cyan = False
 91 | 					if m == 12:
 92 | 						pre += '& '
 93 | 						assert j < len(words)
 94 | 						dec += ' ' + str(words[j])
 95 | 						j += 1
 96 | 					elif m == 3:
 97 | 						pre += '\n: '
 98 | 					elif m in [4,6,5]:
 99 | 						pass
100 | 					else:
101 | 						print(m)
102 | 						raise ValueError
103 | 		dec = pre + dec
104 | 		print(dec + ' ', end='')
105 | 		line += len(dec) + 1
106 | 	if comment:
107 | 		print(') ', end='')
108 | 		line += 2
109 | 	if execute:
110 | 		print('] ', end='')
111 | 		line += 2
112 | 	if line > 0:
113 | 		print()
114 | 


--------------------------------------------------------------------------------
/orig/asmcf.py:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/python3
  2 | import re
  3 | 
  4 | lower = re.compile('^[a-z0-9\-./;:!+@*,?]+$')
  5 | upper = re.compile('^[A-Z0-9\-./;:!+@*,?]+$')
  6 | capit = re.compile('^[A-Z0-9\-./;:!+@*,?][a-z0-9\-./;:!+@*,?]+$')
  7 | 
  8 | def enchuck(s):
  9 | 	w = 0
 10 | 	n = 0
 11 | 	r = []
 12 | 	#print(s)
 13 | 	for ch in s.lower():
 14 | 		c = 1 + 'rtoeanismcylgfwdvpbhxuq0123456789j-k.z/;:!+@*,?'.find(ch)
 15 | 		assert c > 0
 16 | 		if c < 8:
 17 | 			nc = 4
 18 | 			b = c
 19 | 		elif c < 16:
 20 | 			nc = 5
 21 | 			b = 0x10 | c - 8
 22 | 		else:
 23 | 			nc = 7
 24 | 			b = 0x60 | c - 16
 25 | 		tz = len(bin(b)) - len(bin(b).rstrip('0'))
 26 | #		print(ch, bin(b), nc, tz)
 27 | 		if n + nc - tz > 28:
 28 | 			r += [w << 32 - n]
 29 | 			w = 0
 30 | 			n = 0
 31 | 		elif n + nc > 28:
 32 | 			b >>= n + nc - 28
 33 | 			nc = 28 - n
 34 | 		w = w << nc | b
 35 | 		n += nc
 36 | 	if n != 0:
 37 | 		r += [w << 32 - n]
 38 | 	#print([hex(x) for x in r])
 39 | 	return r
 40 | def do_comment(w):
 41 | 	r = enchuck(w)
 42 | 	if lower.match(w):
 43 | 		r[0] |= 9
 44 | 	elif upper.match(w):
 45 | 		r[0] |= 11
 46 | 	elif capit.match(w):
 47 | 		r[0] |= 10
 48 | 	else:
 49 | 		assert False
 50 | 	return r
 51 | def do_number(w, hex, execute, magenta):
 52 | 	if magenta:
 53 | 		return [w]
 54 | 	if w>>26 in [0,63]:
 55 | 		return [w<<5 & 0xffffffff | int(hex)<<4 | (8 if execute else 6)]
 56 | 	else:
 57 | 		return [int(hex)<<4 | (2 if execute else 5), w]
 58 | def do_word(w, execute, cyan, next):
 59 | 	r = enchuck(w)
 60 | 	if next == 'red':
 61 | 		r[0] |= 3
 62 | 	elif next == 'magenta':
 63 | 		r[0] |= 12
 64 | 	elif execute:
 65 | 		r[0] |= 1
 66 | 	elif cyan:
 67 | 		r[0] |= 7
 68 | 	else:
 69 | 		r[0] |= 4
 70 | 	return r
 71 | 
 72 | f = open('cf.f', 'r')
 73 | blocks = {}
 74 | comment = False
 75 | execute = False
 76 | cyan = False
 77 | next = ''
 78 | for l in f:
 79 | 	words = l.split()
 80 | 	for w in words:
 81 | 		if w[0] == '#':
 82 | 			cur = int(w[1:])
 83 | 			if cur not in blocks.keys():
 84 | 				blocks[cur] = []
 85 | 		elif w == '(':
 86 | 			comment = True
 87 | 		elif comment:
 88 | 			if w == ')':
 89 | 				comment = False
 90 | 			else:
 91 | 				blocks[cur] += do_comment(w)
 92 | 		elif w == '[':
 93 | 			assert not execute and next == ''
 94 | 			execute = True
 95 | 		elif w == ']':
 96 | 			assert execute and next == ''
 97 | 			execute = False
 98 | 		elif w == '[[':
 99 | 			assert not cyan and next == ''
100 | 			cyan = True
101 | 		elif w == ']]':
102 | 			assert cyan and next == ''
103 | 			cyan = False
104 | 		elif w == ':':
105 | 			assert not execute and not cyan and next == ''
106 | 			next = 'red'
107 | 		elif w.isdigit():
108 | 			assert not cyan and (next == '' or next == 'magenta-num')
109 | 			blocks[cur] += do_number(int(w), False, execute, next == 'magenta-num')
110 | 			next = ''
111 | 		elif w[0:2] == '$$':
112 | 			assert next != 'magenta-num'
113 | 			blocks[cur] += do_word(w[2:], execute, cyan, next)
114 | 			next = ''
115 | 		elif w[0] == '$':
116 | 			assert not cyan and (next == '' or next == 'magenta-num')
117 | 			blocks[cur] += do_number(int(w[1:], 16), True, execute, next == 'magenta-num')
118 | 			next = ''
119 | 		elif w == '&':
120 | 			assert not execute and not cyan and next == ''
121 | 			next = 'magenta'
122 | 		else:
123 | 			assert next != 'magenta-num'
124 | 			blocks[cur] += do_word(w, execute, cyan, next)
125 | 			if next == 'magenta':
126 | 				next = 'magenta-num'
127 | 			else:
128 | 				next = ''
129 | 
130 | g = open('new.bin', 'wb')
131 | for i in range(63):
132 | 	if i not in blocks:
133 | 		g.write(bytes([0] * 1024))
134 | 		continue
135 | 	b = blocks[i]
136 | 	for j in b:
137 | 		g.write(bytes([j & 0xff, j >> 8 & 0xff, j >> 16 & 0xff, j >> 24 & 0xff]))
138 | 	g.write(bytes([0] * (4 * (256 - len(b)))))
139 | 


--------------------------------------------------------------------------------
/orig/discfcolor.py:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/python3
  2 | import sys
  3 | 
  4 | def dechuck(w):
  5 | 	s = ""
  6 | 	while True:
  7 | 		if w >> 31 == 0:
  8 | 			c = w >> 28
  9 | 			w = w << 4 & 0xffffffff
 10 | 			if c == 0:
 11 | 				return s
 12 | 			s += " rtoeani"[c]
 13 | 		elif w >> 30 == 2:
 14 | 			c = w >> 27 & 7
 15 | 			w = w << 5 & 0xffffffff
 16 | 			s += "smcylgfw"[c]
 17 | 		else:
 18 | 			c = w >> 25 & 31
 19 | 			w = w << 7 & 0xffffffff
 20 | 			s += "dvpbhxuq0123456789j-k.z/;:!+@*,?"[c]
 21 | def sx(n):
 22 | 	return (n & (1<<26) - 1) - (n & 1<<26) & 0xffffffff
 23 | 
 24 | def error(x,h):
 25 | 	raise ValueError
 26 | def t_green(x,h):
 27 | 	return '\u001b[32{}m{}\u001b[0m'.format('' if h else ';1', x)
 28 | def t_red(x,h):
 29 | 	return '\u001b[31;1m{}\u001b[0m'.format(x)
 30 | def t_cyan(x,h):
 31 | 	return '\u001b[36;1m{}\u001b[0m'.format(x)
 32 | def t_yellow(x,h):
 33 | 	return '\u001b[33{}m{}\u001b[0m'.format('' if h else ';1', x)
 34 | def t_white(x,h):
 35 | 	return '\u001b[37;1m{}\u001b[0m'.format(x)
 36 | def t_magenta(x,h):
 37 | 	return '\u001b[35;1m{}\u001b[0m'.format(x)
 38 | 
 39 | t_coltab = [error, t_yellow, t_green, t_red, t_green, t_green, t_green, t_cyan, t_yellow, t_white, t_white, t_white, t_magenta, error, error, error]
 40 | 
 41 | def hc(x,c):
 42 | 	return '<span class="{}">{}</span>'.format(c,x)
 43 | def h_yellow(x,h):
 44 | 	return hc(x, 'darkyellow' if h else 'yellow')
 45 | def h_green(x,h):
 46 | 	return hc(x, 'darkgreen' if h else 'green')
 47 | def h_red(x,h):
 48 | 	return hc(x, 'red')
 49 | def h_cyan(x,h):
 50 | 	return hc(x, 'cyan')
 51 | def h_white(x,h):
 52 | 	return hc(x, 'white')
 53 | def h_magenta(x,h):
 54 | 	return hc(x, 'magenta')
 55 | 
 56 | h_coltab = [error, h_yellow, h_green, h_red, h_green, h_green, h_green, h_cyan, h_yellow, h_white, h_white, h_white, h_magenta, error, error, error]
 57 | 
 58 | html = len(sys.argv) > 1
 59 | coltab = h_coltab if html else t_coltab
 60 | 
 61 | if html:
 62 | 	header = """
 63 | <!DOCTYPE html>
 64 | <html lang="en">
 65 | <head>
 66 | <meta charset="utf-8">
 67 | <title>title</title>
 68 | <style>
 69 | body { background-color: black; }
 70 | * { color: white; font-family: Courier, monospace; }
 71 | th { font-weight: normal; width: 5em; } 
 72 | td { padding-bottom: 1em; }
 73 | .red { color: #ff0000; }
 74 | .green { color: #00f800; }
 75 | .darkgreen { color: #00c000; }
 76 | .yellow { color: #ffff00; }
 77 | .darkyellow { color: #c0c000; }
 78 | .cyan { color: #00ffff; }
 79 | .magenta { color: #ff00ff; }
 80 | th, td { vertical-align: top; }
 81 | </style>
 82 | </head>
 83 | <body>
 84 | <table>
 85 | """
 86 | 	trailer = '</table></body></html>'
 87 | 	nl = '<br>'
 88 | 	def paropen(i):
 89 | 		print('<tr><th>{}</th><td>'.format(i),end='')
 90 | 	def parclose():
 91 | 		print('</td></tr>')
 92 | else:
 93 | 	header = ""
 94 | 	trailer = ""
 95 | 	nl = '\n'
 96 | 	def paropen(i):
 97 | 		print('#{}'.format(i))
 98 | 	def parclose():
 99 | 		pass
100 | 
101 | f = open('COLOR.COM', 'rb')
102 | print(header, end='')
103 | for i in range(63):
104 | 	block = f.read(1024)
105 | 	if i < 18: continue
106 | 	words = [block[4*j] | block[4*j+1] << 8 | block[4*j+2] << 16 | block[4*j+3] << 24 for j in range(256)]
107 | 	if words[0] == 0: continue
108 | 	paropen(i)
109 | 	j = 0
110 | 	line = 0
111 | 	while j < len(words):
112 | 		w = words[j]
113 | 		j += 1
114 | 		if w == 0:
115 | 			break
116 | 		m = w & 15
117 | 		s = dechuck(w & -16)
118 | 		if m in [1,3,4,7,9,10,11]:
119 | 			while j < len(words) and words[j] != 0 and (words[j] & 15) == 0:
120 | 				s += dechuck(words[j] & -16)
121 | 				j += 1
122 | 		if m == 8 or m == 6:
123 | 			if w & 0x10:
124 | 				dec = '{:x}'.format(sx(w>>5))
125 | 			else:
126 | 				dec = str(sx(w>>5))
127 | 		elif m == 2 or m == 5:
128 | 			if j  == len(words):
129 | 				raise ValueError
130 | 			else:
131 | 				if w & 0x10:
132 | 					dec = '{:x}'.format(words[j])
133 | 				else:
134 | 					dec = str(words[j])
135 | 				j += 1
136 | 		elif m == 10:
137 | 			dec = s.capitalize()
138 | 		elif m == 11:
139 | 			dec = s.upper()
140 | 		else:
141 | 			dec = s
142 | 		if m == 3 and line > 0:
143 | 			print(nl,end='')
144 | 			line = 0
145 | 		dec = coltab[m](dec, (w & 0x10) != 0)
146 | 		print(dec + ' ', end='')
147 | 		line += len(dec) + 1
148 | 		if m == 12:
149 | 			dec = coltab[2](words[j], False)
150 | 			j += 1
151 | 			print(dec + ' ', end='')
152 | 			line += len(dec) + 1
153 | 	if line > 0:
154 | 		print(nl,end='')
155 | 	parclose()
156 | print(trailer, end='')
157 | 


--------------------------------------------------------------------------------
/orig/GEN.ASM:
--------------------------------------------------------------------------------
  1 | ;Generic graphics
  2 | 
  3 | ALIGN 4
  4 | frame dd 2000000h-hp*vp*2 ; 32 M
  5 | displ dd 0f0000000h ; fujitsu
  6 | fore  dd 0f7deh
  7 | xc    dd 0
  8 | yc    dd 0
  9 | 
 10 | rgb: ror  EAX, 8
 11 |     shr  AX, 2
 12 |     ror  EAX, 6
 13 |     shr  AL, 3
 14 |     rol  EAX, 6+5
 15 |     and  EAX, 0f7deh
 16 |     ret
 17 | 
 18 | white: DUP_
 19 |     mov  EAX, 0ffffffh
 20 | color: call rgb
 21 |     mov  fore, EAX
 22 |     DROP
 23 |     ret
 24 | 
 25 | north: mov  EDX, 0cf8h
 26 |     out  DX, EAX
 27 |     add  EDX, 4
 28 |     in   EAX, DX
 29 |     ret
 30 | 
 31 | dev: mov  EAX, 80001008h ; Find display, start at device 2
 32 |     mov  ECX, 31-1 ; end with AGP: 10008, bus 1, dev 0
 33 | @@:     DUP_
 34 |         call north
 35 |         and  EAX, 0ff000000h
 36 |         cmp  EAX, 3000000h
 37 |         DROP
 38 |         jz   @f
 39 |         add  EAX, 800h
 40 |         next @b
 41 | @@: ret
 42 | 
 43 | ati0: call dev
 44 |     or   dword ptr [EAX-4], 2 ; Enable memory
 45 |     add  AL, 24h-8 ; look for prefetch
 46 |     mov  CL, 5
 47 | @@:     DUP_
 48 |         call north
 49 |         xor  AL, 8
 50 |         jz   @f
 51 |         DROP
 52 |         sub  EAX, 4
 53 |         next @b
 54 |     DUP_
 55 |     call north
 56 |     and  EAX, 0fffffff0h
 57 | @@: mov  displ, EAX
 58 |     DROP
 59 |     ret
 60 | 
 61 | fifof: DROP
 62 | graphic: ret
 63 | 
 64 | switch:
 65 | ;    DUP_
 66 |     push ESI
 67 |     mov  ESI, frame
 68 |     push EDI
 69 |     mov  EDI, displ ; 0f2000000h eMonster Nvidia
 70 | ;    xor  EAX, EAX
 71 |     mov  ECX, hp*vp/2
 72 | ;@@:     lodsd
 73 | ;        add  EAX, [EDI]
 74 | ;        rcr  EAX, 1
 75 | ;        and  EAX, 0f7def7deh
 76 | ;        stosd
 77 | ;        next @b
 78 |     rep movsd
 79 |     pop  EDI
 80 |     pop  ESI
 81 | ;    DROP
 82 |     jmp  PAUSE
 83 | 
 84 | clip: mov  EDI, xy
 85 |     mov  ECX, EDI
 86 |     test CX, CX
 87 |     jns  @f
 88 |         xor  ECX, ECX
 89 | @@: and  ECX, 0ffffh
 90 |     mov  yc, ECX
 91 |     imul ECX, hp*2
 92 | ;    shl  ECX, 10+1
 93 |     sar  EDI, 16
 94 |     jns  @f
 95 |         xor  EDI, EDI
 96 | @@: mov  xc, EDI
 97 |     lea  EDI, [EDI*2+ECX]
 98 |     add  EDI, frame
 99 |     ret
100 | 
101 | bit16: lodsw
102 |     xchg AL, AH
103 |     mov  ECX, 16
104 | b16: shl  AX, 1
105 |         jnc  @f
106 |             mov  [EDI], DX
107 | @@:     add  EDI, 2
108 |         next b16
109 |     ret
110 | 
111 | bit32: lodsw
112 |     xchg AL, AH
113 |     mov  ECX, 16
114 | b32: shl  EAX, 1
115 |         jnc  @f
116 |             mov  [EDI], DX
117 |             mov  [EDI+2], DX
118 |             mov  [EDI+hp*2], DX
119 |             mov  [EDI+hp*2+2], DX
120 | @@:     add  EDI, 4
121 |         next b32
122 |     ret
123 | 
124 | emit: call qcr
125 |     push ESI
126 |     push EDI
127 |     push EDX
128 |      imul EAX, 16*24/8
129 |      lea  ESI, icons[EAX]
130 |      call clip
131 |      mov  EDX, fore
132 |      mov  ECX, 24
133 | @@:     push ECX
134 |         call bit16
135 |         add  EDI, (hp-16)*2
136 |         pop  ECX
137 |         next @b
138 |     pop  EDX
139 |     pop  EDI
140 |     pop  ESI
141 | BL_: DROP
142 | SPACE: add  xy, iw*10000h
143 |     ret
144 | 
145 | emit2: push ESI
146 |     push EDI
147 |     push EDX
148 |      imul EAX, 16*24/8
149 |      lea  ESI, icons[EAX]
150 |      call clip
151 |      mov  EDX, fore
152 |      mov  ECX, 24
153 | @@:     push ECX
154 |         call bit32
155 |         add  EDI, (2*hp-16*2)*2
156 |         pop  ECX
157 |         next @b
158 |     pop  EDX
159 |     pop  EDI
160 |     pop  ESI
161 |     add  xy, iw*10000h*2
162 |     DROP
163 |     ret
164 | 
165 | text1: call WHITE
166 |     mov  lm, 3
167 |     mov  rm, hc*iw
168 |     jmp  TOP
169 | 
170 | line: call clip
171 |     mov  ECX, [ESI]
172 |     shl  ECX, 1
173 |     sub  EDI, ECX
174 |     mov  ECX, EAX
175 |     mov  EAX, fore
176 |     rep stosw
177 |     inc  xy
178 |     DROP
179 |     DROP
180 |     ret
181 | 
182 | box: call clip
183 |     cmp  EAX, vp+1
184 |     js   @f
185 |         mov  EAX, vp
186 | @@: mov  ECX, EAX
187 |     sub  ECX, yc
188 |     jng  no
189 |     cmp  dword ptr [ESI], hp+1
190 |     js   @f
191 |         mov  dword ptr [ESI], hp
192 | @@: mov  EAX, xc
193 |     sub  [ESI], EAX
194 |     jng  no
195 |     mov  EDX, hp
196 |     sub  EDX, [ESI]
197 |     shl  EDX, 1
198 |     mov  EAX, fore
199 | @@:     push ECX
200 |          mov  ECX, [ESI]
201 |          rep stosw
202 |          add  EDI, EDX
203 |         pop  ECX
204 |         next @b
205 | no: DROP
206 |     DROP
207 |     ret
208 | 


--------------------------------------------------------------------------------
/storage.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | 
  3 | function uint32array_eq(a,b) {
  4 | 	if(a.length !== b.length) return false;
  5 | 	for(let j = 0; j < a.length; j++)
  6 | 		if((a[j]|0) !== (b[j]|0))
  7 | 			return false;
  8 | 	return true;
  9 | }
 10 | 
 11 | function disassemble(words) {
 12 | 	function raw(n) {
 13 | 		if(n < 0) n += 2**32;
 14 | 		return '%' + n.toString(16);
 15 | 	}
 16 | 	var n;
 17 | 	for(var n = words.length - 1; n >= 0; n--)
 18 | 		if(words[n] != 0)
 19 | 			break;
 20 | 	n++;
 21 | 	var output = [];
 22 | 	let num;
 23 | 	for(var i = 0; i < n; ){
 24 | 		let i0 = i;
 25 | 		let w = words[i++];
 26 | 		if(w == 0){
 27 | 			output.push(raw(0));
 28 | 			continue;
 29 | 		}
 30 | 		let m = w & 15;
 31 | 		switch(m){
 32 | 		case 1: case 3: case 4: case 7: case 9: case 10: case 11: case 12:
 33 | 			let s = dechuck(w & -16);
 34 | 			if(m != 12)
 35 | 				while(i < n && words[i] != 0 && (words[i] & 15) == 0)
 36 | 					s += dechuck(words[i++] & -16);
 37 | 			let t = enchuck(s);
 38 | 			t[0] |= m;
 39 | 			if(s == '' || !uint32array_eq(words.subarray(i0, i), t) || m == 10 && !s.match(/^[a-z]/) || m == 11 && !s.match(/[a-z]/)){
 40 | 				for(let j = i0; j < i; j++)
 41 | 					output.push(raw(words[j]));
 42 | 				continue;
 43 | 			}
 44 | 			if(s.match(/^[0-9]+$/) || s == ':') s = '\\' + s;
 45 | 			switch(m){
 46 | 			case 1:
 47 | 				output.push('['); output.push(s); output.push(']');
 48 | 				break;
 49 | 			case 3:
 50 | 				output.push(':'); output.push(s);
 51 | 				break;
 52 | 			case 4:
 53 | 				output.push(s);
 54 | 				break;
 55 | 			case 7:
 56 | 				output.push('[['); output.push(s); output.push(']]');
 57 | 				break;
 58 | 			case 9:
 59 | 				output.push('('); output.push(s); output.push(')');
 60 | 				break;
 61 | 			case 10:
 62 | 				output.push('('); 
 63 | 				output.push(s[0].toUpperCase() + s.substr(1));
 64 | 				output.push(')');
 65 | 				break;
 66 | 			case 11:
 67 | 				output.push('('); 
 68 | 				output.push(s.toUpperCase());
 69 | 				output.push(')');
 70 | 				break;
 71 | 			case 12:
 72 | 				if(i == words.length)
 73 | 					output.push(raw(w));
 74 | 				else{
 75 | 					output.push('&');
 76 | 					output.push(s);
 77 | 					num = words[i++];
 78 | 					if(num < 0) num += 2**32;
 79 | 					output.push(num);
 80 | 				}
 81 | 				break;
 82 | 			}
 83 | 			break;
 84 | 		case 8: case 6:
 85 | 			if(m == 8)
 86 | 				output.push('[');
 87 | 			num = w>>5<<5>>5;
 88 | 			if(num < 0) num += 2**32;
 89 | 			if((w & 0x10) != 0)
 90 | 				output.push('$' + num.toString(16));
 91 | 			else
 92 | 				output.push(num.toString());
 93 | 			if(m == 8)
 94 | 				output.push(']');
 95 | 			break;
 96 | 		case 2: case 5:
 97 | 			if(i == words.length){
 98 | 				output.push(raw(w));
 99 | 				continue;
100 | 			}
101 | 			if(w>>5 != 0 || (words[i+1]>>26) + 1 <= 1){
102 | 				output.push(raw(w));
103 | 				output.push(raw(words[i++]));
104 | 				continue;
105 | 			}
106 | 			if(m == 2)
107 | 				output.push('[');
108 | 			num = words[i++];
109 | 			if(num < 0) num += 2**32;
110 | 			if((w & 0x10) != 0)
111 | 				output.push('$' + num.toString(16));
112 | 			else
113 | 				output.push(num.toString());
114 | 			if(m == 2)
115 | 				output.push(']');
116 | 			break;
117 | 		default:
118 | 			output.push(raw(w));
119 | 			continue;
120 | 		}
121 | 	}
122 | 	let w = 0;
123 | 	for(let i = 0; i < output.length; i++){
124 | 		switch(output[i]){
125 | 		case ':': if(i > 0){ output[w++] = '\n:'; continue; } break;
126 | 		case ')': if(output[i+1] === '('){ i++; continue; } break;
127 | 		case ']': if(output[i+1] === '['){ i++; continue; } break;
128 | 		case ']]': if(output[i+1] === '[['){ i++; continue; } break;
129 | 		}
130 | 		output[w++] = output[i];
131 | 	}
132 | 	output.length = w;
133 | 	return output.join(' ');
134 | }
135 | 
136 | function storage_write() {
137 | 	var n = tos++;;
138 | 	if(n >= 0 && n < mem.length/256){
139 | 		let d = mem.subarray(n*256, n*256+256);
140 | 		let s = disassemble(d);
141 | 		let t = assemble(s, true);
142 | 		if(!uint32array_eq(d, t)){
143 | 			console.log('trial reassembly failed!');
144 | 			console.log(d);
145 | 			console.log(s);
146 | 			console.log(t);
147 | 			s = Array.prototype.slice.call(d).map(x => '=' + (x < 0 ? x + 2**32 : x).toString(16)).join(' ');
148 | 		}
149 | 		localStorage.setItem('jsColorForth #' + n, s);
150 | 	}else
151 | 		console.log("invalid write arg " + n);
152 | }
153 | builtin("write", storage_write);
154 | 
155 | function storage_read() {
156 | 	var n = tos++;
157 | 	if(n >= 0 && n < mem.length/256){
158 | 		let d = localStorage.getItem('jsColorForth #' + n.toString());
159 | 		if(d === null) return;
160 | 		try{
161 | 			let data = assemble(d, true);
162 | 			mem.set(data, n * 256);
163 | 		}catch(e){
164 | 			console.log("invalid data in localStorage "+n);
165 | 		}
166 | 	}else
167 | 		console.log("invalid read arg " + n);
168 | }
169 | builtin("read", storage_read);
170 | 
171 | function nc() {
172 | 	DUP_();
173 | 	tos = mem.length/256;
174 | }
175 | builtin("nc", nc);
176 | 


--------------------------------------------------------------------------------
/orig/BOOT.ASM:
--------------------------------------------------------------------------------
  1 | ; Floppy boot segment
  2 | 
  3 | org 0 ; actually 7c00
  4 | start: jmp  start0
  5 |     nop
  6 | 
  7 |     db 'cmcf 1.0'
  8 |     dw 512     ; bytes/sector
  9 |     db 1       ; sector/cluster
 10 |     dw 1       ; sector reserved
 11 |     db 2       ; FATs
 12 |     dw 16*14   ; root directory entries
 13 |     dw 80*2*18 ; sectors
 14 |     db 0F0h    ; media
 15 |     dw 9       ; sectors/FAT
 16 |     dw 18      ; sectors/track
 17 |     dw 2       ; heads
 18 |     dd 0       ; hidden sectors
 19 |     dd 80*2*18 ; sectors again
 20 |     db 0       ; drive
 21 | ;    db 0
 22 | ;    db 29h     ; signature
 23 | ;    dd 44444444h     ; serial
 24 | ;    db 'COLOR FORTH' ; label
 25 | ;    db '        '
 26 | 
 27 | command  db 0
 28 |          db 0   ; head, drive
 29 | cylinder db 0
 30 |          db 0   ; head
 31 |          db 1   ; sector
 32 |          db 2   ; 512 bytes/sector
 33 |          db 18  ; sectors/track
 34 |          db 1bh ; gap
 35 |          db 0ffh
 36 | ALIGN 4
 37 | nc dd 9 ; Forth+Icons+blocks 24-161
 38 | gdt dw 17h
 39 |     dd offset gdt0
 40 | ALIGN 8
 41 | gdt0 dw 0, 0, 0, 0
 42 |     dw 0FFFFh, 0, 9A00h, 0CFh ; code
 43 |     dw 0FFFFh, 0, 9200h, 0CFh ; data
 44 | 
 45 | ; Code is compiled in Protected 32-bit mode.
 46 | ; Hence  org $-2  to fix 16-bit words
 47 | ; and 4 hand-assembled instructions.
 48 | ; and EAX and AX exchanged
 49 | ; This code is in Real 16-bit mode
 50 | 
 51 | start0: mov  EAX, 4F02h ; Video mode
 52 | org $-2
 53 |     mov  EBX, vesa ; hp*vp rgb: 565
 54 | org $-2
 55 |     int  10h
 56 |     cli
 57 |     xor  AX, AX    ; Move code to 0
 58 |     mov  BX, AX
 59 |     mov  EBX, CS
 60 |     mov  DS, EBX
 61 |     mov  ES, EAX
 62 |     mov  DI, AX
 63 |     mov  SI, AX
 64 |     call $+5 ; Where are we? IP+4*CS
 65 | org $-2
 66 | loc: pop  ESI
 67 |     sub  ESI, offset loc-offset start
 68 | org $-2
 69 |     mov  ECX, 512/4
 70 | org $-2
 71 |     rep movsw
 72 | ;    jmp  0:relocate
 73 |     db 0eah
 74 |     dw offset relocate-offset start, 0
 75 | 
 76 | relocate: ; This code is executed from 0
 77 |     mov  DS, EAX
 78 | ;   lgdt fword ptr gdt
 79 |     db 0fh, 1, 16h
 80 |     dw offset gdt-offset start
 81 |     mov  AL, 1
 82 |     mov  CR0, EAX
 83 | ;    jmp  8:protected
 84 |     db 0eah
 85 |     dw offset protected-offset start, 8
 86 | 
 87 | protected: ; Now in Protected 32-bit mode
 88 |     mov  AL, 10h
 89 |     mov  DS, EAX
 90 |     mov  ES, EAX
 91 |     mov  SS, EAX
 92 |     mov  ESP, Gods
 93 |     xor  ECX, ECX
 94 | 
 95 | A20: mov  AL, 0d1h
 96 |     out  64h, AL
 97 | @@:     in   AL, 64h
 98 |         and  AL, 2
 99 |         jnz  @b
100 |     mov  AL, 4bh
101 |     out  60h, AL
102 | 
103 |     call dma
104 |     shl  EBX, 4
105 |     add  ESI, EBX
106 |     cmp  dword ptr [ESI], 44444444h ; Boot?
107 |     jnz  cold
108 |         mov  CX, 63*100h-80h ; Nope
109 |         rep movsd
110 |         mov  ESI, Godd
111 |         jmp  start2
112 | 
113 | cold:   call sense_
114 |         jns  cold
115 |     mov  ESI, Godd
116 |     xor  EDI, EDI ; Cylinder 0 on top of Address 0
117 |     mov  CL, byte ptr nc
118 | @@:     push ECX
119 |         call READ
120 |         inc  cylinder
121 |         pop  ECX
122 |         loop @b
123 | start2: call stop
124 |     jmp  start1
125 | 
126 | us equ 1000/6
127 | ms equ 1000*us
128 | SPIN: mov  CL, 1ch
129 |     call onoff
130 | ;    mov  DX, 3f2h
131 | ;    out  DX, AL
132 | @@:     call sense_
133 |         jns  @b
134 |     mov  cylinder, 0 ; calibrate
135 |     mov  AL, 7
136 |     mov  CL, 2
137 |     call cmd
138 |     mov  ECX, 500*ms
139 | @@:     loop @b
140 | cmdi:   call sense_
141 |         js   cmdi
142 |     ret
143 | 
144 | ready: ;call delay
145 |     mov  DX, 3f4h
146 | @@:     in   AL, DX
147 |         out  0e1h, AL
148 |         shl  AL, 1
149 |         jnc  @b
150 |     lea  EDX, [EDX+1]
151 |     ret
152 | 
153 | transfer: mov  CL, 9
154 | cmd: lea  EDX, command
155 |     mov  [EDX], AL
156 | cmd0: push ESI
157 |     mov  ESI, EDX
158 | cmd1:   call ready
159 |         jns  @f
160 |             in   AL, DX
161 |             jmp  cmd1
162 | @@:     lodsb
163 |         out  DX, AL
164 |         out  0e1h, AL
165 |         loop cmd1
166 |     pop  ESI
167 | ;delay: mov  EAX, us
168 | ;@@:     dec  EAX
169 | ;        jnz  @b
170 |     ret
171 | 
172 | sense_: mov  AL, 8
173 |     mov  ECX, 1
174 |     call cmd
175 | @@:     call ready
176 |         jns  @b
177 |     in   AL, DX
178 |     out  0e1h, AL
179 |     and  AL, AL
180 | ;    cmp  AL, 80h
181 |     ret
182 | 
183 | seek:   call sense_
184 |         jns  seek
185 |     ret
186 | 
187 | stop: mov  CL, 0ch ; Motor off
188 | onoff: DUP_
189 |     mov  AL, CL
190 |     mov  DX, 3f2h
191 |     out  DX, AL
192 |     out  0e1h, AL
193 |     DROP
194 |     ret
195 | 
196 | dma: mov  word ptr command+1, 3a2h ; l2 s6 u32 ms (e 2)
197 |     mov  AL, 3 ; timing
198 |     mov  CL, 3
199 |     call cmd
200 |     mov  word ptr command+1, 7000h ; +seek -fifo -poll
201 |     mov  AL, 13h ; configure
202 |     mov  CL, 4
203 |     call cmd
204 |     mov  dword ptr command, ECX ; 0
205 |     ret
206 | 
207 | READ: call SEEK
208 |     mov  AL, 0e6h ; Read normal data
209 |     call TRANSFER
210 |     mov  CX, 18*2*512
211 | @@:     call ready
212 |         in   AL, DX
213 |         out  0e1h, AL
214 |         stosb
215 |         next @b
216 |     ret
217 | 
218 | WRITE: call SEEK
219 |     mov  AL, 0c5h ; Write data
220 |     call TRANSFER
221 |     mov  CX, 18*2*512
222 | @@:     call ready
223 |         lodsb
224 |         out  DX, AL
225 |         out  0e1h, AL
226 |         next @b
227 |     ret
228 | 
229 | org 1feh ; Mark boot sector
230 |     dw 0aa55h
231 |     dd 44444444h ; Mark COLOR.COM
232 | 
233 | flop: mov  cylinder, AL ; c-cx
234 |     DUP_
235 |     mov  DX, 3f2h
236 |     in   AL, DX
237 |     out  0e1h, AL
238 |     test AL, 10h
239 |     jnz  @f
240 |         jmp  spin
241 | @@: ret
242 | 
243 | readf: call flop ; ac-ac
244 |     push EDI
245 |     mov  EDI, [ESI+4]
246 |     shl  EDI, 2
247 |     call READ
248 |     pop  EDI
249 | readf1: DROP
250 |     inc  EAX
251 |     add  dword ptr [ESI], 1200h
252 |     ret
253 | 
254 | writef: call flop ; ac-ac
255 |     push ESI
256 |     mov  ESI, [ESI+4]
257 |     shl  ESI, 2
258 |     call WRITE
259 |     pop  ESI
260 |     jmp  readf1
261 | 
262 | seekf: call flop ; c-c
263 | ;    call delay
264 |     call seek
265 |     mov  AL, 0fh
266 |     mov  CL, 3
267 |     call cmd
268 |     call cmdi
269 |     DROP
270 |     ret
271 | 
272 | cmdf: mov  ECX, EAX ; an
273 |     DROP
274 |     lea  EDX, [EAX*4]
275 |     call cmd0
276 |     DROP
277 |     ret
278 | 
279 | readyf: DUP_
280 |     call ready
281 |     DROP
282 |     ret
283 | 


--------------------------------------------------------------------------------
/keyb.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | function $ACCEPT() {
  3 | 	shift = alpha0;
  4 | 	board = alpha;
  5 | 	ret.push($ACCEPT1);
  6 | }
  7 | builtin("accept", $ACCEPT);
  8 | 
  9 | function $ACCEPT1() {
 10 | 	ret.push(() => {
 11 | 		if(tos >= 4){
 12 | 			shift = shift[8];
 13 | 			ret.push($ACCEPT);
 14 | 			ret.push(aword);
 15 | 			ret.push($WORD_);
 16 | 		}else
 17 | 			ret.push(shift[tos]);
 18 | 	});
 19 | 	ret.push($KEY);
 20 | }
 21 | 
 22 | function $nul0() {
 23 | 	DROP();
 24 | 	ret.push($ACCEPT1);
 25 | }
 26 | 
 27 | function $WORD_() {
 28 | 	RIGHT();
 29 | 	words = 1;
 30 | 	chars = 1;
 31 | 	DUP_();
 32 | 	data[data.length - 1] = 0;
 33 | 	bits = 28;
 34 | 	ret.push($WORD1);
 35 | }
 36 | 
 37 | function $WORD0() {
 38 | 	DROP();
 39 | 	ret.push($WORD1);
 40 | 	ret.push($KEY);
 41 | }
 42 | 
 43 | function $WORD1() {
 44 | 	if(!LETTER())
 45 | 		ret.push(shift[tos]);
 46 | 	else{
 47 | 		if(tos != 0){
 48 | 			DUP_();
 49 | 			ECHO_();
 50 | 			PACK();
 51 | 			chars++;
 52 | 		}
 53 | 		DROP();
 54 | 		ret.push($WORD1);
 55 | 		ret.push($KEY);
 56 | 	}
 57 | }
 58 | 
 59 | function ECHO_() {
 60 | 	history_.copyWithin(0, 1);
 61 | 	history_[10] = tos;
 62 | 	DROP();
 63 | }
 64 | 
 65 | function PACK() {
 66 | 	var cl, ch, t;
 67 | 
 68 | 	if(tos >= 0o20){
 69 | 		tos += 0o120;
 70 | 		cl = 7;
 71 | 	}else{
 72 | 		cl = 4;
 73 | 		if((tos & 0o10) != 0){
 74 | 			cl++;
 75 | 			tos ^= 0o30;
 76 | 		}
 77 | 	}
 78 | 	t = tos;
 79 | 	ch = cl;
 80 | 	while(bits < cl){
 81 | 		if((tos & 1) != 0){
 82 | 			tos >>= 1;
 83 | 			data[data.length - 1] <<= bits + 4;
 84 | 			words++;
 85 | 			bits = 28 - ch;
 86 | 			tos = t;
 87 | 			DUP_();
 88 | 			return;
 89 | 		}else{
 90 | 			tos >>= 1;
 91 | 			cl--;
 92 | 		}
 93 | 	}
 94 | 	data[data.length - 1] <<= cl;
 95 | 	data[data.length - 1] ^= tos;
 96 | 	bits -= cl;
 97 | }
 98 | 
 99 | function LJ() {
100 | 	data[data.length - 1] <<= bits + 4;
101 | 	DROP();
102 | }
103 | 
104 | function $X() {
105 | 	RIGHT();
106 | 	tos = words;
107 | 	data.length -= words;
108 | 	DROP();
109 | 	ret.push($ACCEPT);
110 | }
111 | 
112 | function RIGHT() {
113 | 	history_.fill(0);
114 | }
115 | 
116 | function LETTER() {
117 | 	if(tos >= 4){
118 | 		tos = board[tos - 4];
119 | 		return true;
120 | 	}else
121 | 		return false;
122 | }
123 | 
124 | function $ALPHn() { DROP(); ret.push($ALPH0); }
125 | function $ALPH0() {
126 | 	shift = alpha0;
127 | 	board = alpha;
128 | 	DROP();
129 | 	ret.push($ACCEPT1);
130 | }
131 | 
132 | function $STAR0() {
133 | 	shift = graph0;
134 | 	board = graphics;
135 | 	DROP();
136 | 	ret.push($ACCEPT1);
137 | }
138 | 
139 | function $ALPH() {
140 | 	shift = alpha1;
141 | 	board = alpha;
142 | 	ret.push($WORD0);
143 | }
144 | 
145 | function $GRAPH() {
146 | 	shift = graph1;
147 | 	board = graphics;
148 | 	ret.push($WORD0);
149 | }
150 | 
151 | function decimal() {
152 | 	base = 10;
153 | 	shift = numb0;
154 | 	board = numbers;
155 | }
156 | 
157 | function hex() {
158 | 	base = 16;
159 | 	shift = numb0;
160 | 	board = octals;
161 | }
162 | 
163 | function $OCTAL() {
164 | 	if(current == decimal)
165 | 		current = hex;
166 | 	else
167 | 		current = decimal;
168 | 	numb0[6] ^= 0o41 ^ 0o16;
169 | 	current();
170 | 	ret.push($NUMBER0);
171 | }
172 | 
173 | function $Xn() {
174 | 	DROP();
175 | 	DROP();
176 | 	ret.push($ACCEPT);
177 | }
178 | 
179 | function $MINUS() {
180 | 	sign = tos;
181 | 	ret.push($NUMBER2);
182 | }
183 | 
184 | var digit = [
185 | 	14, 10, 0, 0,
186 | 	0, 0, 12, 0, 0, 0, 15, 0,
187 | 	13, 0, 0, 11, 0, 0, 0, 0,
188 | 	0, 1, 2, 3, 4, 5, 6, 7,
189 | 	8, 9
190 | ];
191 | var sign = 0;
192 | 
193 | function $NUMBER0() { DROP(); ret.push($NUMBER3); }
194 | function $NUMBER() { current(); sign = 0; tos = 0; ret.push($NUMBER3); }
195 | function $NUMBER3() {
196 | 	ret.push(() => {
197 | 		if(!LETTER())
198 | 			ret.push(shift[tos]);
199 | 		else if(tos == 0)
200 | 			ret.push($NUMBER0);
201 | 		else{
202 | 			tos = digit[tos-4];
203 | 			if((sign & 0o37) != 0)
204 | 				tos = -tos;
205 | 			data[data.length - 1] = data[data.length - 1] * base + tos;
206 | 			ret.push($NUMBER2);
207 | 		}
208 | 	});
209 | 	ret.push($KEY);
210 | }
211 | function $NUMBER2() {
212 | 	DROP();
213 | 	shift = numb1;
214 | 	ret.push($NUMBER3);
215 | }
216 | 
217 | function $ENDN() {
218 | 	DROP();
219 | 	ret.push($ACCEPT);
220 | 	ret.push(anumber);
221 | }
222 | 
223 | function $EX1() {
224 | 	var r;
225 | 
226 | 	while(--words > 0)
227 | 		DROP();
228 | 	r = forth0.lastIndexOf(tos);
229 | 	if(r < 0)
230 | 		ret.push($ABORT1);
231 | 	else{
232 | 		DROP();
233 | 		ret.push(dict_fn[forth2[r]]);
234 | 	}
235 | }
236 | 
237 | var graph1 = [$WORD0, $X, LJ, $ALPH, 0o25, 0o45, 5, 0];
238 | var graph0 = [$nul0, $nul0, $nul0, $ALPH0, 0, 0, 5, 0, graph1];
239 | var alpha1 = [$WORD0, $X, LJ, $GRAPH, 0o25, 0o45, 0o55, 0];
240 | var alpha0 = [$nul0, $nul0, $NUMBER, $STAR0, 0, 0o41, 0o55, 0, alpha1];
241 | var numb1 = [$NUMBER0, $Xn, $ENDN, $NUMBER0, 0o25, 0o45, 0, 0];
242 | var numb0 = [$nul0, $MINUS, $ALPHn, $OCTAL, 0o43, 5, 0o16, 0, numb1];
243 | var alpha = [
244 | 	0o15, 0o12, 0o01, 0o14,
245 | 	0o24, 0o02, 0o06, 0o10,
246 | 	0o23, 0o11, 0o17, 0o21,
247 | 	0o22, 0o13, 0o16, 0o07,
248 | 	0o05, 0o03, 0o04, 0o26,
249 | 	0o27, 0o44, 0o25, 0o20
250 | ];
251 | var graphics = [
252 | 	0o31, 0o32, 0o33,  0,
253 | 	0o34, 0o35, 0o36, 0o30,
254 | 	0o37, 0o40, 0o41, 0o57,
255 | 	0o51, 0o50, 0o52, 0o54, //g : ; ! @
256 | 	0o46, 0o42, 0o45, 0o56, //g Z J . ,
257 | 	0o55, 0o47, 0o53, 0o43 //g * / + -
258 | ];
259 | var numbers = [
260 | 	0o31, 0o32, 0o33,  0,
261 | 	0o34, 0o35, 0o36, 0o30,
262 | 	0o37, 0o40, 0o41,  0,
263 | 	0,   0 ,  0 ,  0,
264 | 	0,   0 ,  0 ,  0,
265 | 	0,   0 ,  0 ,  0
266 | ];
267 | var octals = [
268 | 	0o31, 0o32, 0o33,  0,
269 | 	0o34, 0o35, 0o36, 0o30,
270 | 	0o37, 0o40, 0o41,  0,
271 | 	0 ,  5 , 0o23, 0o12,
272 | 	0 , 0o20,  4 , 0o16,
273 | 	0 ,  0 ,  0 ,  0
274 | ];
275 | var board = alpha;
276 | var shift = alpha0;
277 | var base = 10;
278 | var current = decimal;
279 | var chars = 1;
280 | var aword = $EX1;
281 | var anumber = nul;
282 | var words = 1;
283 | var bits = 28;
284 | var history_ = new Array(11).fill(0);
285 | 
286 | var keys = {
287 | 	KeyQ: 16,
288 | 	KeyW: 17,
289 | 	KeyE: 18,
290 | 	KeyR: 19,
291 | 	KeyT: 0,
292 | 	KeyY: 0,
293 | 	KeyU: 4,
294 | 	KeyI: 5,
295 | 	KeyO: 6,
296 | 	KeyP: 7,
297 | 	BracketLeft: 0,
298 | 	BracketRight: 0,
299 | 	Enter: 0,
300 | 	ControlLeft: 0,
301 | 	KeyA: 20,
302 | 	KeyS: 21,
303 | 	KeyD: 22,
304 | 	KeyF: 23,
305 | 	KeyG: 0,
306 | 	KeyH: 0,
307 | 	KeyJ: 8,
308 | 	KeyK: 9,
309 | 	KeyL: 10,
310 | 	Semicolon: 11,
311 | 	Quote: 0,
312 | 	Backquote: 0,
313 | //	ShiftLeft: 0,
314 | 	KeyZ: 24,
315 | 	KeyX: 25,
316 | 	KeyC: 26,
317 | 	KeyV: 27,
318 | 	KeyN: 1,
319 | 	KeyM: 12,
320 | 	Comma: 13,
321 | 	Period: 14,
322 | 	Slash: 15,
323 | //	ShiftRight: 0,
324 | 	AltLeft: 3,
325 | 	AltRight: 3,
326 | 	ShiftLeft: 3,
327 | 	ShiftRight: 3,
328 | 	Space: 2
329 | };
330 | var keyqueue = [];
331 | 
332 | function keypressed(e) {
333 | 	keyqueue.push(e.code);
334 | 	wakeup();
335 | }
336 | 
337 | function $KEY() {
338 | 	DUP_();
339 | 	tos = 0;
340 | 	function loop() {
341 | 		let k = keyqueue.shift();
342 | 		if(!(k in keys)){
343 | 			ret.push(loop);
344 | 			ret.push(() => $SLEEP(() => keyqueue.length != 0));
345 | 		}else{
346 | 			tos = keys[k];
347 | 		}
348 | 	}
349 | 	ret.push(loop);
350 | 	ret.push($PAUSE);
351 | }
352 | builtin("key", $KEY);
353 | 


--------------------------------------------------------------------------------
/edit.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | var bas = dot10;
  3 | var blk = 18;
  4 | var curs = 0;
  5 | var cad = 0;
  6 | var pcad = 0;
  7 | var lcad = 0;
  8 | var trash = [];
  9 | var ekbd = [
 10 | 	0o17, 0o01, 0o15, 0o55,
 11 | 	0o14, 0o26, 0o20, 0o01,
 12 | 	0o43, 0o11, 0o12, 0o53,
 13 | 	0o00, 0o70, 0o72, 0o02,
 14 | 	0o00, 0o00, 0o00, 0o00,
 15 | 	0o00, 0o00, 0o00, 0o00,
 16 | ];
 17 | var ekbd0 = [nul, nul, nul, nul, 0o25, 0o45, 7, 0];
 18 | var actc = [
 19 | 	yellow, 0, 0xff0000, 0xc000,
 20 | 	0, 0, 0xffff,
 21 | 	0, 0xffffff, 0xffffff, 0xffffff, 0x8080ff
 22 | ];
 23 | var action = 1;
 24 | 
 25 | function $EDIT() {
 26 | 	blk = tos;
 27 | 	DROP();
 28 | 	ret.push($E);
 29 | }
 30 | builtin("edit", $EDIT);
 31 | function $E() {
 32 | 	DUP_();
 33 | 	tos = blk;
 34 | 	anumber = $FORMAT;
 35 | 	alpha0[4] = 0o45;
 36 | 	alpha0[1] = $E0;
 37 | 	ret.push($E0_);
 38 | 	ret.push($REFRESH);
 39 | }
 40 | builtin("e", $E);
 41 | function $E0() {
 42 | 	DROP();
 43 | 	ret.push($E0_);
 44 | }
 45 | function $E0_() {
 46 | 	shift = ekbd0;
 47 | 	board = ekbd;
 48 | 	keyc = yellow;
 49 | 	function loop() {
 50 | 		ret.push(() => {
 51 | 			ret.push(() => { DROP(); ret.push(loop); });
 52 | 			if(tos < ekeys.length)
 53 | 				ret.push(ekeys[tos]);
 54 | 		});
 55 | 		ret.push($KEY);
 56 | 	}
 57 | 	ret.push(loop);
 58 | }
 59 | 
 60 | function $FORMAT() {
 61 | 	if((action & 0o12) != 0){
 62 | 		DROP();
 63 | 		return;
 64 | 	}
 65 | 	if((tos & 0xFC000000) != 0 && (tos & 0xFC000000) != 0xFC000000){
 66 | 		DUP_();
 67 | 		tos = 1;
 68 | 		if(action != 4)
 69 | 			tos = 3;
 70 | 		if(base != 10)
 71 | 			tos ^= 0o20;
 72 | 		let t = data[data.length - 1];
 73 | 		data[data.length - 1] = tos;
 74 | 		tos = t;
 75 | 		words = 2;
 76 | 	}else{
 77 | 		tos = tos << 5 ^ 2;
 78 | 		if(action != 4)
 79 | 			tos ^= 0o13;
 80 | 		if(base != 10)
 81 | 			tos ^= 0o20;
 82 | 		words = 1;
 83 | 	}
 84 | 	ret.push($INSERT);
 85 | }
 86 | 
 87 | function unPACK() {
 88 | 	DUP_();
 89 | 	if(tos >= 0) {
 90 | 		data[data.length - 1] <<= 4;
 91 | 		tos = tos << 4 | tos >>> 28;
 92 | 		tos &= 7;
 93 | 		return tos;
 94 | 	}
 95 | 	tos <<= 1;
 96 | 	if(tos >= 0){
 97 | 		data[data.length - 1] <<= 5;
 98 | 		tos = tos << 4 | tos >>> 28;
 99 | 		tos = tos & 7 ^ 0o10;
100 | 		return tos;
101 | 	}
102 | 	data[data.length - 1] <<= 7;
103 | 	tos = tos << 6 | tos >>> 26;
104 | 	tos = (tos & 0o77) - 0o20;
105 | 	return tos;
106 | }
107 | builtin("unpack", unPACK);
108 | 
109 | function $INSERT() {
110 | 	var t = insert0();
111 | 	if(t !== undefined)
112 | 		write(t, read(t) ^ action);
113 | 	else
114 | 		console.log("BUG");
115 | 	ret.push($ACCEPT);
116 | }
117 | 
118 | function insert0() {
119 | 	if(((lcad + words ^ lcad) & -0x100) != 0){
120 | 		for(var i = words; i > 0; i--)
121 | 			DROP();
122 | 		return;
123 | 	}
124 | 	if(lcad > cad)
125 | 		memmove(cad + words, cad, lcad - cad);
126 | 	curs = cad + words;
127 | 	var t = curs;
128 | 	for(var i = words; i > 0; i--){
129 | 		write(--t, tos);
130 | 		DROP();
131 | 	}
132 | 	next = t;
133 | 	return t;
134 | }
135 | 
136 | function blank() {
137 | 	xy = [0, 0];
138 | 	DUP_();
139 | 	tos = 0;
140 | 	color();
141 | 	DUP_();
142 | 	tos = hp;
143 | 	DUP_();
144 | 	tos = vp;
145 | 	box();
146 | }
147 | 
148 | function qRING() {
149 | 	DUP_();
150 | 	data[data.length - 1]++;
151 | 	if(curs == next)
152 | 		curs = tos;
153 | 	if(tos != curs){
154 | 		if(tos < curs)
155 | 			pcad = next;
156 | 		DROP();
157 | 		return;
158 | 	}
159 | 	cad = next;
160 | 	xy[1] -= iw;
161 | 	DUP_();
162 | 	tos = 0xe04000;
163 | 	color();
164 | 	tos = 0o60;
165 | 	let c = xy[1] - rm;
166 | 	emit();
167 | 	if(c >= 0) xy[1] -= iw;
168 | }
169 | 
170 | function $REFRESH() {
171 | 	function ref1() {
172 | 		if((read(next) & 0xf) != 0)
173 | 			qRING();
174 | 		var t = read(next++);
175 | 		if((t & 0o20) != 0)
176 | 			bas = dot;
177 | 		else
178 | 			bas = dot10;
179 | 		ret.push(ref1);
180 | 		ret.push(display[t & 0o17]);
181 | 	}
182 | 	ret.push(() => {
183 | 		blank();
184 | 		text1();
185 | 		DUP_();
186 | 		cad = lcad;
187 | 		tos = 0;
188 | 		pcad = blk << 8;
189 | 		next = pcad;
190 | 		ret.push(ref1);
191 | 	});
192 | 	ret.push($SHOW);
193 | }
194 | var display = (function() {
195 | 	function rW() {
196 | 		if(xy[1] != lm)
197 | 			cr();
198 | 		RED();
199 | 		type1();
200 | 	}
201 | 	function gW() { GREEN(); type1(); }
202 | 	function mW() { CYAN(); type1(); }
203 | 	function wW() { DUP_(); tos = yellow; color(); type1(); }
204 | 	function $type0() {
205 | 		xy[1] -= iw;
206 | 		if((read(next - 1) & -0o20) != 0)
207 | 			type1();
208 | 		else{
209 | 			lcad = --next;
210 | 			space();
211 | 			qRING();
212 | 			ret.pop();
213 | 			DROP();
214 | 			ret.push(keyboard);
215 | 		}
216 | 	}
217 | 	function Cap() {
218 | 		WHITE();
219 | 		DUP_();
220 | 		tos = read(next - 1) & -0o20;
221 | 		unPACK();
222 | 		tos += 48;
223 | 		emit();
224 | 		type2();
225 | 	}
226 | 	function CAPS() {
227 | 		WHITE();
228 | 		DUP_();
229 | 		tos = read(next - 1) & -0o20;
230 | 		while(unPACK()){
231 | 			tos += 48;
232 | 			emit();
233 | 		}
234 | 		space();
235 | 		DROP();
236 | 		DROP();
237 | 	}
238 | 	function text() { WHITE(); type1(); }
239 | 	function type1() {
240 | 		DUP_();
241 | 		tos = read(next - 1) & -0o20;
242 | 		type2();
243 | 	}
244 | 	function type2() {
245 | 		while(unPACK())
246 | 			emit();
247 | 		space();
248 | 		DROP();
249 | 		DROP();
250 | 	}
251 | 	function gsW() {
252 | 		gnW1(read(next - 1) >> 5);
253 | 	}
254 | 	function var_() {
255 | 		MAGENTA();
256 | 		type1();
257 | 		gnW();
258 | 	}
259 | 	function gnW() {
260 | 		gnW1(read(next++));
261 | 	}
262 | 	function gnW1(t) {
263 | 		DUP_();
264 | 		tos = bas == dot10 ? 0xf800 : 0xc000;
265 | 		color();
266 | 		DUP_();
267 | 		tos = t;
268 | 		bas();
269 | 	}
270 | 	function sW() {
271 | 		nW1(read(next - 1) >> 5);
272 | 	}
273 | 	function nW() {
274 | 		nW1(read(next++));
275 | 	}
276 | 	function nW1(t) {
277 | 		DUP_();
278 | 		tos = bas == dot10 ? yellow : 0xc0c000;
279 | 		color();
280 | 		DUP_();
281 | 		tos = t;
282 | 		bas();
283 | 	}
284 | 	return [
285 | 		$type0, wW, nW, rW,
286 | 		gW, gnW, gsW, mW,
287 | 		sW, text, Cap, CAPS,
288 | 		var_, nul, nul, nul
289 | 	];
290 | 
291 | })();
292 | 
293 | var ekeys = (function() {
294 | 	function $actn() {
295 | 		keyc = tos;
296 | 		ret.pop();
297 | 		DROP();
298 | 		ret.push($ACCEPT);
299 | 	}
300 | 	function $act(n) {
301 | 		return () => {
302 | 			action = n;
303 | 			tos = actc[action - 1];
304 | 			aword = $INSERT;
305 | 			ret.push($actn);
306 | 		};
307 | 	}
308 | 	function $actv() {
309 | 		action = 12;
310 | 		tos = 0xff00ff;
311 | 		aword = () => {
312 | 			DUP_();
313 | 			tos = 0;
314 | 			words++;
315 | 			ret.push($INSERT);
316 | 		};
317 | 		ret.push($actn);
318 | 	}
319 | 	function mcur() {
320 | 		if(curs > 0)
321 | 			curs--;
322 | 	}
323 | 	function pcur() {
324 | 		curs++;
325 | 	}
326 | 	function mmcur() {
327 | 		if(curs >= 8)
328 | 			curs -= 8;
329 | 		else
330 | 			curs = 0;
331 | 	}
332 | 	function ppcur() {
333 | 		curs += 8;
334 | 	}
335 | 	function pblk() {
336 | 		blk += 2;
337 | 		data[data.length - 1] += 2;
338 | 	}
339 | 	function mblk(){
340 | 		if(blk >= 20){
341 | 			blk -= 2;
342 | 			data[data.length - 1] -= 2;
343 | 		}
344 | 	}
345 | 	function shadow() {
346 | 		blk ^= 1;
347 | 		data[data.length - 1] ^= 1;
348 | 	}
349 | 	function $eout() {
350 | 		ret.pop();
351 | 		ret.pop();
352 | 		DROP();
353 | 		DROP();
354 | 		aword = $EX1;
355 | 		anumber = nul;
356 | 		alpha0[4] = 0;
357 | 		alpha0[1] = $nul0;
358 | 		keyc = yellow;
359 | 		ret.push($ACCEPT);
360 | 	}
361 | 	function enstack() {
362 | 		for(var t = cad - 1; t >= pcad; t--)
363 | 			trash.push(read(t));
364 | 		trash.push(cad - pcad);
365 | 	}
366 | 	function DEL() {
367 | 		enstack();
368 | 		memmove(pcad, cad, lcad - pcad);
369 | 		mcur();
370 | 	}
371 | 	function destack() {
372 | 		if(trash.length == 0)
373 | 			return;
374 | 		words = trash.pop();
375 | 		for(var i = words; i > 0; i--){
376 | 			DUP_();
377 | 			tos = trash.pop();
378 | 		}
379 | 		insert0();
380 | 	}
381 | 	return [
382 | 		nul, DEL, $eout, destack,
383 | 		$act(1), $act(3), $act(4), shadow,
384 | 		mcur, mmcur, ppcur, pcur,
385 | 		mblk, $actv, $act(7), pblk,
386 | 		nul, $act(11), $act(10), $act(9),
387 | 		nul, nul, nul, nul
388 | 	];
389 | })();
390 | 


--------------------------------------------------------------------------------
/icons.js:
--------------------------------------------------------------------------------
  1 | var iconstr = atob(
  2 | `AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  3 | AAAA4/j3/v///Af4AfAA8ADwAPAA8ADwAPAA8ADwAAAAAAAAAAAAA8ADwAPAA8A//D/8P/wDwAPA
  4 | A8ADwAPAA8ADwAPAA8ADwAPAA8ADwAAAAAAAAAAAAAAAAAAAAAAAAAAAH/h//n/++B/wD/AP8A/w
  5 | D/AP8A/4H3/+f/4f+AAAAAAAAAAAAAAAAAAAAAAAAAAAH/h//n/+8A/wD/Af//7//PAA8AD4AH/+
  6 | f/4f+AAAAAAAAAAAAAAAAAAAAAAAAAAAH/h//n/+AB8ADwAPP/9///gP8A/wH3//f/8f9wAAAAAA
  7 | AAAAAAAAAAAAAAAAAAAA4/j3/v/+/B/4D/AP8A/wD/AP8A/wD/AP8A/wDwAAAAAAAAAAA8ADwAPA
  8 | A8AAAAAAAAADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAAAAAAAAAAAAAAAAAAAAAAAAAAAH/h/
  9 | /n/++ALwAPAAf/w//gAPAA9AH3/+f/4f+AAAAAAAAAAAAAAAAAAAAAAAAAAA3Dz+fv/////zz+GH
 10 | 4AfgB+AH4AfgB+AH4AfgBwAAAAAAAAAAAAAAAAAAAAAAAAAAH/h//n/++A/wAfAA8ADwAPAA8AH4
 11 | D3/+f/4f+AAAAAAAAAAAAAAAAAAAAAAAAAAA4AfwD/gffD4+fB/4D/AH4AfAD4AfAD4AfAD4APAA
 12 | 4ADAAIAABwAHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHwAfAA+AB4AAAAAAAAAAAAAAA
 13 | AAAAAAAAAAAAH+d/93//+B/wD/AP8A/wD/gff/9//x//AA8AD2Aff/5//h/4AfAD+AeIB4A/4D/w
 14 | P/AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAAAAAAAAAAAAAAAAAAAAAAAAAAAwAPgB+AH4Afx
 15 | j3GOcY573jvcP/weeB54DDAMMAAAAAAAAAAAAA8ADwAPAA8ADwAPH+9//3//+B/wD/AP8A/wD/AP
 16 | 8A/4H3//f/8f7wAAAAAAAAAAAAAAAAAAAAAAAAAA4AfgB/APcA54HjgcPDwcOB54DnAP8AfgA8AB
 17 | gAAAAAAAAAAAAAAAAAAAAAAAAAAA4/j3/v/+/h/8D/gP8A/wD/gf//7//vf48ADwAPAA8ADwAPAA
 18 | 8ADwAPAA8ADwAPAA9/j//v/++B/wD/AP8A/wD/AP8A/4H//+7/7n+AAAAAAAAAAA8ADwAPAA8ADw
 19 | APAA8/j3/v/+/B/4D/AP8A/wD/AP8A/wD/AP8A/wDwAAAAAAAAAAAAAAAAAAAAAAAAAA8A/4H3w+
 20 | Pnwf+A/wB+AH4A/wH/g+fHw++B/wDwAAAAAAAAAAAAAAAAAAAAAAAAAA8A/wD/AP8A/wD/AP8A/w
 21 | D/AP8A/4H3/+f/4f+AAAAAAAAAAAAAAAAAAAAAAAAAAAH8d/73//+D/wH/AP8A/wD/gff/9//x/v
 22 | AA8ADwAPAA8ADwAOH/h//n/++B/wD/AP8A/wD/AP8A/wD/AP8A/wD/AP8A/4H3/+f/4f+AAAAAAA
 23 | AAAAAeAD4APgB+AH4AXgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AHgAeAB4AAAAAAAAAAAH/h//n/+
 24 | 8B8ADwAPAA8ADwAfH/5//n/4+ADwAPAA8ADwAP///////wAAAAAAAAAAH/h//n/+8B8ADwAPAA8A
 25 | DwAfB/4H/Af+AB8ADwAPAA/wH3/+f/4f+AAAAAAAAAAA8PDw8PDw8PDw8PDw8PDw8PDw////////
 26 | APAA8ADwAPAA8ADwAPAA8AAAAAAAAAAA////////8ADwAPAA8ADwAPAA//j//v/+AB8ADwAPAA/w
 27 | H3/+f/4f+AAAAAAAAAAAH/h//n/++A/wAPAA8ADwAPgA//j//v/++B/wD/AP8A/4H3/+f/4f+AAA
 28 | AAAAAAAA////////AAcADwAfAD4AfAD4AfAD4AfAD4AfAD4AfAD4APAA4ADAAAAAAAAAAAAAH/h/
 29 | /n/++B/wD/AP8A/wD/gff/4//H/++B/wD/AP8A/4H3/+f/4f+AAAAAAAAAAAH/h//n/++B/wD/AP
 30 | 8A/wD/gff/9//x/vAA8ADwAPAA/wH3/+f/4f+AAAAAAAAAAAAHgAeAB4AHgAAAAAAAAAeAB4AHgA
 31 | eAB4AHgAeAB4AHgAeAB4AHgAeBz4H/AP8AfAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAH//f////v/+
 32 | AAAAAAAAAAAAAAAAAAAAAAAA8ADwAPAA8ADwAPAA8Dzw/PP8/+D/gP8A/wD/wP/w8/zw//A/8A/w
 33 | AwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYADwAfgB+ADwAGAAAAAAAAAAAA
 34 | AAAAAAAAAAAAAAAA////////AB8APwD+A/gP4D+A/gD4AP///////wAAAAAAAAAAAA8AHwAfAD4A
 35 | fAB8APgB8AHwA+AHwAfAD4AfAB8APgB8AHwA+AD4AAAAAAAAAAAAAAAAAAAABwAPgB/AH8AfwA+A
 36 | BwAAAAAAAAAHAA+AH8AfwB/AD4AHgAOABwAOABwAAAAAAAAABwAPgB/AH8AfwA+ABwAAAAAAAAAH
 37 | AA+AH8AfwB/AD4AHAAAAAAAAAAAAAYADwAPAB+AH4AfgB+AH4APAA8ABgAGAAYAAAAAAAAADwAPA
 38 | A8ADwAAAAAAAAAAAAAAAAAAAAAAAAAAAA8ADwAPAA8ADwH/+f/5//n/+A8ADwAPAA8ADwAAAAAAA
 39 | AAAAH/h//n/+8A/gB+AH4cfj5+Pn4+fj/+P+4/7h+OAA4ADwD3/+f/4f+AAAAAAAAAAAAAAAAAAA
 40 | AAAAAAAAAAAIMBx4HvAP4AfAA+AH8A94HjgMEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 41 | AAAAAAAAAAAAAAAHAA+AH8AfwB/AD8AHwAOABwAOABwAH/h//n/+8A8ABwAHAA8AfgH+AfgD4APA
 42 | A8AAAAAAAAADwAPAA8ADwAAAAAAAAAAA//D//P/+f/4//x//D/8H/wP/Af8A/wD/AP8A/wH/A/8H
 43 | /w//H/8//3/+//7//P/w//j//v/+///wH/AP8A/wD/Af/////v/+//j/wPfg8/Dx+PD88H7wP/Af
 44 | 8A8AAAAA//////////8DwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8AAAAAAH/h/
 45 | /n/+///4H/AP8A/wD/AP8A/wD/AP8A/wD/AP8A/wD/gf//9//n/+H/gAAAAA///////////wAPAA
 46 | 8ADwAPAA/+D/4P/g/+DwAPAA8ADwAPAA//////////8AAAAAAYABgAPAA8AH4AfgB+AP8A5wDnAe
 47 | eB/4H/g//D/8OBx4HnAO8A/wD+AH4AcAAAAA+A/8D/wP/g/+D/8P9w/3D/eP84/zz/PP8c/x7/Dv
 48 | 8O/w//B/8H/wP/A/8B8AAAAAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8AD
 49 | wAPAA8AAAAAAH/h//n/+///4A/AA8ADwAPgA//h//n/+H/8AHwAPAA8AD8Af//9//n/+H/gAAAAA
 50 | 4AfgB/AP+B/4H/w//n/ud+fn5+fjx+GH4AfgB+AH4AfgB+AH4AfgB+AH4AcAAAAAH/h//n/+///4
 51 | H/AP8ADwAPAA8ADwAPAA8ADwAPAA8ADwD/gf//9//n/+H/gAAAAA4AfwD/APeB54Hjw8PDweeA/w
 52 | D/AH4APAA8ADwAPAA8ADwAPAA8ADwAPAA8AAAAAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADw
 53 | APAA8ADwAPAA//////////8AAAAAH/h//n/+///4H/AP8ADwAPAA8ADwAPA/8D/wP/AP8A/wD/gf
 54 | //9//n/+H/gAAAAA///////////wAPAA8ADwAPAA/+D/4P/g/+DwAPAA8ADwAPAA8ADwAPAA8AAA
 55 | AAAAwAPgB+AH4AfgB3AOcA5wDnAOcA5xjnGOOZw73D/8P/wf+B54HDgcOBgYGBgAAAAA/+D/+P/8
 56 | //7wPvAf8A/wD/AP8A/wD/AP8A/wD/AP8A/wH/A+//7//P/4/+AAAAAA4AfgB/AP8A/wD/gf+B94
 57 | Hnw+fD48PDw8HngeeA/wD/AH4AfgA8ADwAGAAYAAAAAA//j//v/+///wH/AP8A/wD/Af/////v/+
 58 | //jwAPAA8ADwAPAA8ADwAPAA8AAAAAAA/+D/+P/8//7wPvAf8A/wD/Af//7//P/8//7wH/AP8A/w
 59 | H/A+//7//P/4/+AAAAAA8A/wD/AP8A/wD/AP8A/wD/AP///////////wD/AP8A/wD/AP8A/wD/AP
 60 | 8A8AAAAA4AfwD/gfeB58Pj58Hngf+A/wB+AH4AfgB+AP8B/4Hng+fHw+eB74H/AP4AcAAAAA8A/w
 61 | D/AP8A/wD/AP8A/wD/AP8A/wD/AP8A/wD/AP8A/wD/gf//9//n/+H/gAAAAAH/h//n/+///4H/AP
 62 | 8A/wD/AP8A/wD/AP8A/wD/DP8O/wf/g///9//n//H/sAAAAAH/h//n/+f/7gB+AH4AfgB+AH4Afg
 63 | B+AH4AfgB+AH4AfgB+AH4AfgB3/+f/5//h/4AYABgAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGA
 64 | AYABgAGAAYABgAGAAYABgAGAH/h//n/+f/7gB+AHAAcABwAHAAcf/n/+f/5/+OAA4ADgAOAA4ADg
 65 | AP//////////H/h//n/+f/7gB+AHAAcABwAHAAcH/gf+B/4H/gAHAAcABwAH4AfgB3/+f/5//h/4
 66 | 4ODg4ODg4ODg4ODg4ODg4ODg4OD//////////wDgAOAA4ADgAOAA4ADgAOAA4ADg///////////g
 67 | AOAA4ADgAOAA4AD/+P/+//7//gAHAAcABwAH4AfgB3/+f/5//h/4H/h//n/+f/7gB+AH4ADgAOAA
 68 | 4AD/+P/+//7//uAH4AfgB+AH4AfgB3/+f/5//h/4//////////8ADwAeAB4APAB4AHgA8AHgAeAD
 69 | wAeAB4APAB4AHgA8AHgAeADwAOAAH/h//n/+f/7gB+AH4AfgB+AH4Ad//n/+f/5//uAH4AfgB+AH
 70 | 4AfgB3/+f/5//h/4H/h//n/+f/7gB+AH4AfgB+AH4Ad//3//f/8f/wAHAAcABwAH4AfgB3/+f/5/
 71 | /h/4AA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8ADwAPAA8AD/Af//9//n/+H/gAAAAAAAAAAAAA
 72 | AAAAAAAAAAAAAAAAAAD//////////wAAAAAAAAAAAAAAAAAAAAAAAAAA8A/wH/A/8H7x+PPw9+D/
 73 | gP8A/gD8APwA/gD/AP+A9+Dz8PH48H7wP/Af8A8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 74 | AYADwAPAB+AH4APAA8ABgAAAAAAAAAAA//////////8ADwAfAD8AfgD8AfgD8AfgD8AfgD8AfgD8
 75 | APgA//////////8AAAAAAAMABwAHAA4AHgAcADgAeABwAOAB4AHAA4AHgAcADgAeABwAOAB4AHAA
 76 | 4ADgAMAAAAAAAAAAAAAAAAAAAYADgAOAA4ABgAAAAAAAAAAAAYADgAOAA4ABgAGABwAGAAAAAAAA
 77 | AAAAAAAAAAAAAYADgAOAA4ABgAAAAAAAAAAAAYADgAOAA4ABgAAAAAAAAAAAA8ADwAPAA8ADwAPA
 78 | A8ADwAPAA8ADwAPAAYABgAGAAYAAAAAAAAAAAAGAAYABgAGAAYABgAGAAYABgAGAAYABgAGAAYD/
 79 | /////////wGAAYABgAGAAYABgAGAAYABgAGAH/h//n/+f/7gB+AH4Afn5+fn5+fmZ+Zn5mfmZ+f+
 80 | 5/7n/OAA4ADgB3/+f/5//h/4AYABgAGAAYABgAGAA8ADwP////9//h/4D/AH4AfgD/AP8B54Hngc
 81 | OBgYEAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYADgAOAA4ABgAGABwAGAAAA
 82 | ////////////////////////////////////////////////////////////////AAAAAAAAAAAA
 83 | AAAAAAAAAA8AAPAPAAPwDwAP8A8AP/APAP/ADwP/AA8P/AAPP/AAD//AAA//AAAP/AAAD/AAAA/w
 84 | AAAP/AAAD/8AAA//wAAPP/AADw/8AA8D/wAPAP/ADwA/8A8AD/APAAPwDwAA8AAAAAAAAAAAAAAA
 85 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 86 | AAAAAAAAAAAAAAAAAAGAAAAH4AAAB+AAAA/wAAAP8AAAB+AAAAfgAAABgAAAAAAAAAAAAAAAAAAA
 87 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAP///wD///8A////AP///wAAAH4AAA
 88 | D8AAAB+AAAA/AAAAfgAAAPwAAAH4AAAD8AAAB+AAAA/AAAAfgAAAPwAAAH4AAAD8AAAB+AAAA/AA
 89 | AAf///AP///wD///8A////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHAAAADw
 90 | AAAB8AAAA+AAAAfAAAAPgAAAHwAAAD4AAAB8AAAA+AAAAfAAAAPgAAAHwAAAD4AAAB8AAAA+AAAA
 91 | fAAAAPgAAAHwAAAD4AAAB8AAAA+AAAAPAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 92 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAHwAAAB8AAAAfAAAADgAAAAAAAAAAA
 93 | AAAAAAAAAAAAAAOAAAAHwAAAB8AAAAfAAAADgAAAA4AAAA8AAAAOAAAAAAAAAAAAAAAAAAAAAAAA
 94 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAfAAAAHwAAA
 95 | B8AAAAOAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAfAAAAHwAAAB8AAAAOAAAAAAAAAAAAAAAAAAAAA
 96 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAH4AAAB+AAAAfgAAAH4AAAB+AAAAfg
 97 | AAAH4AAAB+AAAAfgAAAH4AAAB+AAAAfgAAADwAAAA8AAAAPAAAADwAAAAAAAAAAAAAAAAAAAAAAA
 98 | AAPAAAADwAAAA8AAAAPAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAPAAAADwAAA
 99 | A8AAAAPAAAADwAAAA8AAAAPAAAADwAAAA8AAAAPAAA////AP///wD///8A////AAA8AAAAPAAAAD
100 | wAAAA8AAAAPAAAADwAAAA8AAAAPAAAADwAAAA8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
101 | AAAAAAAA//8AA///wAf//+AH///gD4AB8A8AAPAPAADwDw/w8A8f+PAPH/jwDxw48A8cOPAPHDjw
102 | Dxw58A8f/+APH//gDw//gA8AAAAPAAAAD4AB8Af//+AH///gA///wAD//wAAAAAAAAAAAAAAAAAA
103 | AAAAAAAAAAAAAAAAAAAAAAAAAAABgAAAAYAAAAGAAAADwAAAA8AAAAPAAAAH4AAAB+AAD///8A//
104 | //AD///AAP//AAA//AAAH/gAAB/4AAA//AAAP/wAAH5+AAB8PgAAeB4AAOAHAADAAwAAAAAAAAAA
105 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
106 | AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAHwAAAB8AAAAfAAAADgAAA
107 | A4AAAA8AAAAOAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAP//8Af///4PAAAPHAAAA7/////////////
108 | ////////////////////////////////////////////////////////////////////////////
109 | //////////////////////////////////////9wAAAOPAAACAgICAgICAgI`
110 | );
111 | 


--------------------------------------------------------------------------------
/gfx.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | var hp = 1024;
  3 | var vp = 768;
  4 | var canvas, ctx;
  5 | var fore, forestr;
  6 | var xc = 0;
  7 | var yc = 0;
  8 | var xy = [3, 3];
  9 | 
 10 | function LRU(N, mask) {
 11 | 	this.N = N;
 12 | 	this.next = new Array(N+1);
 13 | 	this.prev = new Array(N+1);
 14 | 	for(var i = N; i >= 0; i--){
 15 | 		if(i == N || (i & ~mask) == 0){
 16 | 			this.next[i] = i;
 17 | 			this.prev[i] = i;
 18 | 			this.used(i);
 19 | 		}
 20 | 	}
 21 | }
 22 | LRU.prototype.used = function(i) {
 23 | 	this.next[this.prev[i]] = this.next[i];
 24 | 	this.prev[this.next[i]] = this.prev[i];
 25 | 	this.next[i] = this.next[this.N];
 26 | 	this.prev[i] = this.N;
 27 | 	this.next[this.N] = i;
 28 | 	this.prev[this.next[i]] = i;
 29 | }
 30 | LRU.prototype.get = function() {
 31 | 	return this.prev[this.N];
 32 | }
 33 | 
 34 | var fontcache = (function(){
 35 | 	var canvas, ctx, data, buf;
 36 | 	var state = [];
 37 | 	var r = {};
 38 | 	var chars = {};
 39 | 	var N = 256;
 40 | 	var by = 16;
 41 | 	var bmask = N - 1 & ~(by | 1);
 42 | 	var slots = new Array(N);
 43 | 	var lru = new LRU(N, -1);
 44 | 	var lrub = new LRU(N, bmask);
 45 | 	
 46 | 	function sx(i) { return (i & by - 1) * 16; }
 47 | 	function sy(i) { return (i >> 4) * 24; }
 48 | 	r.init = function() {
 49 | 		canvas = document.createElement('canvas');
 50 | 		canvas.width = by*16;
 51 | 		canvas.height = (N/by|0)*24;
 52 | 		ctx = canvas.getContext('2d');
 53 | 		data = ctx.createImageData(16*2, 24*2);
 54 | 		buf = new Uint32Array(data.data.buffer);
 55 | 		for(var i = 0; i < 64; i++)
 56 | 			slots[i] = '';
 57 | 	};
 58 | 	function used(i, big) {
 59 | 		lru.used(i);
 60 | 		lrub.used(i & bmask);
 61 | 		if(big){
 62 | 			lru.used(i ^ 1);
 63 | 			lru.used(i ^ by);
 64 | 			lru.used(i ^ by ^ 1);
 65 | 		}
 66 | 	}
 67 | 	function set1(i, ch, col, big) {
 68 | 		delete chars[slots[i]];
 69 | 		slots[i] = [ch, col, big].toString();
 70 | 	}
 71 | 	function set(i, ch, col, big) {
 72 | 		set1(i, ch, col, big);
 73 | 		if(big){
 74 | 			set1(i^1, ch, col, big);
 75 | 			set1(i^by, ch, col, big);
 76 | 			set1(i^by^1, ch, col, big);
 77 | 		}
 78 | 	}
 79 | 	function populate(i, ch, col, big) {
 80 | 		var l = 12*256 + 16*24/(8*4)*tos;
 81 | 		var p = 0;
 82 | 		var w;
 83 | 		for(var y = 24; --y >= 0; ){
 84 | 			if((y & 1) != 0){
 85 | 				w = read(l++);
 86 | 				w = w << 16 | w >>> 16;
 87 | 				w = w << 8 & 0xff00ff00 | w >> 8 & 0x00ff00ff;
 88 | 			}
 89 | 			for(var x = 16; --x >= 0; ){
 90 | 				if(big){
 91 | 					buf[p] = w >> 31 ? col : 0;
 92 | 					buf[p+1] = w >> 31 ? col : 0;
 93 | 					buf[p+32] = w >> 31 ? col : 0;
 94 | 					buf[p+33] = w >> 31 ? col : 0;
 95 | 					p += 2;
 96 | 				}else{
 97 | 					buf[p++] = w >> 31 ? col : 0;
 98 | 				}
 99 | 				w <<= 1;
100 | 			}
101 | 			if(big)
102 | 				p += 32;
103 | 			else
104 | 				p += 16;
105 | 		}
106 | 		if(big)
107 | 			ctx.putImageData(data, sx(i), sy(i));
108 | 		else
109 | 			ctx.putImageData(data, sx(i), sy(i), 0, 0, 16, 24);
110 | 	};
111 | 	function get(ch, col, big) {
112 | 		var s = [ch, col, big].toString();
113 | 		var i = chars[s];
114 | 		if(i === undefined){
115 | 			i = big ? lrub.get() : lru.get();
116 | 			chars[s] = i;
117 | 			set(i, ch, col, big);
118 | 			populate(i, ch, col, big);
119 | 		}
120 | 		used(i, big);
121 | 		return i;
122 | 	}
123 | 	r.draw = function(targctx, x, y, ch, col, big) {
124 | 		var i = get(ch, col, big);
125 | 		if(big)
126 | 			targctx.drawImage(canvas, sx(i), sy(i), 32, 48, x, y, 32, 48);
127 | 		else
128 | 			targctx.drawImage(canvas, sx(i), sy(i), 16, 24, x, y, 16, 24);
129 | 	};
130 | 	return r;
131 | })();
132 | 
133 | function color() {
134 | 	fore = tos << 16 & 0xff0000 | tos & 0xff00 | tos >> 16 & 0xff | 0xff << 24;
135 | 	var s = (tos & 0xffffff).toString(16);
136 | 	s = "#" + "0".repeat(6 - s.length) + s;
137 | 	forestr = s;
138 | 	DROP();
139 | }
140 | builtin("color", color);
141 | 
142 | function gfxinit() {
143 | 	canvas = document.getElementById('canvas');
144 | 	canvas.addEventListener('keydown', keypressed);
145 | 	ctx = canvas.getContext('2d');
146 | 	ctx.imageSmoothingEnabled = false;
147 | 	fontcache.init();
148 | }
149 | 
150 | function $SWITCH() {
151 | 	ret.push($PAUSE);
152 | }
153 | 
154 | function AT() {
155 | 	xy[0] = tos & 0xffff;
156 | 	DROP();
157 | 	xy[1] = tos & 0xffff;
158 | 	DROP();
159 | }
160 | builtin("at", AT);
161 | 
162 | function pAT() {
163 | 	xy[0] = xy[0] + tos & 0xffff;
164 | 	DROP();
165 | 	xy[1] = xy[1] + tos & 0xffff;
166 | 	DROP();
167 | }
168 | builtin("+at", pAT);
169 | 
170 | function xy_() {
171 | 	DUP_();
172 | 	tos = xy[0] & 0xffff | xy[1] << 16;
173 | }
174 | builtin("xy", xy_);
175 | 
176 | function clip() {
177 | 	yc = xy[0];
178 | 	if((yc & 0x8000) != 0) yc = 0;
179 | 	yc &= 0xffff;
180 | 	xc = xy[1];
181 | 	if((xc & 0x8000) != 0) xc = 0;
182 | 	xc &= 0xffff;
183 | 	return [yc, xc];
184 | }
185 | 
186 | function box() {
187 | 	var d, x, y;
188 | 
189 | 	d = clip();
190 | 	y = tos;
191 | 	DROP();
192 | 	x = tos;
193 | 	DROP();
194 | 	if(y > vp) y = vp;
195 | 	y -= yc;
196 | 	if(y < 0) return;
197 | 	if(x > hp) x = hp;
198 | 	x -= xc;
199 | 	if(x < 0) return;
200 | 	ctx.fillStyle = forestr;
201 | 	ctx.fillRect(d[1], d[0], x, y);
202 | }
203 | builtin("box", box);
204 | 
205 | function line() {
206 | 	var d, n;
207 | 
208 | 	d = clip();
209 | 	n = tos;
210 | 	DROP();
211 | 	d -= tos;
212 | 	DROP();
213 | 	ctx.fillStyle = forestr;
214 | 	ctx.fillRect(d[1], d[0], x, 1);
215 | 	xy[0]++;
216 | }
217 | builtin("line", line);
218 | 
219 | var iw = 16 + 6;
220 | var ih = 24 + 6;
221 | var hc = hp / iw | 0;
222 | var vc = vp / ih | 0;
223 | var lm = 3;
224 | var rm = hc * iw;
225 | var xycr = 0;
226 | 
227 | function emit() {
228 | 	qcr();
229 | 	var d = clip();
230 | 	fontcache.draw(ctx, d[1], d[0], tos, fore, false);
231 | 	DROP();
232 | 	xy[1] += iw;
233 | }
234 | builtin("emit", emit);
235 | 
236 | function emit2() {
237 | 	var d = clip();
238 | 	fontcache.draw(ctx, d[1], d[0], tos, fore, true);
239 | 	DROP();
240 | 	xy[1] += iw*2;
241 | }
242 | builtin("2emit", emit2);
243 | 
244 | function text1() {
245 | 	WHITE();
246 | 	lm = 3;
247 | 	rm = hc * iw;
248 | 	xy = [3, lm];
249 | 	xycr = [3, lm];
250 | }
251 | builtin("text", text1);
252 | 
253 | function qcr() {
254 | 	if(xy[1] >= rm) cr();
255 | }
256 | function cr() {
257 | 	xy[0] += ih;
258 | 	xy[1] = lm;
259 | }
260 | builtin("cr", cr);
261 | 
262 | function space() {
263 | 	xy[1] += iw;
264 | }
265 | builtin("space", space);
266 | 
267 | function qdot() { if(base != 10) dot(); else dot10(); }
268 | var tens = [ 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000 ];
269 | function dot10() {
270 | 	var d, i;
271 | 
272 | 	d = tos;
273 | 	if(d < 0){
274 | 		d = -d;
275 | 		DUP_();
276 | 		tos = 0o43;
277 | 		emit();
278 | 	}
279 | 	for(i = 8; i >= 0; i--){
280 | 		tos = d / tens[i] | 0;
281 | 		d %= tens[i];
282 | 		if(tos != 0)
283 | 			break;
284 | 	}
285 | 	if(i >= 0){
286 | 		eDIG1();
287 | 		while(--i >= 0){
288 | 			tos = d / tens[i] | 0;
289 | 			d %= tens[i];
290 | 			eDIG1();
291 | 		}
292 | 	}
293 | 	tos = d;
294 | 	eDIG1();
295 | 	space();
296 | 	DROP();
297 | }
298 | builtin(".", dot10);
299 | 
300 | var hicon = [
301 | 	0o30, 0o31, 0o32, 0o33, 0o34, 0o35, 0o36, 0o37,
302 | 	0o40, 0o41, 0o05, 0o23, 0o12, 0o20, 0o04, 0o16
303 | ];
304 | 	
305 | function eDIG1() { DUP_(); eDIG(); }
306 | function eDIG() {
307 | 	tos = hicon[tos];
308 | 	emit();
309 | }
310 | builtin("digit", eDIG);
311 | function oDIG() {
312 | 	tos = tos << 4 | tos >>> 28;
313 | 	DUP_();
314 | 	tos &= 0xf;
315 | 	return tos;
316 | }
317 | function dot() {
318 | 	var i;
319 | 
320 | 	for(i = 7; i > 0; i--){
321 | 		if(oDIG())
322 | 			break;
323 | 		DROP();
324 | 	}
325 | 	if(i <= 0)
326 | 		oDIG();
327 | 	i++;
328 | 	for(;;){
329 | 		eDIG();
330 | 		if(--i <= 0) break;
331 | 		oDIG();
332 | 	}
333 | 	space();
334 | 	DROP();
335 | 	return;
336 | }
337 | function hdotn() {
338 | 	var n = tos;
339 | 	DROP();
340 | 	tos = tos << 32 - n * 4 | tos >>> n * 4;
341 | 	for(; n > 0; n--){
342 | 		oDIG();
343 | 		eDIG();
344 | 	}
345 | 	DROP();
346 | }
347 | builtin("h.n", hdotn);
348 | function hdot() {
349 | 	for(var i = 8; i > 0; i--){
350 | 		oDIG();
351 | 		eDIG();
352 | 	}
353 | 	DROP();
354 | }
355 | builtin("h.", hdot);
356 | 
357 | function keyboard() {
358 | 	text1();
359 | 	DUP_();
360 | 	tos = keyc;
361 | 	color();
362 | 	rm = hc * iw;
363 | 	lm = hp - 9 * iw + 3;
364 | 	xy = [vp-4*ih+3, hp-9*iw+3];
365 | 	var k = 0;
366 | 	for(var i = 0; i < 3; i++){
367 | 		k += 12;
368 | 		for(var j = 0; j < 4; j++){
369 | 			DUP_();
370 | 			tos = board[k++];
371 | 			emit();
372 | 		}
373 | 		space();
374 | 		k -= 16;
375 | 		for(var j = 0; j < 4; j++){
376 | 			DUP_();
377 | 			tos = board[k++];
378 | 			emit();
379 | 		}
380 | 	}
381 | 	cr();
382 | 	xy[1] += 4 * iw;
383 | 	var k = 4;
384 | 	for(var j = 0; j < 3; j++){
385 | 		DUP_();
386 | 		tos = shift[k++];
387 | 		emit();
388 | 	}
389 | 	lm = 3;
390 | 	xy[1] = 3;
391 | 	for(var i = 0; i < god_data.length - 1; i++){
392 | 		DUP_();
393 | 		tos = god_data[i];
394 | 		qdot();
395 | 	}
396 | 	xy[1] = hp - (11 + 9) * iw + 3;
397 | 	for(var j = 0; j < 11; j++){
398 | 		DUP_();
399 | 		tos = history_[j];
400 | 		emit();
401 | 	}
402 | }
403 | builtin("keyboard", keyboard);
404 | 
405 | function $pad() {
406 | 	board = [];
407 | 	var t = tos + 28 * 2;
408 | 	var v = dict[t];
409 | 	shift = [nul, nul, nul, nul, v&0xff, v>>8&0xff, v>>16&0xff, v>>24&0xff];
410 | 	t++;
411 | 	for(var i = 0; i < 28; i++)
412 | 		board.push(dict[t + (i>>2)] >> ((i & 3) << 3) & 0xff);
413 | 	t = tos + 1;
414 | 	DROP();
415 | 	function loop(){
416 | 		ret.push(() => {
417 | 			let n = dict[t + 2*tos];
418 | 			DROP();
419 | 			ret.push(loop);
420 | 			ret.push(forth2[n]);
421 | 		});
422 | 		ret.push($KEY);
423 | 	}
424 | 	ret.push(loop);
425 | }
426 | var pad_fn = forth2.length;
427 | builtin(".pad", $pad);
428 | 
429 | function mpad() {
430 | 	dict[here] = INS_DUP;
431 | 	dict[here+1] = INS_SETTOS;
432 | 	dict[here+2] = here + 6;
433 | 	dict[here+3] = INS_FORTH;
434 | 	dict[here+4] = pad_fn;
435 | 	dict[here+5] = INS_SEMI;
436 | 	here += 6;
437 | }
438 | builtin_macro("pad", mpad);
439 | 
440 | var yellow = 0xffff00;
441 | function WHITE() { DUP_(); tos = 0xffffff; color(); }
442 | function CYAN() { DUP_(); tos = 0xffff; color(); }
443 | function MAGENTA() { DUP_(); tos = 0xff00ff; color(); }
444 | function SILVER() { DUP_(); tos = 0xc0c0c0; color(); }
445 | function BLUE() { DUP_(); tos = 0x4040ff; color(); }
446 | function RED() { DUP_(); tos = 0xff0000; color(); }
447 | function GREEN() { DUP_(); tos = 0x8000ff00; color(); }
448 | var keyc = yellow;
449 | 


--------------------------------------------------------------------------------
/init.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | /*
  3 |    ( white words )
  4 |    [ yellow words ]
  5 |    [[ cyan words ]]
  6 |    : redword 
  7 |    & magentaword 12345
  8 |    
  9 |    #16  switch block 
 10 |    $2A  hex constant
 11 |    \0   number as text word (not number)
 12 |    \:   colon as word (not define)
 13 |    =expr  replaced with eval("expr")
 14 | */
 15 | 
 16 | var forth = `
 17 | #18
 18 | ( jscolorforth )
 19 | [ 24 load 26 load 28 load 30 load ] 
 20 | : dump 32 load ; 
 21 | : icons 34 load ; 
 22 | : pi 40 load ;
 23 | : colors 56 load ;
 24 | [ mark empty ] 
 25 | #24
 26 | ( Wordcode ) [ macro ] 
 27 | : t! =INS_TBANG , , [[ drop ]] ;
 28 | : t@ [[ ?dup ]] =INS_TAT , , ;
 29 | : swap 0 [[ t! ]] 1 [[ t! ]] 0 [[ t@ ]] 1 [[ t@ ]] ;
 30 | : if =INS_JNO , $0 , here ;
 31 | : 2* =INS_LSH , ;
 32 | : 2/ =INS_ASR , ;
 33 | : @ =INS_AT , ;
 34 | : ! =INS_BANG , [[ drop drop ]] ;
 35 | : nip =INS_NIP , ;
 36 | : + =INS_ADD , ;
 37 | : or =INS_OR , ;
 38 | : and =INS_AND , ;
 39 | : u+ =INS_UPLUS , [[ drop ]] ;
 40 | : ? =INS_TEST , [[ drop ]] ;
 41 | : less =INS_LESS , ;
 42 | : over [[ ?dup ]] =INS_OVER , ;
 43 | : push =INS_PUSH , [[ drop ]] ;
 44 | : pop [[ ?dup ]] =INS_POP , ;
 45 | : - =INS_NOT , ;
 46 | #25
 47 | ( Wordcode macros: , compiles 1 word )
 48 | : t! ( set temporary )
 49 | : t@ ( read temporary )
 50 | : if ( uses global flag )
 51 | : then ( fix address - in kernel )
 52 | : u+ ( add to 2nd number )
 53 | #26
 54 | ( macros ) 
 55 | : for [[ push begin ]] ;
 56 | : next =INS_NEXT , , ;
 57 | : -next =INS_0NEXT , , ;
 58 | : i [[ ?dup ]] =INS_POP , =INS_PUSH , ;
 59 | : +! =INS_TBANG , 0 , [[ @ + ]] 0 [[ t@ ! ]] ;
 60 | : or! =INS_TBANG , 0 , [[ @ or ]] 0 [[ t@ ! ]] ;
 61 | : nop =INS_NOP , ;
 62 | : * =INS_MUL , ;
 63 | : */ =INS_MULDIV , [[ nip nip ]] ;
 64 | : / =INS_DIV , ;
 65 | : mod =INS_MOD , ;
 66 | : /mod [[ over over mod ]] 0 [[ t! / ]] 0 [[ t@ ]] ;
 67 | #27
 68 | #28
 69 | ( Compiled macros ) 
 70 | [ forth ] 
 71 | : @ @ ; 
 72 | : ! ! ;
 73 | : + + ;
 74 | : */ */ ;
 75 | : * * ;
 76 | : / / ;
 77 | : 2* 2* ;
 78 | : 2/ 2/ ;
 79 | : dup dup ; ( Arithmetic ) 
 80 | : negate - 1 + ; 
 81 | : min less if drop ; then swap drop ; 
 82 | : abs dup negate 
 83 | : max less if swap then drop ; 
 84 | : v+ ( vv-v ) push u+ pop + ; 
 85 | : writes ( acn ) for write next drop drop ;
 86 | : reads ( acn ) for read next drop drop ;
 87 | : rest 0 dup nc reads ;
 88 | : oadf ( qwerty )
 89 | : save 0 dup nc writes ;
 90 | #29
 91 | ( These macros may be white, others may not ) 
 92 | : @ etc ( Arithmetic ) 
 93 | : negate n-n ( when you just cant use ) - 
 94 | : min nn-n ( minimum ) 
 95 | : abs n-u ( absolute value ) 
 96 | : max nn-n ( maximum ) 
 97 | : v+ vv-v ( add 2-vectors ) 
 98 | : nc -a ( number of cylinders booted ) 
 99 | : save ( write colorforth to bootable floppy ) 
100 | : oadf ( save as spelled by qwerty. For typing with blank screen ) 
101 | #30
102 | ( Colors etc ) 
103 | : block $100 * ; 
104 | : white $ffffff color ; 
105 | : red $ff0000 color ; 
106 | : green $ff00 color ; 
107 | : blue $ff color ; 
108 | : silver $bfbfbf color ; 
109 | : black 0 color ; 
110 | : screen 0 dup at 1024 768 box ; 
111 | : 5* 5 for 2emit next ; 
112 | : cf 25 dup at red $1 $3 $c $3 $a 5* green $14 $2 $1 $3 $3e 5* ; 
113 | : logo show black screen 800 710 blue box 600 50 at 1024 620 red box 200 100 at 700 500 green box text cf keyboard ; 
114 | : empty empt logo ; 
115 | #31
116 | 
117 | : block n-a ( block number to word address ) 
118 | : colors ( specified as rgb: 888 ) 
119 | : screen ( fills screen with current color ) 
120 | : at xy ( set current screen position ) 
121 | : box xy ( lower-right of colored rectangle ) 
122 | : dump ( compiles memory display ) 
123 | : print ( compiles screen print ) 
124 | : icon ( compiles icon editor ) 
125 | : logo ( displays colorforth logo ) 
126 | : show ( background task executes following code repeatedly ) 
127 | : keyboard ( displays keypad and stack ) 
128 | #32
129 | ( Dump ) & x 2097152 & y 2101760 
130 | : one dup @ h. space dup h. cr ; 
131 | : lines for one 4294967295 + next drop ; 
132 | : dump x ! 
133 | : r show black screen x @ 15 + 16 text lines keyboard ; 
134 | : it @ + @ dup h. space ; 
135 | : lines for white i [ x ] it i [ y ] it or drop if red then i . cr -next ; 
136 | : cmp show blue screen text 19 lines red [ x ] @ h. space [ y ] @ h. keyboard ; 
137 | : u 16 
138 | : +xy dup [ x ] +! [ y ] +! ; 
139 | : d 4294967280 +xy ; 
140 | : byte 4 / dump ; 
141 | : fix for 0 over ! 1 + next ; [ dump ] 
142 | #33
143 | ( Does not say empty, compiles on top of application ) 
144 | : x -a ( current address ) 
145 | : one a-a ( line of display ) 
146 | : lines an 
147 | : dump a ( background task continually displays memory ) 
148 | : u ( increment address ) 
149 | : d ( decrement ) 
150 | : byte a ( byte address dump ) 
151 | : fix an-a ( test word ) 
152 | #34
153 | ( Icons ) [ empty macro ] 
154 | ( @w !w *byte )
155 | [ forth ] & ic 0 & cu 351 
156 | : sq xy $10000 /mod 16 + swap 16 + box 17 0 +at ; 
157 | : loc [ ic ] @ [ 16 24 8 */ ] * [ 12 block 4 * ] + ; 
158 | : 0/1 $8000 ? if green sq ; then blue sq ; 
159 | : row dup @w *byte 16 for 0/1 2* next drop [ 4294967279 16 * ] 17 +at ; 
160 | : ikon loc 24 for row 2 + next drop ; 
161 | : adj 17 * swap ; 
162 | : cursor [ cu ] @ 16 /mod adj adj over over at red 52 u+ 52 + box ; 
163 | : ok show black screen cursor 18 dup at ikon text [ ic ] @ . keyboard ; [ 36 load ok h ] 
164 | #35
165 | ( Draw big-bits icon ) 
166 | : @w a-n ( fetch 16-bit word from byte address ) 
167 | : !w na ( store same ) 
168 | : *byte n-n ( swap bytes ) 
169 | : ic -a ( current icon ) 
170 | : cu -a ( cursor ) 
171 | : sq ( draw small square ) 
172 | : xy -a ( current screen position, set by ) at 
173 | : loc -a ( location of current icons bit-map ) 
174 | : 0/1 n-n ( color square depending on bit 15 ) 
175 | : row a-a ( draw row of icon ) 
176 | : +at nn ( relative change to screen position ) 
177 | : ikon ( draw big-bits icon ) 
178 | : adj nn-nn ( magnify cursor position ) 
179 | : cursor ( draw red box for cursor ) 
180 | : ok ( background task to continually draw icon, icon number at top ) 
181 | #36
182 | ( Edit ) 
183 | : +ic 1 [ ic ] +! ; 
184 | : -ic [ ic ] @ 4294967295 + 0 max [ ic ] ! ; 
185 | : bit [ cu ] @ 2/ 2/ 2/ 2/ 2* loc + $10000 [ cu ] @ $f and 1 + for 2/ next *byte ; 
186 | : toggle bit over @w or swap !w ; 
187 | : td toggle 
188 | : d 16 
189 | : wrap [ cu ] @ + [ 16 24 * ] dup u+ /mod drop [ cu ] ! ; 
190 | : tu toggle 
191 | : u 4294967280 wrap ; 
192 | : tr toggle 
193 | : r 1 wrap ; 
194 | : tl toggle 
195 | : l 4294967295 wrap ; 
196 | : nul ; 
197 | : h pad nul nul accept nul tl tu td tr l u d r -ic nul nul +ic nul nul nul nul nul nul nul nul nul nul nul nul [ $2500 , $110160c dup , , $2b000023 , 0 , 0 , 0 , ] 
198 | #37
199 | ( Edit icon ) 
200 | #38
201 | #40
202 | ( Calculate Pi )
203 | & c 0 
204 | & b 0
205 | : a 64 256 * ;
206 | : init c @ 4294967295 + for 2000 a i + ! -next ;
207 | : g b @ 2* 4294967295 + ;
208 | : d1 b @ * b @ a + @ 10000 * + ;
209 | : si b @ for i b ! d1 g /mod b @ a + ! next ;
210 | : o1 c @ 4294967282 + dup c ! 4294967295 + b ! 10000 mod dup ;
211 | : o2 10000 /mod push + . drop pop ;
212 | : loop c @ 15 less drop drop if ; then o1 si o2 loop ;
213 | : show0 show nop ;
214 | : ok show0 black screen text init 0 loop key empty ;
215 | [ 200 14 * c ! ok ]
216 | #42
217 | #44
218 | #45
219 | #46
220 | #48
221 | ( ASCII ) [ macro ] 
222 | ( 1@ ) [ forth ] 
223 | : string pop ; 
224 | : cf-ii string [ $6f747200 , $696e6165 , $79636d73 , $7766676c , $62707664 , $71757868 , $336a7a6b , $37363534 , $2d313938 , $2f322e30 , $2b213a3b , $3f2c2a40 , ] 
225 | : ch $fffffff0 and unpack [ cf-ii ] + 1@ $ff and ; 
226 | : ii-cf string [ $2a00 , 0 , $2b2d0000 , $2725232e , $1b262224 , $1f1e1d1c , $28292120 , $2f000000 , $3a43355c , $3d3e3440 , $484a3744 , $3336393c , $38314742 , $3f414632 , $493b45 , 0 , $a13052c , $d0e0410 , $181a0714 , $306090c , $8011712 , $f111602 , $190b15 , ] 
227 | : chc $ffffffe0 + [ ii-cf ] + 1@ $ff and ; 
228 | #50
229 | ( Clock ) [ macro ] 
230 | ( p@ ) 
231 | ( p! ) [ forth ] 
232 | : ca $70 a! p! $71 a! ; 
233 | : c@ ca 0 p@ ; 
234 | : c! ca p! ; 
235 | : hi 10 c@ $80 and drop if ; then hi ; 
236 | : lo 0 p@ $80 and drop if lo ; then ; 
237 | : bcd c@ 16 /mod 10 * + ; 
238 | : hms0 4 bcd 100 * 2 bcd + 100 * 0 bcd + ; 
239 | : hms hms0 2 ms dup hms0 or drop if drop hms ; then ; 
240 | : ymd 9 bcd 100 * 8 bcd + 100 * 7 bcd + ; 
241 | : day 6 c@ 4294967295 + ; 
242 | : cal hi lo time - hi lo time + ( 748 ) ; 
243 | #52
244 | #54
245 | #55
246 | #56
247 | ( Hexagon ) [ empty ] & col 0 & del 2105376 
248 | : lin dup 2/ 2/ dup 2* line ; 
249 | : hex xy 7 and over 2/ for lin 7 + next over for lin next swap 2/ for 4294967289 + lin next drop ; 
250 | : +del [ del ] @ nop 
251 | : petal and [ col ] @ + $f8f8f8 and color 100 hex ; 
252 | : -del [ del ] @ $f8f8f8 or $80808 + ; 
253 | : rose 0 +del 4294967120 4294967096 +at $f80000 -del petal 352 4294967096 +at $f80000 +del 4294967032 4294966947 +at $f800 -del petal 176 4294967096 +at $f8 +del 4294967120 98 +at $f8 -del petal 176 4294967096 +at $f800 +del ; 
254 | : ok show black screen 512 282 at rose text [ col ] @ h. space [ del ] @ $ff and . keyboard ; [ 58 load ok h ] 
255 | #57
256 | ( Draws 7 hexagons. Colors differ along red, green and blue axes. ) 
257 | : col ( color of center hexagon ) 
258 | : del ( color difference ) 
259 | : lin n ( draws 1 horizontal line of a hexagon ) 
260 | : hex n ( draws top, center and bottom. Slope 7 x to 4 y is 1.750 compared to 1.732 ) 
261 | : +del n ( increment color ) 
262 | : -del n 
263 | : petal n ( draw colored hexagon ) 
264 | : rose ( draw 7 hexagons ) 
265 | : ok ( describe screen. Center color at top ) 
266 | #58
267 | ( Pan ) 
268 | : in [ del ] @ 2* $404040 min [ del ] ! ; 
269 | : out [ del ] @ 2/ $80808 max [ del ] ! ; 
270 | : r $f80000 
271 | : +del [ del ] @ 
272 | : +col and [ col ] @ + $f8f8f8 and [ col ] ! ; 
273 | : g $f800 +del ; 
274 | : b $f8 +del ; 
275 | : -r $f80000 -del +col ; 
276 | : -g $f800 -del +col ; 
277 | : -b $f8 -del +col ; 
278 | : nul ; 
279 | : h pad nul nul accept nul -r -g -b nul r g b nul out nul nul in nul nul nul nul nul nul nul nul nul nul nul nul [ $250000 , $130d01 dup , , $2b000023 , 0 , 0 , 0 , ] 
280 | #59
281 | : in ( increment color difference ) 
282 | : out ( decrement it ) 
283 | : r 
284 | : g 
285 | : b ( increment center color ) 
286 | : -r 
287 | : -g 
288 | : -b ( decrement it ) 
289 | : +del ( redefine with ; ) 
290 | : +col ( change center color ) 
291 | : nul ( ignore ) 
292 | : h ( describe keypad ) 
293 | #62
294 | ( Timing ) [ empty macro ] 
295 | ( out ) [ forth ] 
296 | : tare time - 1000 for next time + ; 
297 | : tare+ time - push 1000 for dup next c pop time + ; 
298 | : test tare time + - 1000 for out next time + ; ( next 3 loop 5.7 /next 2 /swap 25 swap 7.2 ) [ macro ] 
299 | : c! $c88b 2, [[ drop ]] here ; 
300 | : loop $49 1, $75 1, ( e2 ) here - + 1, ; [ forth ] 
301 | : try time - 1000 c! loop time + ; 
302 | `;
303 | 
304 | function ctz(n) {
305 | 	var k;
306 | 	for(k = 0; (n & 1) == 0; k++)
307 | 		n >>= 1;
308 | 	return k;
309 | }
310 | 
311 | function dechuck(w){
312 | 	var s, c;
313 | 
314 | 	s = '';
315 | 	for(;;){
316 | 		if(w>>31 == 0){
317 | 			c = w >> 28 & 7;
318 | 			w <<= 4;
319 | 			if(c == 0)
320 | 				return s;
321 | 			s += ' rtoeani'[c];
322 | 		}else if((w >> 30 & 3) == 2){
323 | 			c = w >> 27 & 7;
324 | 			w <<= 5;
325 | 			s += 'smcylgfw'[c];
326 | 		}else{
327 | 			c = w >> 25 & 31;
328 | 			w <<= 7;
329 | 			s += 'dvpbhxuq0123456789j-k.z/;:!+@*,?'[c];
330 | 		}
331 | 	}
332 | }
333 | 
334 | function do_comment(w) {
335 | 	if(w[0] == '\\') w = w.substr(1);
336 | 	var r = enchuck(w.toLowerCase());
337 | 	if(w.match(/^[a-z0-9\-./;:!+@*,?]+$/))
338 | 		r[0] |= 9;
339 | 	else if(w.match(/^[A-Z0-9\-./;:!+@*,?]+$/))
340 | 		r[0] |= 11;
341 | 	else if(w.match(/^[A-Z0-9\-./;:!+@*,?][a-z0-9\-./;:!+@*,?]+$/))
342 | 		r[0] |= 10;
343 | 	else
344 | 		throw 'invalid comment word ' + w;
345 | 	return r;
346 | }
347 | 
348 | function do_number(w, hex, execute, magenta) {
349 | 	if(magenta)
350 | 		return [w];
351 | 	if(w >> 26 == 0 || w >> 26 == -1)
352 | 		return [w << 5 | hex << 4 | (execute ? 8 : 6)];
353 | 	else
354 | 		return [hex << 4 | (execute ? 2 : 5), w];
355 | }
356 | 
357 | function do_word(w, execute, cyan, next) {
358 | 	var r = enchuck(w);
359 | 	if(next == 'red')
360 | 		r[0] |= 3;
361 | 	else if(next == 'magenta')
362 | 		r[0] |= 12;
363 | 	else if(execute)
364 | 		r[0] |= 1;
365 | 	else if(cyan)
366 | 		r[0] |= 7;
367 | 	else
368 | 		r[0] |= 4;
369 | 	return r;
370 | }
371 | 
372 | function assemble(src, single) {
373 | 	var words = src.split(/[ \t\n]+/);
374 | 	var blocks = {};
375 | 	var cur = 0;
376 | 	var comment = false;
377 | 	var execute = false;
378 | 	var cyan = false;
379 | 	var next = '';
380 | 	if(single) blocks[cur] = [];
381 | 	for(var i = 0; i < words.length; i++){
382 | 		var w = words[i];
383 | 		var r = [];
384 | 		if(w == '') continue;
385 | 		if(w[0] == '=' && !single)
386 | 			w = eval(w.substring(1)).toString();
387 | 		if(w[0] == '%')
388 | 			r = [Number.parseInt(w.substring(1), 16)];
389 | 		else if(w[0] == '#' && !single){
390 | 			cur = parseInt(w.substring(1));
391 | 			if(!(cur in blocks))
392 | 				blocks[cur] = [];
393 | 		}else if(w == '(')
394 | 			comment = true;
395 | 		else if(comment){
396 | 			if(w == ')')
397 | 				comment = false;
398 | 			else
399 | 				r = do_comment(w);
400 | 		}else if(w == '['){
401 | 			if(execute || next != '') throw "syntax error";
402 | 			execute = true;
403 | 		}else if(w == ']'){
404 | 			if(!execute || next != '') throw "syntax error";
405 | 			execute = false;
406 | 		}else if(w == '[['){
407 | 			if(cyan || next != '') throw "syntax error";
408 | 			cyan = true;
409 | 		}else if(w == ']]'){
410 | 			if(!cyan || next != '') throw "syntax error";
411 | 			cyan = false;
412 | 		}else if(w == ':'){
413 | 			if(execute || cyan || next != '') throw "syntax error";
414 | 			next = 'red';
415 | 		}else if(w == '&'){
416 | 			if(execute || cyan || next != '') throw "syntax error";
417 | 			next = 'magenta';
418 | 		}else if(w[0] == '\\'){
419 | 			if(next == 'magenta-num') throw "syntax error";
420 | 			r = do_word(w.substring(1), execute, cyan, next);
421 | 			if(next == 'magenta')
422 | 				next = 'magenta-num';
423 | 			else
424 | 				next = '';
425 | 		}else if(w.match(/^\$[0-9a-fA-F]+$/)){
426 | 			if(cyan || (next != '' && next != 'magenta-num')) throw "syntax error";
427 | 			r = do_number(parseInt(w.substring(1), 16), true, execute, next == 'magenta-num');
428 | 			next = '';
429 | 		}else if(w.match(/^[0-9]+$/)){
430 | 			if(cyan || (next != '' && next != 'magenta-num')) throw "syntax error";
431 | 			r = do_number(parseInt(w), false, execute, next == 'magenta-num');
432 | 			next = '';
433 | 		}else{
434 | 			if(next == 'magenta-num') throw "syntax error";
435 | 			r = do_word(w, execute, cyan, next);
436 | 			if(next == 'magenta')
437 | 				next = 'magenta-num';
438 | 			else
439 | 				next = '';
440 | 		}
441 | 		blocks[cur].push.apply(blocks[cur], r);
442 | 	}
443 | 	if(single){
444 | 		var r = new Uint32Array(256);
445 | 		if(0 in blocks)
446 | 			r.set(blocks[0]);
447 | 		return r;
448 | 	}
449 | 	var r = new Uint32Array(256 * 128);
450 | 	for(var i = 0; i < 128; i++){
451 | 		var b = blocks[i];
452 | 		if(b !== undefined)
453 | 			r.set(b, i * 256);
454 | 	}
455 | 	return r;
456 | }
457 | 
458 | function output(file, b){
459 | 	const fs = require('fs');
460 | 	var f = fs.createWriteStream('out.bin', {options: 'wb'});
461 | 	for(var i = 0; i < 63; i++){
462 | 		f.write(Buffer.from(b[i].buffer));
463 | 	}
464 | 	f.end();
465 | }
466 | 


--------------------------------------------------------------------------------
/orig/forth.txt:
--------------------------------------------------------------------------------
  1 | #18
  2 | ( colorforth Jul31 Chuck Moore Public Domain ) [ 24 load 26 load 28 load 30 load ] 
  3 | : dump 32 load ; 
  4 | : icons 34 load ; 
  5 | : print 38 load ; 
  6 | : file 44 load ; 
  7 | : north 46 load ; 
  8 | : colors 56 load ; [ mark empty ] 
  9 | #19
 10 | #20
 11 | #21
 12 | #22
 13 | #23
 14 | #24
 15 | [ macro ] 
 16 | : swap $168b 2, $c28b0689 , ; 
 17 | : $$0 [[ ?dup ]] $c031 2, ; 
 18 | : if $74 2, here ; 
 19 | : -if $79 2, here ; 
 20 | : a [[ ?dup ]] $c28b 2, ; 
 21 | : a! ?lit if $ba 1, , ; then $d08b 2, [[ drop ]] ; 
 22 | : 2* $e0d1 2, ; 
 23 | : a, 2* 2* , ; 
 24 | : @ ?lit if [[ ?dup ]] $58b 2, [[ a, ]] ; then $85048b 3, $$0 , ; 
 25 | : ! ?lit if ?lit if $5c7 2, swap [[ a, ]] , ; then $589 2, [[ a, drop ]] ; then [[ a! ]] $950489 3, $$0 , [[ drop ]] ; 
 26 | : nip $4768d 3, ; 
 27 | : + ?lit if $5 1, , ; then $603 2, [[ nip ]] ; 
 28 | : or $633 
 29 | : binary ?lit if swap 2 + 1, , ; then 2, [[ nip ]] ; 
 30 | : and $623 [[ binary ]] ; 
 31 | : u+ ?lit if $681 2, , ; then $44601 3, [[ drop ]] ; 
 32 | : ? ?lit $a9 1, , ; 
 33 | #25
 34 | ( Pentium macros: 1, 2, 3, , compile 1-4 bytes ) 
 35 | : drop ( lodsd, flags unchanged, why sp is in ESI ) 
 36 | : over ( sp 4 + @ ) 
 37 | : swap ( sp xchg ) 
 38 | : $$0 ( 0 0 xor, macro 0 identical to number 0 ) 
 39 | : a ( 2 0 mov, never used? ) 
 40 | : a! ( 0 2 mov, unoptimized ) 
 41 | : @ ( EAX 4 *, unoptimized ) 
 42 | : ! ( EDX 4 * ) 
 43 | : nop ( used to thwart look-back optimization ) 
 44 | : - ( ones-complement ) 
 45 | : 2* 
 46 | : 2/ 
 47 | : if ( jz, flags set, max 127 bytes, leave address ) 
 48 | : -if ( jns, same ) 
 49 | : then ( fix address - in kernel ) 
 50 | : push ( EAX push ) 
 51 | : pop ( EAX pop ) 
 52 | : u+ ( add to 2nd number, literal or value ) 
 53 | : ? ( test bits, set flags, literal only! ) 
 54 | #26
 55 | ( macros ) 
 56 | : over [[ ?dup ]] $4468b 3, ; 
 57 | : push $50 1, [[ drop ]] ; 
 58 | : pop [[ ?dup ]] $58 1, ; 
 59 | : - $d0f7 2, ; 
 60 | : for [[ push begin ]] ; 
 61 | : *next swap 
 62 | : next $75240cff 
 63 | : 0next , here - + 1, $4c483 3, ; 
 64 | : -next $79240cff [[ 0next ]] ; 
 65 | : i [[ ?dup ]] $24048b 3, ; 
 66 | : *end swap 
 67 | : end $eb 1, here - + 1, ; 
 68 | : +! ?lit if ?lit if $581 2, swap [[ a, ]] , ; then $501 2, [[ a, drop ]] ; then [[ a! ]] $950401 3, $$0 , [[ drop ]] ; 
 69 | : nop $90 1, ; 
 70 | : align here - 3 and drop if [[ nop align ]] ; then ; 
 71 | : or! [[ a! ]] $950409 3, $$0 , [[ drop ]] ; 
 72 | : * $6af0f 3, [[ nip ]] ; 
 73 | : */ $c88b 2, [[ drop ]] $f9f72ef7 , [[ nip ]] ; 
 74 | : /mod [[ swap ]] $99 1, $16893ef7 , ; 
 75 | : / [[ /mod nip ]] ; 
 76 | : mod [[ /mod drop ]] ; 
 77 | #27
 78 | 
 79 | : for n ( push count onto return stack, falls into ) begin 
 80 | : begin -a ( current code address - byte ) 
 81 | : *next aa-aa ( swap ) for ( and ) if ( addresses ) 
 82 | : next a ( decrement count, jnz to ) for, ( pop return stack when done ) 
 83 | : -next a ( same, jns - loop includes 0 ) 
 84 | : i -n ( copy loop index to data stack ) 
 85 | : end a ( jmp to ) begin 
 86 | : +! na ( add to memory, 2 literals optimized ) 
 87 | : align ( next call to end on word boundary ) 
 88 | : or! na ( inclusive-or to memory, unoptimized ) 
 89 | : * mm-p ( 32-bit product ) 
 90 | : */ mnd-q ( 64-bit product, then quotient ) 
 91 | : /mod nd-rq ( remainder and quotient ) 
 92 | : / nd-q ( quotient ) 
 93 | : mod nd-r ( remainder ) 
 94 | : time -n ( Pentium cycle counter, calibrate to get actual clock rate ) 
 95 | #28
 96 | ( Compiled macros ) 
 97 | : 2/ $f8d1 2, ; 
 98 | : time [[ ?dup ]] $310f 2, ; [ forth ] 
 99 | : @ @ ; 
100 | : ! ! ; 
101 | : + + ; 
102 | : */ */ ; 
103 | : * * ; 
104 | : / / ; 
105 | : 2/ 2/ ; 
106 | : dup dup ; ( Arithmetic ) 
107 | : negate - 1 + ; 
108 | : min less if drop ; then swap drop ; 
109 | : abs dup negate 
110 | : max less if swap then drop ; 
111 | : v+ ( vv-v ) push u+ pop + ; 
112 | : writes ( acn ) for write next drop drop ; 
113 | : reads ( acn ) for read next drop drop ; 
114 | : oadf ( qwerty ) 
115 | : save 0 dup [ nc ] @ writes stop ; 
116 | #29
117 | ( These macros may be white, others may not ) 
118 | : @ etc ( Arithmetic ) 
119 | : negate n-n ( when you just cant use ) - 
120 | : min nn-n ( minimum ) 
121 | : abs n-u ( absolute value ) 
122 | : max nn-n ( maximum ) 
123 | : v+ vv-v ( add 2-vectors ) 
124 | : nc -a ( number of cylinders booted ) 
125 | : save ( write colorforth to bootable floppy ) 
126 | : oadf ( save as spelled by qwerty. For typing with blank screen ) 
127 | #30
128 | ( Colors etc ) 
129 | : block $100 * ; 
130 | : white $ffffff color ; 
131 | : red $ff0000 color ; 
132 | : green $ff00 color ; 
133 | : blue $ff color ; 
134 | : silver $bfbfbf color ; 
135 | : black 0 color ; 
136 | : screen 0 dup at 1024 768 box ; 
137 | : 5* 5 for 2emit next ; 
138 | : cf 25 dup at red $1 $3 $c $3 $a 5* green $14 $2 $1 $3 $3e 5* ; 
139 | : logo show black screen 800 710 blue box 600 50 at 1024 620 red box 200 100 at 700 500 green box text cf keyboard ; 
140 | : empty empt logo ; 
141 | #31
142 | 
143 | : block n-a ( block number to word address ) 
144 | : colors ( specified as rgb: 888 ) 
145 | : screen ( fills screen with current color ) 
146 | : at xy ( set current screen position ) 
147 | : box xy ( lower-right of colored rectangle ) 
148 | : dump ( compiles memory display ) 
149 | : print ( compiles screen print ) 
150 | : icon ( compiles icon editor ) 
151 | : logo ( displays colorforth logo ) 
152 | : show ( background task executes following code repeatedly ) 
153 | : keyboard ( displays keypad and stack ) 
154 | #32
155 | ( Dump ) & x 2097152 & y 2101760 
156 | : one dup @ h. space dup h. cr ; 
157 | : lines for one 4294967295 + next drop ; 
158 | : dump x ! 
159 | : r show black screen x @ 15 + 16 text lines keyboard ; 
160 | : it @ + @ dup h. space ; 
161 | : lines for white i [ x ] it i [ y ] it or drop if red then i . cr -next ; 
162 | : cmp show blue screen text 19 lines red [ x ] @ h. space [ y ] @ h. keyboard ; 
163 | : u 16 
164 | : +xy dup [ x ] +! [ y ] +! ; 
165 | : d 4294967280 +xy ; 
166 | : ati $f4100000 ( ff7fc000 ) or 
167 | : byte 4 / dump ; 
168 | : fix for 0 over ! 1 + next ; [ dump ] 
169 | #33
170 | ( Does not say empty, compiles on top of application ) 
171 | : x -a ( current address ) 
172 | : one a-a ( line of display ) 
173 | : lines an 
174 | : dump a ( background task continually displays memory ) 
175 | : u ( increment address ) 
176 | : d ( decrement ) 
177 | : ati ( address of AGP graphic registers ) 
178 | : byte a ( byte address dump ) 
179 | : fix an-a ( test word ) 
180 | #34
181 | ( Icons ) [ empty macro ] 
182 | : @w $8b66 3, ; 
183 | : !w [[ a! ]] $28966 3, [[ drop ]] ; 
184 | : *byte $c486 2, ; [ forth ] & ic 0 & cu 351 
185 | : sq [ xy ] @ $10000 /mod 16 + swap 16 + box 17 0 +at ; 
186 | : loc [ ic ] @ [ 16 24 8 */ ] * [ 12 block 4 * ] + ; 
187 | : 0/1 $8000 ? if green sq ; then blue sq ; 
188 | : row dup @w *byte 16 for 0/1 2* next drop [ 4294967279 16 * ] 17 +at ; 
189 | : ikon loc 24 for row 2 + next drop ; 
190 | : adj 17 * swap ; 
191 | : cursor [ cu ] @ 16 /mod adj adj over over at red 52 u+ 52 + box ; 
192 | : ok show black screen cursor 18 dup at ikon text [ ic ] @ . keyboard ; [ 36 load ok h ] 
193 | #35
194 | ( Draw big-bits icon ) 
195 | : @w a-n ( fetch 16-bit word from byte address ) 
196 | : !w na ( store same ) 
197 | : *byte n-n ( swap bytes ) 
198 | : ic -a ( current icon ) 
199 | : cu -a ( cursor ) 
200 | : sq ( draw small square ) 
201 | : xy -a ( current screen position, set by ) at 
202 | : loc -a ( location of current icons bit-map ) 
203 | : 0/1 n-n ( color square depending on bit 15 ) 
204 | : row a-a ( draw row of icon ) 
205 | : +at nn ( relative change to screen position ) 
206 | : ikon ( draw big-bits icon ) 
207 | : adj nn-nn ( magnify cursor position ) 
208 | : cursor ( draw red box for cursor ) 
209 | : ok ( background task to continually draw icon, icon number at top ) 
210 | #36
211 | ( Edit ) 
212 | : +ic 1 [ ic ] +! ; 
213 | : -ic [ ic ] @ 4294967295 + 0 max [ ic ] ! ; 
214 | : bit [ cu ] @ 2/ 2/ 2/ 2/ 2* loc + $10000 [ cu ] @ $f and 1 + for 2/ next *byte ; 
215 | : toggle bit over @w or swap !w ; 
216 | : td toggle 
217 | : d 16 
218 | : wrap [ cu ] @ + [ 16 24 * ] dup u+ /mod drop [ cu ] ! ; 
219 | : tu toggle 
220 | : u 4294967280 wrap ; 
221 | : tr toggle 
222 | : r 1 wrap ; 
223 | : tl toggle 
224 | : l 4294967295 wrap ; 
225 | : nul ; 
226 | : h pad nul nul accept nul tl tu td tr l u d r -ic nul nul +ic nul nul nul nul nul nul nul nul nul nul nul nul [ $2500 , $110160c dup , , $2b000023 , 0 , 0 , 0 , ] 
227 | #37
228 | ( Edit icon ) 
229 | #38
230 | ( PNG ) [ empty ] & w 54 & h 32 & d 4 
231 | : frame $1e80000 ; [ file 42 load 40 load ] 
232 | : -crc ( a ) here over negate + crc . ; 
233 | : crc -crc ; 
234 | : wd ( -a ) here 3 and drop if 0 1, wd ; then here 2 2/s ; 
235 | : bys ( n-a ) . here swap , ; 
236 | : plte $45544c50 48 bys $0 3, $ff0000 3, $ff00 3, $ffff00 3, $ff 3, $ff00ff 3, $ffff 3, $ffffff 3, $0 3, $c00000 3, $c000 3, $c0c000 3, $c0 3, $c000c0 3, $c0c0 3, $c0c0c0 3, crc ; 
237 | : png ( awh ) [ d ] @ / [ h ] ! [ d ] @ / [ w ] ! wd swap $474e5089 , $a1a0a0d , ( ihdr ) $52444849 13 bys [ w ] @ . [ h ] @ . $304 , $0 1, crc plte ( idat ) $54414449 0 bys swap deflate crc ( iend ) $444e4549 0 bys crc wd over negate + ; 
238 | : at 1024 * + 2* [ frame ] + ; 
239 | : full 4 [ d ] ! 0 dup at 1024 768 png ; 
240 | : pad 1 [ d ] ! [ 46 4294967287 + 22 * ] nop [ 25 4294967292 + 30 * ] at [ 9 22 * ] nop [ 4 30 * ] png ; 
241 | #39
242 | #40
243 | ( lz77 ) [ macro ] 
244 | : @w $8b66 3, ; 
245 | : *byte $c486 2, ; 
246 | : !b [[ a! ]] $289 2, [[ drop ]] ; [ forth ] 
247 | : *bys dup 16 2/s *byte swap $ffff and *byte $10000 * + ; 
248 | : . *bys , ; 
249 | : +or over - and or ; 
250 | : 0/1 $10 ? if $1e and $1e or drop if 7 ; then $f ; then 0 and ; 
251 | : 4b dup 0/1 9 and over 6 2/s 0/1 $a and +or swap 11 2/s 0/1 $c and +or $8 or ; 
252 | : pix dup @w [ d ] @ 2* u+ 4b ; 
253 | : row 1, dup [ w ] @ 2/ dup 1 + dup 2, - 2, 0 dup 1, +adl for pix 16 * push pix pop or dup 1, +adl next drop +mod [ d ] @ [ 1024 2 * ] * + ; 
254 | : deflate $178 2, 1 0 adl! [ h ] @ 4294967295 + for 0 row next 1 row drop [ ad2 ] @ *byte 2, [ ad1 ] @ *byte 2, here over 4 + negate + *bys over 4294967292 + !b ; 
255 | #41
256 | #42
257 | ( Crc ) [ macro ] 
258 | : 2/s ?lit $e8c1 2, 1, ; 
259 | : 1@ $8a 2, ; [ forth ] & ad1 48546 & ad2 48600 
260 | : array ( -a ) pop 2 2/s ; 
261 | : bit ( n-n ) 1 ? if 1 2/s $edb88320 or ; then 1 2/s ; 
262 | : fill ( nn ) for dup 8 for bit next , 1 + next drop ; 
263 | : table ( -a ) align array [ 0 256 fill ] 
264 | : crc ( an-n ) 4294967295 swap for over 1@ over or $ff and [ table ] + @ swap 8 2/s or 1 u+ next - nip ; 
265 | : +adl ( n ) $ff and [ ad1 ] @ + dup [ ad2 ] @ + 
266 | : adl! [ ad2 ] ! [ ad1 ] ! ; 
267 | : +mod [ ad1 ] @ 65521 mod [ ad2 ] @ 65521 mod adl! ; 
268 | #43
269 | #44
270 | ( DOS file ) 
271 | : blks 256 * ; 
272 | : w/c [ 18 blks ] ; 
273 | : buffer [ 604 block ] ; 
274 | : size ( -a ) [ buffer ] 0 1 reads [ buffer $98f + ] ; 
275 | : set ( n ) ! [ buffer ] 0 1 writes ; 
276 | : cyls ( n-nn ) 1 swap [ w/c 4294967295 + ] + [ w/c ] / ; 
277 | : put ( an ) dup 2* 2* size set cyls writes stop ; 
278 | : get ( a ) size @ 3 + 2/ 2/ cyls reads stop ; 
279 | : .com 0 63 blocks put ; 
280 | #45
281 | 
282 | : blks n-n ( size in blocks to words ) 
283 | : w/c -n ( words per cylinder ) 
284 | : buffer -a ( 1 cylinder required for floppy dma ) 
285 | : size -a ( locate size of 2nd file. Floppy has first FILLER then FILE allocated. FILLER is 2048 bytes, to fill out cylinder 0. Names at most 8 letters, all caps. Directory starts at ) [ buffer $980 + ] 
286 | : set n ( size. FILE must be larger than your file. ) 
287 | : cyls n-nn ( starting cylinder 1 and number of cylinders ) 
288 | : put an ( write file from address ) 
289 | : get a ( read file to address ) 
290 | #46
291 | ( North Bridge ) [ empty macro ] 
292 | : 4@ [[ dup ]] $ed 1, ; 
293 | : 4! $ef 1, [[ drop ]] ; [ forth ] & dev 15104 
294 | : nb $0 [ dev ] ! ; 
295 | : sb $3800 [ dev ] ! ; 
296 | : agp $800 [ dev ] ! ; 
297 | : ess $6800 [ dev ] ! ; 
298 | : ric $7800 [ dev ] ! ; 
299 | : win $8000 [ dev ] ! ; 
300 | : ati $10000 [ dev ] ! ; 
301 | : add $cf8 a! 4! $cfc a! ; 
302 | : q $80000000 + add 4@ ; 
303 | : en $8004 q 4294967292 and or 4! ; 
304 | : dv dup $800 * q swap 1 + ; 
305 | : regs [ dev ] @ [ 19 4 * ] + 20 for dup q h. space dup h. cr 4294967292 + next drop ; 
306 | : devs 0 33 for dup q dup 1 + drop if dup h. space drop dup 8 + q dup h. space over h. cr then drop $800 + next drop ; 
307 | : ok show black screen text regs keyboard ; 
308 | : u $40 [ dev ] +! ; 
309 | : d 4294967232 [ dev ] +! ; 
310 | : test $ff00 + a! 4@ ; [ ok ] 
311 | #47
312 | #48
313 | ( ASCII ) [ macro ] 
314 | : 1@ $8a 2, ; [ forth ] 
315 | : string pop ; 
316 | : cf-ii string [ $6f747200 , $696e6165 , $79636d73 , $7766676c , $62707664 , $71757868 , $336a7a6b , $37363534 , $2d313938 , $2f322e30 , $2b213a3b , $3f2c2a40 , ] 
317 | : ch $fffffff0 and unpack [ cf-ii ] + 1@ $ff and ; 
318 | : ii-cf string [ $2a00 , 0 , $2b2d0000 , $2725232e , $1b262224 , $1f1e1d1c , $28292120 , $2f000000 , $3a43355c , $3d3e3440 , $484a3744 , $3336393c , $38314742 , $3f414632 , $493b45 , 0 , $a13052c , $d0e0410 , $181a0714 , $306090c , $8011712 , $f111602 , $190b15 , ] 
319 | : chc $ffffffe0 + [ ii-cf ] + 1@ $ff and ; 
320 | #49
321 | #50
322 | ( Clock ) [ macro ] 
323 | : p@ $ec 1, ; 
324 | : p! $ee 1, [[ drop ]] ; [ forth ] 
325 | : ca $70 a! p! $71 a! ; 
326 | : c@ ca 0 p@ ; 
327 | : c! ca p! ; 
328 | : hi 10 c@ $80 and drop if ; then hi ; 
329 | : lo 0 p@ $80 and drop if lo ; then ; 
330 | : bcd c@ 16 /mod 10 * + ; 
331 | : hms0 4 bcd 100 * 2 bcd + 100 * 0 bcd + ; 
332 | : hms hms0 2 ms dup hms0 or drop if drop hms ; then ; 
333 | : ymd 9 bcd 100 * 8 bcd + 100 * 7 bcd + ; 
334 | : day 6 c@ 4294967295 + ; 
335 | : cal hi lo time - hi lo time + ( 748 ) ; 
336 | #51
337 | #52
338 | ( LAN ) [ empty $3f8 54 load init ] 
339 | : no block 4 * 1024 ; 
340 | : send no for dup 1@ xmit 1 + next drop ; 
341 | : receive no for rcv over 1! 1 + next drop ; 
342 | : no 18 [ 7 18 * ] ; 
343 | : backup no for dup send 1 + next drop ; 
344 | : accept no for dup receive 1 + next drop ; 
345 | #53
346 | #54
347 | ( Serial 3f8 2e8 1050 ) [ macro ] 
348 | : p@ [[ a! dup ]] $ec 1, ; 
349 | : p! [[ a! ]] $ee 1, [[ drop ]] ; 
350 | : 1@ $8a 2, ; 
351 | : 1! [[ a! ]] $288 2, [[ drop ]] ; [ forth ] 
352 | : r [ 0 + ] + ; 
353 | : $$9600 12 ; 
354 | : $$115200 1 ; 
355 | : b/s $83 [ 3 r ] p! $$9600 [ 0 r ] p! 0 [ 1 r ] p! 3 [ 3 r ] p! ; 
356 | : init b/s ( 16550 ) 1 [ 2 r ] p! 0 [ 4 r ] p! ; 
357 | : xmit ( n ) [ 5 r ] p@ $20 and drop if [ 0 r ] p! ; then pause xmit ; 
358 | : cts [ 6 r ] p@ $30 and $30 or drop if cts ; then xmit ; 
359 | : st [ 6 r ] p@ 
360 | : xbits $30 and $10 / dup 1 and 2* 2* + 2/ ; 
361 | : st! [ 4 r ] p! ; 
362 | : ?rcv [ 5 r ] p@ 1 and drop if [ 0 r ] p@ then ; 
363 | : rcv ?rcv if ; then pause rcv ; 
364 | #55
365 | 
366 | : p@ p-n ( fetch byte from port ) 
367 | : p! np ( store byte to port ) 
368 | : 1@ a-n ( fetch byte from byte address ) 
369 | : 1! na ( store byte to byte address ) 
370 | : r n-p ( convert relative to absolute port address. Base port on stack at compile time. Compiled as literal at yellow-green transition ) 
371 | : $$9600 
372 | : $$115200 ( baud-rate divisors. These are names, not numbers ) 
373 | : b/s ( set baud rate. Edit to change ) 
374 | : init ( initialize uart ) 
375 | : xmit n ( wait for ready and transmit byte ) 
376 | : cts n ( wait for clear-to-send then xmit ) 
377 | : st -n ( fetch status byte ) 
378 | : xbits n-n ( exchange status bits ) 
379 | : st! n ( store control byte ) 
380 | : ?rcv ( fetch byte if ready. Set flag to be tested by ) if 
381 | : rcv -n ( wait for ready and fetch byte ) 
382 | #56
383 | ( Hexagon ) [ empty ] & col 0 & del 2105376 
384 | : lin dup 2/ 2/ dup 2* line ; 
385 | : hex [ xy ] @ 7 and over 2/ for lin 7 + next over for lin next swap 2/ for 4294967289 + lin next drop ; 
386 | : +del [ del ] @ nop 
387 | : petal and [ col ] @ + $f8f8f8 and color 100 hex ; 
388 | : -del [ del ] @ $f8f8f8 or $80808 + ; 
389 | : rose 0 +del 4294967120 4294967096 +at $f80000 -del petal 352 4294967096 +at $f80000 +del 4294967032 4294966947 +at $f800 -del petal 176 4294967096 +at $f8 +del 4294967120 98 +at $f8 -del petal 176 4294967096 +at $f800 +del ; 
390 | : ok show black screen 512 282 at rose text [ col ] @ h. space [ del ] @ $ff and . keyboard ; [ 58 load ok h ] 
391 | #57
392 | ( Draws 7 hexagons. Colors differ along red, green and blue axes. ) 
393 | : col ( color of center hexagon ) 
394 | : del ( color difference ) 
395 | : lin n ( draws 1 horizontal line of a hexagon ) 
396 | : hex n ( draws top, center and bottom. Slope 7 x to 4 y is 1.750 compared to 1.732 ) 
397 | : +del n ( increment color ) 
398 | : -del n 
399 | : petal n ( draw colored hexagon ) 
400 | : rose ( draw 7 hexagons ) 
401 | : ok ( describe screen. Center color at top ) 
402 | #58
403 | ( Pan ) 
404 | : in [ del ] @ 2* $404040 min [ del ] ! ; 
405 | : out [ del ] @ 2/ $80808 max [ del ] ! ; 
406 | : r $f80000 
407 | : +del [ del ] @ 
408 | : +col and [ col ] @ + $f8f8f8 and [ col ] ! ; 
409 | : g $f800 +del ; 
410 | : b $f8 +del ; 
411 | : -r $f80000 -del +col ; 
412 | : -g $f800 -del +col ; 
413 | : -b $f8 -del +col ; 
414 | : nul ; 
415 | : h pad nul nul accept nul -r -g -b nul r g b nul out nul nul in nul nul nul nul nul nul nul nul nul nul nul nul [ $250000 , $130d01 dup , , $2b000023 , 0 , 0 , 0 , ] 
416 | #59
417 | 
418 | : in ( increment color difference ) 
419 | : out ( decrement it ) 
420 | : r 
421 | : g 
422 | : b ( increment center color ) 
423 | : -r 
424 | : -g 
425 | : -b ( decrement it ) 
426 | : +del ( redefine with ; ) 
427 | : +col ( change center color ) 
428 | : nul ( ignore ) 
429 | : h ( describe keypad ) 
430 | #60
431 | #61
432 | #62
433 | ( Timing ) [ empty macro ] 
434 | : out $e1e6 2, ; [ forth ] 
435 | : tare time - 1000 for next time + ; 
436 | : tare+ time - push 1000 for dup next c pop time + ; 
437 | : test tare time + - 1000 for out next time + ; ( next 3 loop 5.7 /next 2 /swap 25 swap 7.2 ) [ macro ] 
438 | : c! $c88b 2, [[ drop ]] here ; 
439 | : loop $49 1, $75 1, ( e2 ) here - + 1, ; [ forth ] 
440 | : try time - 1000 c! loop time + ; 
441 | 


--------------------------------------------------------------------------------
/main.js:
--------------------------------------------------------------------------------
  1 | "use strict";
  2 | /*
  3 | 	to implement stack manipulation, 'trampolining' is used.
  4 | 	functions that manipulate the stack are called dollar functions
  5 | 	and their names prefixed with a dollar sign, like $ACCEPT.  dollar
  6 | 	functions must not be called directly, but instead are pushed
  7 | 	on the return stack ret.  the master loop for(;;) ret.pop()()
  8 | 	will then pick them up and execute them.  it's generally legal to
  9 | 	push a sequence of functions on the return stack to execute them
 10 | 	(in reverse of the order pushed).  non-dollar functions are also
 11 | 	legal to push on the return stack.
 12 | 
 13 | 	dollar functions can have arguments which are passed using
 14 | 
 15 | 		ret.push(() => $fn(a,b,c));
 16 | 
 17 | 	dollar functions can't currently have return values.
 18 | 
 19 | 	summary:
 20 | 	function x() {
 21 | 		OK: y();
 22 | 		NEIN NEIN NEIN: ret.push(...)
 23 | 		NEIN NEIN NEIN: ret.pop(...)
 24 | 		NEIN NEIN NEIN: $z();
 25 | 	}
 26 | 	function $x() {
 27 | 		OK: y();
 28 | 		OK: ret.push(x);
 29 | 		OK: ret.push($z);
 30 | 		OK: ret.pop();
 31 | 		NEIN NEIN NEIN: $z();
 32 | 	}
 33 | */
 34 | 
 35 | var tos = 0;
 36 | var flag = false;
 37 | var next = 0;
 38 | var screen = undefined;
 39 | var main_ret = [];
 40 | var main_data = [];
 41 | var god_ret = [];
 42 | var god_data = [];
 43 | 
 44 | var data = god_data;
 45 | var ret = god_ret;
 46 | var me = 'god';
 47 | var mem;
 48 | 
 49 | function alit() { lit = adup; literal(); }
 50 | function adup() { DUP_(); }
 51 | var lit = adup;
 52 | 
 53 | var dict = [];
 54 | var dict_fn = [];
 55 | var dict_name = []; /* for debugging */
 56 | var nojit = [];
 57 | var here = 0;
 58 | var list = [0, 0];
 59 | var mk = [0, 0, 0];
 60 | 
 61 | var forth0 = [];
 62 | var forth2 = [];
 63 | var macro0 = [];
 64 | var macro2 = [];
 65 | 
 66 | function enchuck(s) {
 67 | 	var w = 0;
 68 | 	var n = 0;
 69 | 	var r = [];
 70 | 	var nc, b;
 71 | 	for(var i = 0; i < s.length; i++){
 72 | 		var c = 1 + 'rtoeanismcylgfwdvpbhxuq0123456789j-k.z/;:!+@*,?'.indexOf(s[i]);
 73 | 		if(c == 0) throw new Error("unchuckable: " + s);
 74 | 		if(c < 8) { nc = 4; b = c; }
 75 | 		else if(c < 16) { nc = 5; b = 0x10 | c - 8; }
 76 | 		else { nc = 7; b = 0x30; b = 0x60 | c - 16; }
 77 | 		if(n + nc - ctz(b) > 28){
 78 | 			r.push(w << 32 - n);
 79 | 			w = 0;
 80 | 			n = 0;
 81 | 		}else if(n + nc > 28){
 82 | 			b >>= n + nc - 28;
 83 | 			nc = 28 - n;
 84 | 		}
 85 | 		w = w << nc | b;
 86 | 		n += nc;
 87 | 	}
 88 | 	if(n != 0)
 89 | 		r.push(w << 32 - n);
 90 | 	return r;
 91 | }
 92 | 
 93 | function builtin(name, fn) {
 94 | 	if(fn.name == '' || fn.name == 'anonymous')
 95 | 		throw new Error("don't call builtin_macro with anonymous functions");
 96 | 	var w = enchuck(name)[0];
 97 | 	forth0.push(w);
 98 | 	forth2.push(dict.length);
 99 | 	dict[here++] = 0;
100 | 	dict_fn.push(fn);
101 | 	dict_name.push(name);
102 | 	fn.$ = fn.name[0] == '$';
103 | 	nojit.push(true);
104 | }
105 | function builtin_macro(name, fn) {
106 | 	if(fn.name == '' || fn.name == 'anonymous')
107 | 		throw new Error("don't call builtin_macro with anonymous functions");
108 | 	var w = enchuck(name)[0];
109 | 	macro0.push(w);
110 | 	macro2.push(dict.length);
111 | 	dict[here++] = 0;
112 | 	dict_fn.push(fn);
113 | 	dict_name.push(name);
114 | 	fn.$ = fn.name[0] == '$';
115 | 	nojit.push(true);
116 | }
117 | 
118 | var INS_NOP = 0;
119 | var INS_DUP = 1;
120 | var INS_DROP = 2;
121 | var INS_SETTOS = 3;
122 | var INS_FORTH = 4;
123 | var INS_MACRO = 5;
124 | var INS_SEMI = 6;
125 | var INS_JYES = 7;
126 | var INS_JNO = 8;
127 | var INS_NOT = 9;
128 | var INS_PUSH = 0xb;
129 | var INS_POP = 0xc;
130 | var INS_ADD = 0xd;
131 | var INS_UPLUS = 0xe;
132 | var INS_NEXT = 0xf;
133 | var INS_MUL = 0x10;
134 | var INS_BANG = 0x11;
135 | var INS_AT = 0x12;
136 | var INS_LSH = 0x13;
137 | var INS_ASR = 0x14;
138 | var INS_NIP = 0x15;
139 | var INS_OR = 0x16;
140 | var INS_AND = 0x17;
141 | var INS_TEST = 0x18;
142 | var INS_OVER = 0x19;
143 | var INS_0NEXT = 0x1a;
144 | var INS_TBANG = 0x1b;
145 | var INS_TAT = 0x1c;
146 | var INS_MULDIV = 0x1d;
147 | var INS_DIV = 0x1e;
148 | var INS_MOD = 0x1f;
149 | var INS_LESS = 0x20;
150 | 
151 | function read(n) {
152 | 	return mem[n]|0;
153 | }
154 | 
155 | function write(n, v) {
156 | 	mem[n] = v;
157 | }
158 | 
159 | function memmove(dst, src, n) {
160 | 	mem.copyWithin(dst, src, src + n);
161 | }
162 | 
163 | function DUP_() {
164 | 	data.push(tos);
165 | }
166 | 
167 | function DROP() {
168 | 	tos = data.pop() | 0;
169 | }
170 | 
171 | function $start() {
172 | 	ret.push($ACCEPT);
173 | 	ret.push($LOAD);
174 | 	ret.push(() => {DUP_(); tos = 18;});
175 | 	ret.push($show0);
176 | }
177 | builtin("warm", $start);
178 | 
179 | function $show0() {
180 | 	ret.push(function(){});
181 | 	ret.push($SHOW);
182 | }
183 | 
184 | function $SHOW() {
185 | 	screen = ret.pop();
186 | 	DUP_();
187 | 	tos = 0;
188 | 	function $loop(){
189 | 		ret.push($loop);
190 | 		ret.push(() => {tos++;});
191 | 		ret.push(screen);
192 | 		ret.push($SWITCH);
193 | 	}
194 | 	ret.push($loop);
195 | 	ret.push($ACT);
196 | }
197 | builtin("show", $SHOW);
198 | 
199 | function $ACT() {
200 | 	main_data.length = 0;
201 | 	main_data.push(tos);
202 | 	main_ret.length = 0;
203 | 	main_ret.push(ret.pop());
204 | 	DROP();
205 | }
206 | builtin("act", $ACT);
207 | 
208 | function c_() {
209 | 	god_data = [0, 0];
210 | }
211 | builtin("c", c_);
212 | 
213 | function $PAUSE() {
214 | 	DUP_();
215 | 	if(me == 'god'){
216 | 		me = 'main';
217 | 		data = main_data;
218 | 		ret = main_ret;
219 | 	}else{
220 | 		me = 'god';
221 | 		data = god_data;
222 | 		ret = god_ret;
223 | 	}
224 | 	DROP();
225 | }
226 | builtin("pause", $PAUSE);
227 | 
228 | var sleeping = true;
229 | var sleepmagic = new Object;
230 | 
231 | function $SLEEP(fn) {
232 | 	if(me != 'god') throw new Error('$SLEEP from main thread');
233 | 	function loop() {
234 | 		if(!fn()){
235 | 			ret.push(loop);
236 | 			sleeping = true;
237 | 			throw sleepmagic;
238 | 		}
239 | 	}
240 | 	ret.push(loop);
241 | 	ret.push($PAUSE);
242 | }
243 | 
244 | function wakeup() {
245 | 	if(sleeping){
246 | 		sleeping = false;
247 | 		setTimeout(master, 0);
248 | 	}
249 | }
250 | 
251 | function $delay() {
252 | 	let expired = false;
253 | 	setTimeout(() => {expired = true; wakeup();}, 250);
254 | 	DROP();
255 | 	ret.push(() => $SLEEP(() => expired));
256 | }
257 | builtin("delay", $delay);
258 | 
259 | function $ABORT() {
260 | 	curs = next;
261 | 	blk = next >> 8;
262 | 	ret.push($ABORT1);
263 | }
264 | 
265 | function $ABORT1() {
266 | 	ret = god_ret;
267 | 	spaces[3] = forthd;
268 | 	spaces[4] = $qCOMPILE;
269 | 	spaces[5] = cNUM;
270 | 	spaces[6] = cSHORT;
271 | 	tos = 0o57;
272 | 	ECHO_();
273 | 	ret.push($ACCEPT);
274 | }
275 | 
276 | function $LOAD() {
277 | 	ret.push(next);
278 | 	next = tos * 256;
279 | 	DROP();
280 | 	ret.push($INTER);
281 | }
282 | builtin("load", $LOAD);
283 | 
284 | function $INTER() {
285 | 	var word, f;
286 | 
287 | 	word = read(next);
288 | 	next++;
289 | 	f = spaces[word & 0o17];
290 | 	ret.push($INTER);
291 | 	ret.push(() => f(word));
292 | }
293 | 
294 | function $qIGNORE(word) {
295 | 	if(word == 0){
296 | 		ret.pop();
297 | 		next = ret.pop();
298 | 	}
299 | }
300 | 
301 | function nul() {
302 | }
303 | 
304 | function $execute(word) {
305 | 	var r;
306 | 
307 | 	lit = alit;
308 | 	DUP_();
309 | 	tos = word & -16;
310 | 	r = forth0.lastIndexOf(tos);
311 | 	if(r < 0){
312 | 		console.log("not found " + dechuck(word & -16));
313 | 		ret.push($ABORT);
314 | 	}else{
315 | 		DROP();
316 | 		ret.push(dict_fn[forth2[r]]);
317 | 	}
318 | }
319 | 
320 | function NUM(word) {
321 | 	lit = alit;
322 | 	DUP_();
323 | 	tos = read(next);
324 | 	next++;
325 | }
326 | 
327 | function SHORT_(word) {
328 | 	lit = alit;
329 | 	DUP_();
330 | 	tos = word >> 5;
331 | }
332 | 
333 | function MACRO(word) {
334 | 	spaces[3] = macrod;
335 | }
336 | builtin("macro", MACRO);
337 | 
338 | function FORTH(word) {
339 | 	spaces[3] = forthd;
340 | }
341 | builtin("forth", FORTH);
342 | 
343 | function macrod(word) {
344 | 	macro0.push(word & -16);
345 | 	var h = here;
346 | 	macro2.push(h);
347 | 	dict_fn[h] = () => jit(h)();
348 | 	dict_name[h] = dechuck(word & -16);
349 | 	list[0] = undefined;
350 | 	lit = adup;
351 | }
352 | 
353 | function forthd(word) {
354 | 	forth0.push(word & -16);
355 | 	var h = here;
356 | 	forth2.push(h);
357 | 	dict_fn[h] = () => jit(h)();
358 | 	dict_name[h] = dechuck(word & -16);
359 | 	list[0] = undefined;
360 | 	lit = adup;
361 | }
362 | 
363 | function $qCOMPILE(word) {
364 | 	var r;
365 | 
366 | 	lit();
367 | 	tos = word & -16;
368 | 	r = macro0.lastIndexOf(tos);
369 | 	if(r >= 0){
370 | 		DROP();
371 | 		ret.push(dict_fn[macro2[r]]);
372 | 	}else{
373 | 		r = forth0.lastIndexOf(tos);
374 | 		if(r < 0){
375 | 			console.log("not found " + dechuck(word & -16));
376 | 			ret.push($ABORT);
377 | 		}else{
378 | 			list[0] = here;
379 | 			dict[here++] = INS_FORTH;
380 | 			dict[here++] = r;
381 | 			DROP();
382 | 		}
383 | 	}
384 | }
385 | 
386 | function $COMPILE(word) {
387 | 	var r;
388 | 
389 | 	lit();
390 | 	tos = word & -16;
391 | 	r = macro0.lastIndexOf(tos);
392 | 	if(r < 0){
393 | 		console.log("not found " + dechuck(word & -16));
394 | 		ret.push($ABORT);
395 | 	}else{
396 | 		list[0] = here;
397 | 		dict[here++] = INS_MACRO;
398 | 		dict[here++] = r;
399 | 		DROP();
400 | 	}
401 | }
402 | 
403 | function cNUM(word) {
404 | 	lit();
405 | 	tos = read(next);
406 | 	next++;
407 | 	literal();
408 | 	DROP();
409 | }
410 | 
411 | function cSHORT(word) {
412 | 	lit();
413 | 	tos = word >> 5;
414 | 	literal();
415 | 	DROP();
416 | }
417 | 
418 | function variable(word) {
419 | 	forth0.push(word & -16);
420 | 	forth2.push(here);
421 | 	dict_fn[here] = () => {DUP_(); tos = a;};
422 | 	dict_fn[here].$ = false;
423 | 	dict_name[here] = dechuck(word & -16);
424 | 	nojit[here] = true;
425 | 	dict[here++] = 0;
426 | 	let a = next;
427 | 	macro0.push(word & -16);
428 | 	macro2.push(here);
429 | 	dict.push(0);
430 | 	dict_fn[here] = () => {lit(); tos = a; literal(); DROP();};
431 | 	dict_fn[here].$ = false;
432 | 	dict_name[here] = dechuck(word & -16);
433 | 	nojit[here] = true;
434 | 	dict[here++] = 0;
435 | 	list[0] = undefined;
436 | 	lit = adup;
437 | 	next++;
438 | }
439 | 
440 | var spaces = [
441 | 	$qIGNORE,
442 | 	$execute,
443 | 	NUM,
444 | 	macrod,
445 | 	$qCOMPILE,
446 | 	cNUM,
447 | 	cSHORT,
448 | 	$COMPILE,
449 | 	SHORT_,
450 | 	nul,
451 | 	nul,
452 | 	nul,
453 | 	variable,
454 | 	nul,
455 | 	nul,
456 | 	nul
457 | ];
458 | 
459 | 
460 | function cdrop() {
461 | 	list[0] = here;
462 | 	dict[here++] = INS_DROP;
463 | }
464 | builtin_macro("drop", cdrop);
465 | 
466 | function cdup() {
467 | 	dict[here++] = INS_DUP;
468 | }
469 | builtin_macro("dup", cdup);
470 | 
471 | function qdup() {
472 | 	if(list[0] != here-1 || dict[here-1] != INS_DROP)
473 | 		cdup();
474 | 	else
475 | 		here--;
476 | }
477 | builtin_macro("?dup", qdup);
478 | 
479 | function qlit() {
480 | 	if(list[0] != here-2 || dict[here-2] != INS_SETTOS)
481 | 		flag = false;
482 | 	else{
483 | 		flag = true;
484 | 		DUP_();
485 | 		list[0] = list[1];
486 | 		if(dict[here-3] == INS_DUP){
487 | 			here -= 3;
488 | 		}else{
489 | 			here -= 2;
490 | 			cdrop();
491 | 		}
492 | 	}
493 | }
494 | builtin("?lit", qlit);
495 | 
496 | function literal() {
497 | 	qdup();
498 | 	list[1] = list[0];
499 | 	list[0] = here;
500 | 	dict[here++] = INS_SETTOS;
501 | 	dict[here++] = tos;
502 | }
503 | 
504 | function semi() {
505 | 	dict[here++] = INS_SEMI;
506 | }
507 | builtin_macro(";", semi);
508 | 
509 | function then() {
510 | 	list[0] = undefined;
511 | 	dict[tos-1] = here;
512 | 	DROP();
513 | }
514 | builtin_macro("then", then);
515 | 
516 | function begin() {
517 | 	list[0] = undefined;
518 | 	DUP_();
519 | 	tos = here;
520 | }
521 | builtin_macro("begin", begin);
522 | 
523 | function comma() {
524 | 	dict[here++] = tos;
525 | 	DROP();
526 | }
527 | builtin(",", comma);
528 | 
529 | function HERE() {
530 | 	DUP_();
531 | 	tos = here;
532 | }
533 | builtin("here", HERE);
534 | 
535 | function mark() {
536 | 	mk = [macro0.length, forth0.length, here];
537 | }
538 | builtin("mark", mark);
539 | 
540 | function empty() {
541 | 	macro2.length = macro0.length = mk[0];
542 | 	forth2.length = forth0.length = mk[1];
543 | 	here = mk[2];
544 | }
545 | builtin("empt", empty);
546 | 
547 | function log() {
548 | 	console.log(data, tos);
549 | }
550 | builtin("log", log);
551 | 
552 | function debug() {
553 | 	debugger;
554 | }
555 | builtin("debug", debug);
556 | 
557 | function erase() {
558 | 	var n = tos << 8; DROP();
559 | 	var a = tos << 8; DROP();
560 | 	mem.fill(0, a, a + n);
561 | }
562 | builtin("erase", erase);
563 | 
564 | function $copy() {
565 | 	if(tos < 12) ret.push($ABORT1);
566 | 	var a = tos; DROP();
567 | 	memmove(a << 8, blk << 8, 256);
568 | 	blk = a;
569 | }
570 | builtin("copy", $copy);
571 | 
572 | function master() {
573 | 	try {
574 | 		for(var i = 0; i < 1000; i++)
575 | 			ret.pop()();
576 | 		setTimeout(master, 0);
577 | 	}catch(e){
578 | 		if(e !== sleepmagic){
579 | 			console.log(e.stack);
580 | 			throw e;
581 | 		}
582 | 	}
583 | }
584 | 
585 | function dict_$(n) {
586 | 	var f = dict_fn[n];
587 | 	if(f !== undefined && f.$ !== undefined)
588 | 		return f.$;
589 | 	return jit_instrs[n].$;
590 | }
591 | 
592 | function common(t) { }
593 | function Basic(id, s, n, $) { this.id = id; this.stat = s; this.next = [n]; common(this); this.is$ = () => !!$; }
594 | function Semi(id) { this.id = id; this.next = []; common(this); }
595 | function JSCall(id, f, n) { this.id = id; this.fun = f; this.next = [n]; if(!nojit[f]) this.next.push(f); common(this); }
596 | function Cond(id, c, t, e) { this.id = id; this.cond = c; this.next = [t,e]; common(this); }
597 | function Next(id, c, t, e) { this.id = id; this.cond = c; this.next = [t,e]; common(this); }
598 | 
599 | Basic.prototype.mktext = function(n) { return this.stat + "\n" + n[0]; };
600 | Semi.prototype.mktext = function(n) { return ""; };
601 | JSCall.prototype.mktext = function(n) {
602 | 	if(dict_$(this.fun) === false){
603 | 		return "dict_fn[" + this.fun + "](); /* " + dict_name[this.fun] + " */\n" + n[0];
604 | 	}else{
605 | 		var s = "";
606 | 		if(n[0] != "")
607 | 			s += "ret.push(() => {" + n[0] + "});\n"
608 | 		s += "ret.push(dict_fn[" + this.fun + "]); /* " + dict_name[this.fun] + " */ "
609 | 		return s;
610 | 	}
611 | };
612 | Cond.prototype.mktext = function(n) { return "if(" + this.cond + ") {\n" + n[0] + "} else {\n" + n[1] + "}"; };
613 | Next.prototype.mktext = function(n) { return "if(--ret[ret.length - 1] " + this.cond + ") {\n" + n[0] + "} else {\nret.pop();\n" + n[1] + "}"; };
614 | 
615 | Semi.prototype.is$ = () => false;
616 | JSCall.prototype.is$ = function() { return dict_$(this.fun); };
617 | Cond.prototype.is$ = () => false;
618 | Next.prototype.is$ = () => true;
619 | 
620 | var jit_instrs = [];
621 | 
622 | function jit_instr(h) {
623 | 	switch(dict[h]){
624 | 	case INS_NOP: return new Basic(h, ';', h + 1); /* intentionally breaks tail call optimisation */
625 | 	case INS_SEMI: return new Semi(h, );
626 | 	case INS_DUP: return new Basic(h, "data.push(tos);", h + 1);
627 | 	case INS_DROP: return new Basic(h, "tos = data.pop() | 0;", h + 1);
628 | 	case INS_SETTOS: return new Basic(h, "tos = " + dict[h+1] + ";", h + 2);
629 | 	case INS_NOT: return new Basic(h, "tos = ~tos;", h + 1);
630 | 	case INS_PUSH: return new Basic(h, "ret.push(tos);", h + 1, true);
631 | 	case INS_POP: return new Basic(h, "tos = ret.pop();", h + 1, true);
632 | 	case INS_ADD: return new Basic(h, "tos = 0 | tos + data.pop();", h + 1);
633 | 	case INS_MUL: return new Basic(h, "tos = 0 | tos * data.pop();", h + 1);
634 | 	case INS_UPLUS: return new Basic(h, "data[data.length - 2] += tos;", h + 1);
635 | 	case INS_AT: return new Basic(h, "tos = read(tos);", h + 1);
636 | 	case INS_BANG: return new Basic(h, "write(tos, data[data.length - 1]);", h + 1);
637 | 	case INS_LSH: return new Basic(h, "tos <<= 1;", h + 1);
638 | 	case INS_ASR: return new Basic(h, "tos >>>= 1;", h + 1);
639 | 	case INS_NIP: return new Basic(h, "data.length--;", h + 1);
640 | 	case INS_OR: return new Basic(h, "tos |= data.pop();", h + 1);
641 | 	case INS_AND: return new Basic(h, "tos &= data.pop();", h + 1);
642 | 	case INS_TEST: return new Basic(h, "flag = (data[data.length - 1] & tos) != 0;}", h + 1);
643 | 	case INS_OVER: return new Basic(h, "tos = data[data.length - 2];", h + 1);
644 | 	case INS_TBANG: return new Basic(h, "var t" + dict[h+1] + " = tos;", h + 2);
645 | 	case INS_TAT: return new Basic(h, "tos = t" + dict[h+1] + ";", h + 2);
646 | 	case INS_MULDIV: return new Basic(h, "tos = data[data.length - 2] * data[data.length - 1] / tos | 0;", h + 1);
647 | 	case INS_DIV: return new Basic(h, "tos = data.pop() / tos | 0;", h + 1);
648 | 	case INS_MOD: return new Basic(h, "tos = data.pop() % tos;", h + 1);
649 | 	case INS_LESS: return new Basic(h, "flag = data[data.length - 1] < tos;", h + 1);
650 | 
651 | 	case INS_FORTH: return new JSCall(h, forth2[dict[h+1]], h+2);
652 | 	case INS_MACRO: return new JSCall(h, macro2[dict[h+1]], h+2);
653 | 	case INS_JYES: return new Cond(h, "flag", dict[h+1], h+2);
654 | 	case INS_JNO: return new Cond(h, "!flag", dict[h+1], h+2);
655 | 	case INS_NEXT: return new Next(h, "> 0", dict[h+1], h+2);
656 | 	case INS_0NEXT: return new Next(h, ">= 0", dict[h+1], h+2);
657 | 	default: throw new Error("invalid opcode " + dict[h]);
658 | 	}
659 | }
660 | 
661 | function jit_loop(start) {
662 | 	if(start in jit_instrs) return jit_instrs[start];
663 | 
664 | 	var namectr = 0
665 | 	var named = {};
666 | 
667 | 	function handle(p) {
668 | 		var n = [];
669 | 		var $ = false;
670 | 		for(var i = 0; i < p.next.length; i++){
671 | 			p.next[i] = jit_instrs[p.next[i]];
672 | 			if(p.next[i].text === undefined){
673 | 				named[p.next[i].id] = '_' + namectr++;
674 | 				n.push("ret.push(" + named[p.next[i].id] + ");");
675 | 				$ = true;
676 | 			}else{
677 | 				n.push(p.next[i].text);
678 | 				if(p.next[i].$ !== false)
679 | 					$ = true;
680 | 			}
681 | 		}
682 | 		let t = p.mktext(n);
683 | 		if(named[p.id]){
684 | 			p.text = "function " + named[p.id] + "() {\n" + t + "}\nret.push(" + named[p.id] + ");";
685 | 			p.$ = true;
686 | 		}else{
687 | 			p.text = t;
688 | 			p.$ = $ || p.is$();
689 | 		}
690 | 	}
691 | 
692 | 	var qu = [start];
693 | 	while(qu.length != 0){
694 | 		let h = qu.pop();
695 | 		if(h instanceof Function) {h(); continue;}
696 | 		if(h in jit_instrs) continue;
697 | 		let p = jit_instr(h);
698 | 		jit_instrs[h] = p;
699 | 		qu.push(() => handle(p));
700 | 		p.next.forEach(x => {
701 | 			if(!(x in jit_instrs))
702 | 				qu.push(x);
703 | 		});
704 | 	}
705 | 	return jit_instrs[start];
706 | }
707 | 
708 | function jit(h) {
709 | 	var p = jit_loop(h);
710 | 	var f = new Function(p.text);
711 | 	f.$ = p.$;
712 | 	return dict_fn[h] = f;
713 | }
714 | 
715 | function init() {
716 | 	mem = assemble(forth);
717 | 	for(var i = 0; i < iconstr.length / 4; i++)
718 | 		mem[12*256 + i] =
719 | 			iconstr.charCodeAt(4 * i) |
720 | 			iconstr.charCodeAt(4 * i + 1) << 8 |
721 | 			iconstr.charCodeAt(4 * i + 2) << 16 |
722 | 			iconstr.charCodeAt(4 * i + 3) << 24;
723 | 	ret.push($start);
724 | 	setTimeout(master, 0);
725 | 	gfxinit();
726 | }
727 | 
728 | window.onload = init;
729 | 


--------------------------------------------------------------------------------
/orig/COLOR.ASM:
--------------------------------------------------------------------------------
   1 | ;colorForth, 2001 Jul 22, Chuck Moore, Public Domain
   2 | 
   3 | .MODEL tiny
   4 | .486p
   5 | only SEGMENT USE32
   6 | ASSUME DS:only
   7 | 
   8 | next MACRO adr
   9 |     dec  ECX
  10 |     jnz  adr
  11 | ENDM
  12 | 
  13 | DUP_ MACRO
  14 |     lea  ESI, [ESI-4]
  15 |     mov  [ESI], EAX
  16 | ENDM
  17 | 
  18 | DROP MACRO
  19 |     lodsd
  20 | ENDM
  21 | 
  22 | ;hp equ 800
  23 | ;vp equ 600
  24 | ;vesa equ 114h
  25 | hp equ 1024
  26 | vp equ 768
  27 | vesa equ 117h
  28 | buffer equ 604*256
  29 | include boot.asm ; boot boot0 hard
  30 | 
  31 | ;   100000 dictionary
  32 | ;    a0000 top of return stack
  33 | ;    9f800 top of data stack
  34 | ;    9d800 free
  35 | ;    97000 floppy buffer
  36 | ;     4800 source
  37 | icons equ 12*256*4 ; 3000
  38 | ;     7c00 BIOS boot sector
  39 | ;        0 Forth
  40 | 
  41 | warm: DUP_
  42 | start1: call ATI0
  43 | ;    mov  screen, offset nul
  44 | ;    xor  EAX, EAX
  45 |     call show0
  46 |     mov  forths, (forth1-forth0)/4
  47 |     mov  macros, (macro1-macro0)/4
  48 |     mov  EAX, 18
  49 |     call LOAD
  50 |     jmp  ACCEPT
  51 | 
  52 | Gods equ 28000h*4 ; 0A0000h
  53 | Godd equ Gods-750*4
  54 | mains equ Godd-1500*4
  55 | maind equ mains-750*4
  56 | ALIGN 4
  57 |     me dd offset God
  58 | screen dd 0 ; logo
  59 | 
  60 | ROUND: call unPAUSE
  61 | God     dd 0 ; Gods-2*4
  62 |     call unPAUSE
  63 | main    dd 0 ; mains-2*4
  64 |     jmp  ROUND
  65 | 
  66 | PAUSE: DUP_
  67 |     push ESI
  68 |     mov  EAX, me
  69 |     mov  [EAX], ESP
  70 |     add  EAX, 4
  71 |     jmp  EAX
  72 | 
  73 | unPAUSE: pop  EAX
  74 |     mov  ESP, [EAX]
  75 |     mov  me, EAX
  76 |     pop  ESI
  77 |     DROP
  78 |     ret
  79 | 
  80 | ACT: mov  EDX, maind-4
  81 |     mov  [EDX], EAX
  82 |     mov  EAX, mains-4
  83 |     pop  [EAX]
  84 |     sub  EAX, 4
  85 |     mov  [EAX], EDX
  86 |     mov  main, EAX
  87 |     DROP
  88 |     ret
  89 | 
  90 | show0: call show
  91 |     ret
  92 | show: pop  screen
  93 |     DUP_
  94 |     xor  EAX, EAX
  95 |     call ACT
  96 | @@:     call graphic
  97 |         call [screen]
  98 |         call SWITCH
  99 |         inc  EAX
 100 |         jmp  @b
 101 | 
 102 | c_:  mov  ESI, Godd+4
 103 |     ret
 104 | 
 105 | mark: mov  ECX, macros
 106 |     mov  mk, ECX
 107 |     mov  ECX, forths
 108 |     mov  mk+4, ECX
 109 |     mov  ECX, H
 110 |     mov  mk+2*4, ECX
 111 |     ret
 112 | 
 113 | empty: mov  ECX, mk+2*4
 114 |     mov  H, ECX
 115 |     mov  ECX, mk+4
 116 |     mov  forths, ECX
 117 |     mov  ECX, mk
 118 |     mov  macros, ECX
 119 |     mov  class, 0
 120 |     ret
 121 | 
 122 | mFIND: mov  ECX, macros
 123 |     push EDI
 124 |     lea  EDI, [macro0-4+ECX*4]
 125 |     jmp  @f
 126 | 
 127 | FIND: mov  ECX, forths
 128 |     push EDI
 129 |     lea  EDI, [forth0-4+ECX*4]
 130 | @@: std
 131 |     repne scasd
 132 |     cld
 133 |     pop  EDI
 134 |     ret
 135 | 
 136 | EX1: dec  words ; from keyboard
 137 |     jz   @f
 138 |         DROP
 139 |         jmp  EX1
 140 | @@: call FIND
 141 |     jnz  ABORT1
 142 |         DROP
 143 |         jmp  [forth2+ECX*4]
 144 | 
 145 | execute: mov  lit, offset alit
 146 |     DUP_
 147 |     mov  EAX, [-4+EDI*4]
 148 | ex2: and  EAX, -20o
 149 |     call FIND
 150 |     jnz  ABORT
 151 |         DROP
 152 |         jmp  [forth2+ECX*4]
 153 | 
 154 | ABORT: mov  curs, EDI
 155 |     shr  EDI, 10-2
 156 |     mov  blk, EDI
 157 | ABORT1: mov  ESP, Gods
 158 |     mov  spaces+3*4, offset forthd
 159 |     mov  spaces+4*4, offset qcompile
 160 |     mov  spaces+5*4, offset cnum
 161 |     mov  spaces+6*4, offset cshort
 162 |     mov  EAX, 57o ; ?
 163 |     call ECHO_
 164 |     jmp  ACCEPT
 165 | 
 166 | sDEFINE: pop  aDEFINE
 167 |     ret
 168 | MACRO_: call sDEFINE
 169 | macrod: mov  ECX, macros
 170 |     inc  macros
 171 |     lea  ECX, [macro0+ECX*4]
 172 |     jmp  @f
 173 | 
 174 | FORTH: call sDEFINE
 175 | forthd: mov  ECX, forths
 176 |     inc  forths
 177 |     lea  ECX, [forth0+ECX*4]
 178 | @@: mov  EDX, [-4+EDI*4]
 179 |     and  EDX, -20o
 180 |     mov  [ECX], EDX
 181 |     mov  EDX, h
 182 |     mov  [forth2-forth0+ECX], EDX
 183 |     lea  EDX, [forth2-forth0+ECX]
 184 |     shr  EDX, 2
 185 |     mov  last, EDX
 186 |     mov  list, ESP
 187 |     mov  lit, offset adup
 188 |     test class, -1
 189 |     jz   @f
 190 |         jmp  [class]
 191 | @@: ret
 192 | 
 193 | cdrop: mov  EDX, h
 194 |     mov  list, EDX
 195 |     mov  byte ptr [EDX], 0adh ; lodsd
 196 |     inc  h
 197 |     ret
 198 | 
 199 | qdup: mov  EDX, h
 200 |     dec  EDX
 201 |     cmp  list, EDX
 202 |     jnz  cdup
 203 |     cmp  byte ptr [EDX], 0adh
 204 |     jnz  cdup
 205 |         mov  h, EDX
 206 |         ret
 207 | cdup: mov  EDX, h
 208 |     mov  dword ptr [EDX], 89fc768dh
 209 |     mov  byte ptr [4+EDX], 06
 210 |     add  h, 5
 211 |     ret
 212 | 
 213 | adup: DUP_
 214 |     ret
 215 | 
 216 | var1: DUP_
 217 |     mov  EAX, [4+forth0+ECX*4]
 218 |     ret
 219 | variable: call forthd
 220 |     mov  [forth2-forth0+ECX], offset var1
 221 |     inc  forths ; dummy entry for source address
 222 |     mov  [4+ECX], EDI
 223 |     call macrod
 224 |     mov  [forth2-forth0+ECX], offset @f
 225 |     inc  macros
 226 |     mov  [4+ECX], EDI
 227 |     inc  EDI
 228 |     ret
 229 | @@: call [lit]
 230 |     mov  EAX, [4+macro0+ECX*4]
 231 |     jmp  @f
 232 | 
 233 | cNUM: call [lit]
 234 |     mov  EAX, [EDI*4]
 235 |     inc  EDI
 236 |     jmp  @f
 237 | 
 238 | cSHORT: call [lit]
 239 |     mov  EAX, [-4+EDI*4]
 240 |     sar  EAX, 5
 241 | @@: call literal
 242 |     DROP
 243 |     ret
 244 | 
 245 | alit: mov lit, offset adup
 246 | literal: call qDUP
 247 |     mov  EDX, list
 248 |     mov  list+4, EDX
 249 |     mov  EDX, h
 250 |     mov  list, EDX
 251 |     mov  byte ptr [EDX], 0b8h
 252 |     mov  [1+EDX], EAX
 253 |     add  h, 5
 254 |     ret
 255 | 
 256 | qCOMPILE: call [lit]
 257 |     mov  EAX, [-4+EDI*4]
 258 |     and  EAX, -20o
 259 |     call mFIND
 260 |     jnz  @f
 261 |         DROP
 262 |         jmp  [macro2+ECX*4]
 263 | @@: call FIND
 264 |     mov  EAX, [forth2+ECX*4]
 265 | @@: jnz  ABORT
 266 | call_: mov  EDX, h
 267 |     mov  list, EDX
 268 |     mov  byte ptr [EDX], 0e8h
 269 |     add  EDX, 5
 270 |     sub  EAX, EDX
 271 |     mov  [-4+EDX], EAX
 272 |     mov  h, EDX
 273 |     DROP
 274 |     ret
 275 | 
 276 | COMPILE: call [lit]
 277 |     mov  EAX, [-4+EDI*4]
 278 |     and  EAX, -20o
 279 |     call mFIND
 280 |     mov  EAX, [macro2+ECX*4]
 281 |     jmp  @b
 282 | 
 283 | SHORT_: mov lit, offset alit
 284 |     DUP_
 285 |     mov  EAX, [-4+EDI*4]
 286 |     sar  EAX, 5
 287 |     ret
 288 | 
 289 | NUM: mov lit, offset alit
 290 |     DUP_
 291 |     mov  EAX, [EDI*4]
 292 |     inc  EDI
 293 |     ret
 294 | 
 295 | comma: mov  ECX, 4
 296 | @@: mov  EDX, h
 297 |     mov  [EDX], EAX
 298 |     mov  EAX, [ESI] ; drop
 299 |     lea  EDX, [EDX+ECX]
 300 |     lea  ESI, [ESI+4]
 301 |     mov  h, EDX
 302 | ;    DROP
 303 |     ret
 304 | 
 305 | comma1: mov  ECX, 1
 306 |     jmp  @b
 307 | 
 308 | comma2: mov  ECX, 2
 309 |     jmp  @b
 310 | 
 311 | comma3: mov  ECX, 3
 312 |     jmp  @b
 313 | 
 314 | semi: mov  EDX, h
 315 |     sub  EDX, 5
 316 |     cmp  list, EDX
 317 |     jnz  @f
 318 |     cmp  byte ptr [EDX], 0e8h
 319 |     jnz  @f
 320 |         inc  byte ptr [EDX] ; jmp
 321 |         ret
 322 | @@: mov  byte ptr [5+EDX], 0c3h ; ret
 323 |     inc  h
 324 |     ret
 325 | 
 326 | then: mov  list, ESP
 327 |     mov  EDX, h
 328 |     sub  EDX, EAX
 329 |     mov  [-1+EAX], DL
 330 |     DROP
 331 |     ret
 332 | 
 333 | begin: mov  list, ESP
 334 | here: DUP_
 335 |     mov  EAX, h
 336 |     ret
 337 | 
 338 | qlit: mov  EDX, h
 339 |     lea  EDX, [EDX-5]
 340 |     cmp  list, EDX
 341 |     jnz  @f
 342 |     cmp  byte ptr [EDX], 0b8h
 343 |     jnz  @f
 344 |         DUP_
 345 |         mov  EAX, list+4
 346 |         mov  list, EAX
 347 |         mov  EAX, [1+EDX]
 348 |         cmp  dword ptr [EDX-5], 89fc768dh ; dup
 349 |         jz   q1
 350 |             mov  h, EDX
 351 |             jmp  cdrop            
 352 | q1:     add  h, -10 ; flag nz
 353 |         ret
 354 | @@: xor  EDX, EDX ; flag z
 355 |     ret
 356 | 
 357 | less: cmp  [ESI], EAX
 358 |     js   @f ; flag nz
 359 |         xor  ECX, ECX ; flag z
 360 | @@: ret
 361 | 
 362 | qIGNORE: test dword ptr [-4+EDI*4], -20o
 363 |     jnz  nul
 364 |         pop  EDI
 365 |         pop  EDI
 366 | nul: ret
 367 | 
 368 | jump: pop  EDX
 369 |     add  EDX, EAX
 370 |     lea  EDX, [5+EAX*4+EDX]
 371 |     add  EDX, [-4+EDX]
 372 |     DROP
 373 |     jmp  EDX
 374 | 
 375 | LOAD: shl  EAX, 10-2
 376 |     push EDI
 377 |     mov  EDI, EAX
 378 |     DROP
 379 | INTER:  mov  EDX, [EDI*4]
 380 |         inc  EDI
 381 |         and  EDX, 17o
 382 |         call spaces[EDX*4]
 383 |         jmp  INTER
 384 | 
 385 | ALIGN 4
 386 |  spaces dd offset qIGNORE, offset execute, offset NUM
 387 | aDEFINE dd 5+offset MACRO_ ; offset macrod ?
 388 |         dd offset qCOMPILE, offset cNUM, offset cSHORT, offset COMPILE
 389 |         dd offset SHORT_, offset nul, offset nul, offset nul
 390 |         dd offset variable, offset nul, offset nul, offset nul
 391 | 
 392 |    lit dd offset adup
 393 |     mk dd 0, 0, 0
 394 |      H dd 40000h*4
 395 |   last dd 0
 396 |  class dd 0
 397 |   list dd 0, 0
 398 | macros dd 0
 399 | forths dd 0
 400 | ;macro0 dd (3 shl 4+1)shl 24 ; or
 401 | ;       dd ((5 shl 4+6)shl 7+140o)shl 17 ; and
 402 | ;       dd 173o shl 25 ; +
 403 | macro0 dd 170o shl 25 ; ;
 404 |        dd ((140o shl 7+146o)shl 7+142o)shl 11 ; dup
 405 |        dd (((177o shl 7+140o)shl 7+146o)shl 7+142o)shl 4 ; ?dup
 406 |        dd (((140o shl 4+1)shl 4+3)shl 7+142o)shl 10 ; drop
 407 | ;       dd ((6 shl 4+7)shl 7+142o)shl 17 ; nip
 408 |        dd (((2 shl 7+144o)shl 4+4)shl 4+6)shl 13 ; then
 409 |        dd ((((143o shl 4+4)shl 5+25o)shl 4+7)shl 4+6)shl 8 ; begin
 410 | macro1 dd 128 dup (0)
 411 | forth0 dd (((143o shl 4+3)shl 4+3)shl 4+2)shl 13 ; boot
 412 |        dd (((27o shl 4+5)shl 4+1)shl 5+21o)shl 14 ; warm
 413 |        dd ((((142o shl 4+5)shl 7+146o)shl 5+20o)shl 4+4)shl 5 ; pause
 414 |        dd ((((21o shl 4+5)shl 5+22o)shl 4+1)shl 4+3)shl 10 ; MACRO
 415 |        dd ((((26o shl 4+3)shl 4+1)shl 4+2)shl 7+144o)shl 8 ; FORTH
 416 |        dd 22o shl 27 ; c
 417 |        dd (((20o shl 4+2)shl 4+3)shl 7+142o)shl 12 ; stop
 418 |        dd (((1 shl 4+4)shl 4+5)shl 7+140o)shl 13 ; read
 419 |        dd ((((27o shl 4+1)shl 4+7)shl 4+2)shl 4+4)shl 11 ; write
 420 |        dd (6 shl 5+22o)shl 23 ; nc
 421 |        dd (((((22o shl 4+3)shl 5+21o)shl 5+21o)shl 4+5)shl 4+6)shl 5; comman d
 422 |        dd (((20o shl 4+4)shl 4+4)shl 7+164o)shl 12 ; seek
 423 |        dd ((((1 shl 4+4)shl 4+5)shl 7+140o)shl 5+23o)shl 8 ; ready
 424 | ;       dd (((22o shl 5+24o)shl 4+1)shl 4+7)shl 14 ; clri
 425 |        dd ((5 shl 5+22o)shl 4+2)shl 19 ; ACT
 426 |        dd (((20o shl 7+144o)shl 4+3) shl 5+27o)shl 11 ; SHOW
 427 |        dd (((24o shl 4+3)shl 4+5)shl 7+140o)shl 12 ; LOAD
 428 |        dd (((144o shl 4+4)shl 4+1)shl 4+4)shl 13 ; here
 429 |        dd (((177o shl 5+24o)shl 4+7)shl 4+2)shl 12 ; ?lit
 430 |        dd (153o shl 7+176o) shl 18 ; 3,
 431 |        dd (152o shl 7+176o) shl 18 ; 2,
 432 |        dd (151o shl 7+176o) shl 18 ; 1,
 433 |        dd 176o shl 25 ; ,
 434 |        dd (((24o shl 4+4)shl 5+20o)shl 5+20o)shl 13 ; less
 435 |        dd (((162o shl 7+146o)shl 5+21o)shl 7+142o)shl 6 ; jump
 436 |        dd (((((5 shl 5+22o)shl 5+22o)shl 4+4)shl 7+142o)shl 4+2)shl 3 ; accept
 437 |        dd ((142o shl 4+5)shl 7+140o)shl 14 ; pad
 438 |        dd ((((4 shl 4+1)shl 4+5)shl 5+20o)shl 4+4)shl 11 ; erase
 439 |        dd (((22o shl 4+3)shl 7+142o)shl 5+23o)shl 11 ; copy
 440 |        dd (((21o shl 4+5)shl 4+1)shl 7+164o)shl 12 ; mark
 441 |        dd (((4 shl 5+21o)shl 7+142o)shl 4+2)shl 12 ; empt
 442 |        dd (((4 shl 5+21o)shl 4+7)shl 4+2)shl 15 ; emit
 443 |        dd ((((140o shl 4+7)shl 5+25o)shl 4+7)shl 4+2)shl 8 ; digit
 444 |        dd ((((152o shl 4+4)shl 5+21o)shl 4+7)shl 4+2)shl 8 ; 2emit
 445 |        dd 165o shl 25 ; .
 446 |        dd (144o shl 7+165o)shl 18 ; h.
 447 |        dd ((144o shl 7+165o)shl 4+6)shl 14 ; h.n
 448 |        dd (22o shl 4+1)shl 23 ; CR
 449 |        dd ((((20o shl 7+142o)shl 4+5)shl 5+22o)shl 4+4)shl 7 ; space
 450 |        dd (((140o shl 4+3)shl 5+27o)shl 4+6)shl 12 ; DOWN
 451 |        dd (((4 shl 7+140o)shl 4+7)shl 4+2)shl 13 ; edit
 452 |        dd 4 shl 28 ; E
 453 | ;       dd (((26o shl 4+3)shl 4+6)shl 4+2)shl 15 ; font
 454 |        dd (24o shl 5+21o)shl 22 ; lm
 455 |        dd (1 shl 5+21o)shl 23 ; rm
 456 |        dd ((((25o shl 4+1)shl 4+5)shl 7+142o)shl 7+144o)shl 5 ; graph ic
 457 |        dd (((2 shl 4+4)shl 7+145o)shl 4+2)shl 13 ; text
 458 | ;       dd (153o shl 7+140o)shl 18 ; 3d
 459 | ;       dd (((((1 shl 4+4)shl 4+6)shl 7+140o)shl 4+4)shl 4+1)shl 5 ; render
 460 | ;       dd ((((141o shl 4+4)shl 4+1)shl 4+2)shl 4+4)shl 9 ; verte x
 461 | ;       dd ((((26o shl 4+1)shl 4+3)shl 4+6)shl 4+2)shl 11 ; front
 462 | ;       dd ((2 shl 4+3)shl 7+142o)shl 17 ; top
 463 | ;       dd (((20o shl 4+7)shl 7+140o)shl 4+4)shl 12 ; side
 464 |        dd ((((164o shl 4+4)shl 5+23o)shl 7+143o)shl 4+3)shl 5 ; keybo ard
 465 |        dd (((140o shl 4+4)shl 7+143o)shl 7+146o)shl 7 ; debu g
 466 |        dd (5 shl 4+2)shl 24 ; at
 467 |        dd ((173o shl 4+5)shl 4+2)shl 17 ; +at
 468 |        dd (145o shl 5+23o)shl 20 ; xy
 469 |        dd ((26o shl 4+3)shl 7+141o)shl 16 ; fov
 470 |        dd (((26o shl 4+7)shl 5+26o)shl 4+3)shl 14 ; fifo
 471 |        dd ((143o shl 4+3)shl 7+145o)shl 14 ; box
 472 |        dd (((24o shl 4+7)shl 4+6)shl 4+4)shl 15 ; line
 473 |        dd ((((22o shl 4+3)shl 5+24o)shl 4+3)shl 4+1)shl 10 ; color
 474 | ;       dd (((22o shl 5+24o)shl 4+7)shl 7+142o)shl 11 ; clip
 475 |        dd (((((3 shl 5+22o)shl 4+2)shl 4+5)shl 4+6)shl 4+2)shl 7 ; octant
 476 |        dd (20o shl 7+142o)shl 20 ; sp
 477 |        dd (((24o shl 4+5)shl 5+20o)shl 4+2)shl 14 ; last
 478 |        dd (((((146o shl 4+6)shl 7+142o)shl 4+5)shl 5+22o))shl 5 ; unpac k
 479 | ;       dd (((142o shl 4+5)shl 5+22o)shl 7+164o)shl 9 ; pack
 480 | forth1 dd 512 dup (0)
 481 | ;macro2 dd offset cOR
 482 | ;       dd offset cAND
 483 | ;       dd offset PLUS
 484 | macro2 dd offset semi
 485 |        dd offset cdup
 486 |        dd offset qdup
 487 |        dd offset cdrop
 488 | ;       dd offset nip
 489 |        dd offset then
 490 |        dd offset begin
 491 |        dd 128 dup (0)
 492 | forth2 dd offset boot
 493 |        dd offset warm
 494 |        dd offset PAUSE
 495 |        dd offset MACRO_
 496 |        dd offset FORTH
 497 |        dd offset c_
 498 |        dd offset stop
 499 |        dd offset readf
 500 |        dd offset writef
 501 |        dd offset nc_
 502 |        dd offset cmdf
 503 |        dd offset seekf
 504 |        dd offset readyf
 505 |        dd offset ACT
 506 |        dd offset SHOW
 507 |        dd offset LOAD
 508 |        dd offset here
 509 |        dd offset qlit
 510 |        dd offset COMMA3
 511 |        dd offset COMMA2
 512 |        dd offset COMMA1
 513 |        dd offset COMMA
 514 |        dd offset less
 515 |        dd offset jump
 516 |        dd offset ACCEPT
 517 |        dd offset pad
 518 |        dd offset erase
 519 |        dd offset copy
 520 |        dd offset mark
 521 |        dd offset empty
 522 |        dd offset emit
 523 |        dd offset eDIG
 524 |        dd offset emit2
 525 |        dd offset dot10
 526 |        dd offset hdot
 527 |        dd offset hdotn
 528 |        dd offset CR
 529 |        dd offset space
 530 |        dd offset DOWN
 531 |        dd offset edit
 532 |        dd offset E
 533 | ;       dd offset font
 534 |        dd offset LMs
 535 |        dd offset RMs
 536 |        dd offset graphic
 537 |        dd offset text1
 538 | ;       dd offset set3d
 539 | ;       dd offset render
 540 | ;       dd offset vertex
 541 | ;       dd offset front
 542 | ;       dd offset top_
 543 | ;       dd offset side
 544 |        dd offset keyboard
 545 |        dd offset debug
 546 |        dd offset at
 547 |        dd offset pat
 548 |        dd offset xy_
 549 |        dd offset fov_
 550 |        dd offset fifof
 551 |        dd offset box
 552 |        dd offset line
 553 |        dd offset color
 554 | ;       dd offset clip
 555 |        dd offset octant
 556 |        dd offset sps
 557 |        dd offset last_
 558 |        dd offset unpack
 559 | ;       dd offset pack
 560 |        dd 512 dup (0)
 561 | 
 562 | boot: mov  AL, 0FEh ; Reset
 563 |     out  64h, AL
 564 |     jmp  $
 565 | 
 566 | erase: mov  ECX, EAX
 567 |     shl  ECX, 8
 568 |     DROP
 569 |     push EDI
 570 |      mov  EDI, EAX
 571 |      shl  EDI, 2+8
 572 |      xor  EAX, EAX
 573 |      rep stosd
 574 |     pop EDI
 575 |     DROP
 576 |     ret
 577 | 
 578 | ;move: mov  ECX, EAX
 579 | ;    DROP
 580 | ;    mov  EDI, EAX
 581 | ;    shl  EDI, 2
 582 | ;    DROP
 583 | ;    push ESI
 584 | ;     mov  ESI, EAX
 585 | ;     shl  ESI, 2
 586 | ;     rep movsd
 587 | ;    pop  ESI
 588 | ;    DROP
 589 | ;    ret
 590 | 
 591 | copy: cmp  EAX, 12
 592 |     jc   ABORT1
 593 |     mov  EDI, EAX
 594 |     shl  EDI, 2+8
 595 |     push ESI
 596 |      mov  ESI, blk
 597 |      shl  ESI, 2+8
 598 |      mov  ECX, 256
 599 |      rep movsd
 600 |     pop  ESI
 601 |     mov  blk, EAX
 602 |     DROP
 603 |     ret
 604 | 
 605 | debug: mov  xy, 3*10000h+(vc-2)*ih+3
 606 |     DUP_
 607 |     mov  EAX, God
 608 |     push [EAX]
 609 |     call dot
 610 |     DUP_
 611 |     pop  EAX
 612 |     call dot
 613 |     DUP_
 614 |     mov  EAX, main
 615 |     call dot
 616 |     DUP_
 617 |     mov  EAX, ESI
 618 |     jmp  dot
 619 | 
 620 | iw equ 16+6
 621 | ih equ 24+6
 622 | hc equ hp/iw ; 46
 623 | vc equ vp/ih ; 25
 624 | ALIGN 4
 625 | xy  dd 3*10000h+3
 626 | lm  dd 3
 627 | rm  dd hc*iw ; 1012
 628 | xycr dd 0
 629 | fov dd 10*(2*vp+vp/2)
 630 | 
 631 | nc_: DUP_
 632 |     mov  EAX, (offset nc-offset start)/4
 633 |     ret
 634 | 
 635 | xy_: DUP_
 636 |     mov  EAX, (offset xy-offset start)/4
 637 |     ret
 638 | 
 639 | fov_: DUP_
 640 |     mov  EAX, (offset fov-offset start)/4
 641 |     ret
 642 | 
 643 | sps: DUP_
 644 |     mov  EAX, (offset spaces-offset start)/4
 645 |     ret
 646 | 
 647 | last_: DUP_
 648 |     mov  EAX, (offset last-offset start)/4
 649 |     ret
 650 | 
 651 | include gen.asm ; cce.asm pio.asm ATI128.asm ATI64.asm gen.asm
 652 | 
 653 | yellow equ 0ffff00h
 654 | CYAN: DUP_
 655 |     mov  EAX, 0ffffh
 656 |     jmp  color
 657 | MAGENTA: DUP_
 658 |     mov  EAX, 0ff00ffh
 659 |     jmp  color
 660 | SILVER: DUP_
 661 |     mov  EAX, 0c0c0c0h
 662 |     jmp  color
 663 | BLUE: DUP_
 664 |     mov  EAX, 4040ffh
 665 |     jmp  color
 666 | RED: DUP_
 667 |     mov  EAX, 0ff0000h
 668 |     jmp  color
 669 | GREEN: DUP_
 670 |     mov  EAX, 8000ff00h
 671 |     jmp  color
 672 | 
 673 | history db 11 dup (0)
 674 | ECHO_: push ESI
 675 |      mov  ECX, 11-1
 676 |      lea  EDI, history
 677 |      lea  ESI, [1+EDI]
 678 |      rep movsb
 679 |     pop  ESI
 680 |     mov  history+11-1, AL
 681 |     DROP
 682 |     ret
 683 | 
 684 | RIGHT: DUP_
 685 |     mov  ECX, 11
 686 |     lea  EDI, history
 687 |     xor  EAX, EAX
 688 |     rep stosb
 689 |     DROP
 690 |     ret
 691 | 
 692 | DOWN: DUP_
 693 |     xor  EDX, EDX
 694 |     mov  ECX, ih
 695 |     div  ECX
 696 |     mov  EAX, EDX
 697 |     add  EDX, 3*10000h+8000h-ih+3
 698 |     mov  xy, EDX
 699 | ZERO: test EAX, EAX
 700 |     mov  EAX, 0
 701 |     jnz  @f
 702 |         inc  EAX
 703 | @@: ret
 704 | 
 705 | blank: DUP_
 706 |     xor  EAX, EAX
 707 |     mov  xy, EAX
 708 |     call color
 709 |     DUP_
 710 |     mov  EAX, hp
 711 |     DUP_
 712 |     mov  EAX, vp
 713 |     jmp  box
 714 | 
 715 | TOP: mov  ECX, lm
 716 |     shl  ECX, 16
 717 |     add  ECX, 3
 718 |     mov  xy, ECX
 719 |     mov  xycr, ECX
 720 |     ret
 721 | 
 722 | qcr: mov  CX, word ptr xy+2
 723 |     cmp  CX, word ptr rm
 724 |     js   @f
 725 | cr: mov  ECX, lm
 726 |     shl  ECX, 16
 727 |     mov  CX, word ptr xy
 728 |     add  ECX, ih
 729 |     mov  xy, ECX
 730 | @@: ret
 731 | 
 732 | LMs: mov  lm, EAX
 733 |     DROP
 734 |     ret
 735 | 
 736 | RMs: mov  rm, EAX
 737 |     DROP
 738 |     ret
 739 | 
 740 | at: mov  word ptr xy, AX
 741 |     DROP
 742 |     mov  word ptr xy+2, AX
 743 |     DROP
 744 |     ret
 745 | 
 746 | pAT: add  word ptr xy, AX
 747 |     DROP
 748 |     add  word ptr xy+2, AX
 749 |     DROP
 750 |     ret
 751 | 
 752 | ;cl1: xor  EAX, EAX
 753 | ;    mov  [ESI], EAX
 754 | ;    ret
 755 | ;clip: movsx EDX, word ptr xy
 756 | ;    cmp  EDX, vp
 757 | ;    jns  cl1
 758 | ;    add  EAX, EDX
 759 | ;    js   cl1
 760 | ;    test EDX, EDX
 761 | ;    jns  @f
 762 | ;        xor  EDX, EDX
 763 | ;@@: cmp  EAX, vp
 764 | ;    js   @f
 765 | ;        mov  EAX, vp
 766 | ;@@: sub  EAX, EDX
 767 | ;    mov  word ptr xy, DX
 768 | ;    movsx EDX, word ptr xy+2
 769 | ;    cmp  EDX, hp
 770 | ;    jns  cl1
 771 | ;    add  [ESI], EDX
 772 | ;    js   cl1
 773 | ;    test EDX, EDX
 774 | ;    jns  @f
 775 | ;        xor  EDX, EDX
 776 | ;@@: cmp  dword ptr [ESI], hp
 777 | ;    js   @f
 778 | ;        mov  dword ptr [ESI], hp
 779 | ;@@: sub  [ESI], EDX
 780 | ;    mov  word ptr xy+2, DX
 781 | ;    ret
 782 | 
 783 | octant: DUP_
 784 |     mov  EAX, 43h ; poly -last y+ x+ ;23h ; last y+ x+
 785 |     mov  EDX, [4+ESI]
 786 |     test EDX, EDX
 787 |     jns  @f
 788 |         neg  EDX
 789 |         mov  [4+ESI], EDX
 790 |         xor  AL, 1
 791 | @@: cmp  EDX, [ESI]
 792 |     jns  @f
 793 |         xor  AL, 4
 794 | @@: ret
 795 | 
 796 | ; Keyboard
 797 | EIGHT: add  EDI, 12
 798 |     call FOUR
 799 |     call SPACE
 800 |     sub  EDI, 16
 801 | FOUR: mov  ECX, 4
 802 | FOUR1:  push ECX
 803 |         DUP_
 804 |         xor  EAX, EAX
 805 |         mov  AL, [4+EDI]
 806 |         inc  EDI
 807 |         call EMIT
 808 |         pop  ECX
 809 |         next FOUR1
 810 |     ret
 811 | 
 812 | stack: mov  EDI, Godd-4
 813 | @@: mov  EDX, God
 814 |     cmp  [EDX], EDI
 815 |     jnc  @f
 816 |         DUP_
 817 |         mov  EAX, [EDI]
 818 |         sub  EDI, 4
 819 |         call qDOT
 820 |         jmp  @b
 821 | @@: ret
 822 | 
 823 | KEYBOARD: call text1
 824 |     mov  EDI, board
 825 |     DUP_
 826 |     mov  EAX, keyc
 827 |     call color
 828 |     mov  rm, hc*iw
 829 |     mov  lm, hp-9*iw+3
 830 |     mov  xy, (hp-9*iw+3)*10000h+vp-4*ih+3
 831 |     call EIGHT
 832 |     call EIGHT
 833 |     call EIGHT
 834 |     call CR
 835 |     add  xy, 4*iw*10000h
 836 |     mov  EDI, shift
 837 |     add  EDI, 4*4-4
 838 |     mov  ECX, 3
 839 |     call FOUR1
 840 |     mov  lm, 3
 841 |     mov  word ptr xy+2, 3
 842 |     call stack
 843 |     mov  word ptr xy+2, hp-(11+9)*iw+3
 844 |     lea  EDI, history-4
 845 |     mov  ECX, 11
 846 |     jmp  FOUR1
 847 | 
 848 | alpha db 15o, 12o,  1 , 14o
 849 |       db 24o,  2 ,  6 , 10o
 850 |       db 23o, 11o, 17o, 21o
 851 |       db 22o, 13o, 16o,  7
 852 |       db  5 ,  3 ,  4 , 26o
 853 |       db 27o, 44o, 25o, 20o
 854 | graphics db 31o, 32o, 33o,  0 
 855 |          db 34o, 35o, 36o, 30o
 856 |          db 37o, 40o, 41o, 57o
 857 |          db 51o, 50o, 52o, 54o ; : ; ! @
 858 |          db 46o, 42o, 45o, 56o ; Z J . ,
 859 |          db 55o, 47o, 53o, 43o ; * / + -
 860 | numbers db 31o, 32o, 33o,  0
 861 |         db 34o, 35o, 36o, 30o
 862 |         db 37o, 40o, 41o,  0
 863 |         db  0,   0 ,  0 ,  0
 864 |         db  0,   0 ,  0 ,  0
 865 |         db  0,   0 ,  0 ,  0
 866 | octals db 31o, 32o, 33o,  0
 867 |        db 34o, 35o, 36o, 30o
 868 |        db 37o, 40o, 41o,  0
 869 |        db  0 ,  5 , 23o, 12o
 870 |        db  0 , 20o,  4 , 16o
 871 |        db  0 ,  0 ,  0 ,  0
 872 | LETTER: cmp  AL, 4
 873 |     js   @f
 874 |         mov  EDX, board
 875 |         mov  AL, [EDX][EAX]
 876 | @@: ret
 877 | 
 878 | keys db 16, 17, 18, 19,  0,  0,  4,  5 ; 20
 879 |      db  6,  7,  0,  0,  0,  0, 20, 21
 880 |      db 22, 23,  0,  0,  8,  9, 10, 11 ; 40
 881 |      db  0,  0,  0,  0, 24, 25, 26, 27
 882 |      db  0,  1, 12, 13, 14, 15,  0,  0 ; 60 N
 883 |      db  3,  2 ; alt space
 884 | KEY: DUP_
 885 |     xor  EAX, EAX
 886 | @@:     call PAUSE
 887 |         in   AL, 144o
 888 |         test AL, 1
 889 |         jz   @b
 890 |     in   AL, 140o
 891 |     test AL, 360o
 892 |     jz   @b
 893 |     cmp  AL, 72o
 894 |     jnc  @b
 895 |     mov  AL, [keys-20o+EAX]
 896 |     ret
 897 | 
 898 | ALIGN 4
 899 | graph0 dd offset nul0, offset nul0, offset nul0, offset ALPH0
 900 |        db  0 ,  0 ,  5 , 0 ;     a
 901 | graph1 dd offset WORD0, offset X, offset LJ, offset ALPH
 902 |        db 25o, 45o,  5 , 0 ; x . a
 903 | alpha0 dd offset nul0, offset nul0, offset NUMBER, offset STAR0
 904 |        db  0 , 41o, 55o, 0 ;   9 *
 905 | alpha1 dd offset WORD0, offset X, offset LJ, offset GRAPH
 906 |        db 25o, 45o, 55o, 0 ; x . *
 907 |  numb0 dd offset nul0, offset MINUS, offset ALPHn, offset OCTAL
 908 |        db 43o,  5 , 16o, 0 ; - a f
 909 |  numb1 dd offset NUMBER0, offset Xn, offset ENDN, offset NUMBER0
 910 |        db 25o, 45o,  0 , 0 ; x .
 911 | 
 912 | board   dd offset alpha-4
 913 | shift   dd offset alpha0
 914 | base    dd 10
 915 | current dd offset decimal
 916 | keyc    dd yellow
 917 | chars   dd 1
 918 | aword   dd offset EX1
 919 | anumber dd offset nul
 920 | words   dd 1
 921 | 
 922 | nul0: DROP
 923 |     jmp  @f
 924 | ACCEPT:
 925 | acceptn: mov  shift, offset alpha0
 926 |     lea  EDI, alpha-4
 927 | ACCEPT1: mov  board, EDI
 928 | @@: call KEY
 929 |     cmp  AL, 4
 930 |     jns  first
 931 |     mov  EDX, shift
 932 |     jmp  dword ptr [EDX+EAX*4]
 933 | 
 934 | bits db 28
 935 | @@: add  EAX, 120o
 936 |     mov  CL, 7
 937 |     jmp  @f
 938 | PACK: cmp  AL, 20o
 939 |     jnc  @b
 940 |         mov  CL, 4
 941 |         test AL, 10o
 942 |         jz   @f
 943 |         inc  ECX
 944 |         xor  AL, 30o
 945 | @@: mov  EDX, EAX
 946 |     mov  CH, CL
 947 | @@: cmp  bits, CL
 948 |     jnc  @f
 949 |         shr  AL, 1
 950 |         jc   FULL
 951 |         dec  CL
 952 |         jmp  @b
 953 | @@: shl  dword ptr [ESI], CL
 954 |     xor  [ESI], EAX
 955 |     sub  bits, CL
 956 |     ret
 957 | 
 958 | LJ0: mov  CL, bits
 959 |     add  CL, 4
 960 |     shl  dword ptr [ESI], CL
 961 |     ret
 962 | 
 963 | LJ: call LJ0
 964 |     DROP
 965 |     ret
 966 | 
 967 | FULL: call LJ0
 968 |     inc  words
 969 |     mov  bits, 28
 970 |     sub  bits, CH
 971 |     mov  EAX, EDX
 972 |     DUP_
 973 |     ret
 974 | 
 975 | X:  call RIGHT
 976 |     mov  EAX, words
 977 |     lea  ESI, [EAX*4+ESI]
 978 |     DROP
 979 |     jmp  ACCEPT
 980 | 
 981 | WORD_: call RIGHT
 982 |     mov  words, 1
 983 |     mov  chars, 1
 984 |     DUP_
 985 |     mov  dword ptr [ESI], 0
 986 |     mov  bits, 28
 987 | WORD1:  call LETTER
 988 |         jns  @f
 989 |             mov  EDX, shift
 990 |             jmp  dword ptr [EDX+EAX*4]
 991 | @@:     test AL, AL
 992 |         jz   WORD0
 993 |         DUP_
 994 |         call ECHO_
 995 |         call PACK
 996 |         inc  chars
 997 | WORD0:  DROP
 998 |         call KEY
 999 |         jmp  WORD1
1000 | 
1001 | decimal: mov  base, 10
1002 |     mov  shift, offset numb0
1003 |     mov  board, offset numbers-4
1004 |     ret
1005 | 
1006 | hex: mov  base, 16
1007 |     mov  shift, offset numb0 ; oct0
1008 |     mov  board, offset octals-4
1009 |     ret
1010 | 
1011 | octal: xor current, (offset decimal-offset start) xor (offset hex-offset start)
1012 |     xor  byte ptr numb0+18, 41o xor 16o ; f vs 9
1013 |     call current
1014 |     jmp  NUMBER0
1015 | 
1016 | Xn: DROP
1017 |     DROP
1018 |     jmp  ACCEPTn
1019 | 
1020 | ;      db  0,  0,  0,  0
1021 | digit db 14, 10,  0,  0
1022 |       db  0,  0, 12,  0,  0,  0, 15,  0
1023 |       db 13,  0,  0, 11,  0,  0,  0,  0
1024 |       db  0,  1,  2,  3,  4,  5,  6,  7
1025 |       db  8,  9
1026 | sign db 0
1027 | MINUS: ; mov  AL, 43o ; -
1028 |     mov  sign, AL
1029 |     jmp  NUMBER2
1030 | 
1031 | NUMBER0: DROP
1032 |     jmp  NUMBER3
1033 | NUMBER: call current
1034 |     mov  sign, 0
1035 |     xor  EAX, EAX
1036 | NUMBER3: call KEY
1037 |     call LETTER
1038 |     jns  @f
1039 |         mov  EDX, shift
1040 |         jmp  dword ptr [EDX+EAX*4]
1041 | @@: test AL, AL
1042 |     jz   NUMBER0
1043 |     mov  AL, [digit-4+EAX]
1044 |     test sign, 37o
1045 |     jz   @f
1046 |         neg  EAX
1047 | @@: mov  EDX, [ESI]
1048 |     imul EDX, base
1049 |     add  EDX, EAX
1050 | @@: mov  [ESI], EDX
1051 | NUMBER2: DROP
1052 |     mov  shift, offset numb1
1053 |     jmp  NUMBER3
1054 | 
1055 | ENDN: DROP
1056 |     call [anumber]
1057 |     jmp  ACCEPTn
1058 | 
1059 | ALPHn: DROP
1060 | ALPH0: mov  shift, offset alpha0
1061 |     lea  EDI, alpha-4
1062 |     jmp  @f
1063 | STAR0: mov  shift, offset graph0
1064 |     lea  EDI, graphics-4
1065 | @@: DROP
1066 |     jmp  ACCEPT1
1067 | 
1068 | ALPH: mov  shift, offset alpha1
1069 |     lea  EDI, alpha-4
1070 |     jmp  @f
1071 | GRAPH: mov  shift, offset graph1
1072 |     lea  EDI, graphics-4
1073 | @@: mov  board, EDI
1074 |     jmp  WORD0
1075 | 
1076 | first: add  shift, 4*4+4
1077 |     call WORD_
1078 |     call [aword]
1079 |     jmp  ACCEPT
1080 | 
1081 | hicon db 30o, 31o, 32o, 33o, 34o, 35o, 36o, 37o
1082 |       db 40o, 41o,  5 , 23o, 12o, 20o,  4 , 16o 
1083 | eDIG1: DUP_
1084 | eDIG: push ECX
1085 |      mov  AL, hicon[EAX]
1086 |      call EMIT
1087 |     pop  ECX
1088 |     ret
1089 | 
1090 | oDIG: rol  EAX, 4
1091 |     DUP_
1092 |     and  EAX, 0Fh
1093 |     ret
1094 | 
1095 | hdotn: mov  EDX, EAX
1096 |     neg  EAX
1097 |     lea  ECX, [32+EAX*4]
1098 |     DROP
1099 |     rol  EAX, CL
1100 |     mov  ECX, EDX
1101 |     jmp  @f
1102 | hdot: mov  ECX, 8
1103 | @@:     call oDIG
1104 |         call eDIG
1105 |         next @b
1106 |     DROP
1107 |     ret
1108 | 
1109 | dot: mov  ECX, 7
1110 | @@:     call oDIG
1111 |         jnz  @h
1112 |         DROP
1113 |         next @b
1114 |     inc  ECX
1115 | @@:     call oDIG
1116 | @h1:    call eDIG
1117 |         next @b
1118 |     call space
1119 |     DROP
1120 |     ret
1121 | @h: inc  ECX
1122 |     jmp  @h1
1123 | 
1124 | qdot: cmp  base, 10
1125 |     jnz  dot
1126 | dot10: mov  EDX, EAX
1127 |     test EDX, EDX
1128 |     jns  @f
1129 |         neg  EDX
1130 |         DUP_
1131 |         mov  EAX, 43o
1132 |         call EMIT
1133 | @@: mov  ECX, 8
1134 | @@:     mov  EAX, EDX
1135 |         xor  EDX, EDX
1136 |         div  tens[ECX*4]
1137 |         test EAX, EAX
1138 |         jnz  D_1
1139 |         dec  ECX
1140 |         jns  @b
1141 |     jmp  D_2
1142 | @@:     mov  EAX, EDX
1143 |         xor  EDX, EDX
1144 |         div  tens[ECX*4]
1145 | D_1:    call eDIG1
1146 |         dec  ECX
1147 |         jns  @b
1148 | D_2: mov  EAX, EDX
1149 |     call eDIG1
1150 |     call space ; spcr
1151 |     DROP
1152 |     ret
1153 | 
1154 | unPACK: DUP_
1155 |     test EAX, EAX
1156 |     js   @f
1157 |         shl  dword ptr [ESI], 4
1158 |         rol  EAX, 4
1159 |         and  EAX, 7
1160 |         ret
1161 | @@: shl  EAX, 1
1162 |     js   @f
1163 |         shl  dword ptr [ESI], 5
1164 |         rol  EAX, 4
1165 |         and  EAX, 7
1166 |         xor  AL, 10o
1167 |         ret
1168 | @@: shl  dword ptr [ESI], 7
1169 |     rol  EAX, 6
1170 |     and  EAX, 77o
1171 |     sub  AL, 20o
1172 |     ret
1173 | 
1174 | qRING: DUP_
1175 |     inc  dword ptr [ESI]
1176 |     cmp  curs, EDI ; from abort, insert
1177 |     jnz  @f
1178 |         mov  curs, EAX        
1179 | @@: cmp  EAX, curs
1180 |     jz   RING
1181 |     jns  @f
1182 |         mov  pcad, EDI
1183 | @@: DROP
1184 |     ret
1185 | 
1186 | RING: mov  cad, EDI
1187 |     sub  xy, iw*10000h ; bksp
1188 |     DUP_
1189 |     mov  EAX, 0e04000h
1190 |     call color
1191 |     mov  EAX, 60o
1192 |     mov  CX, word ptr xy+2
1193 |     cmp  CX, word ptr rm
1194 |     js   @f
1195 |         call EMIT
1196 |         sub  xy, iw*10000h ; bksp
1197 |         ret
1198 | @@: jmp  EMIT
1199 | 
1200 | rW: mov  CX, word ptr xy+2
1201 |     cmp  CX, word ptr lm
1202 |     jz   @f
1203 |         call cr
1204 | @@: call RED
1205 |     jmp  TYPE_
1206 | 
1207 | gW: call GREEN
1208 |     jmp  TYPE_
1209 | mW: call CYAN
1210 |     jmp  TYPE_
1211 | wW: DUP_
1212 |     mov  EAX, yellow
1213 |     call color
1214 |     jmp  TYPE_
1215 | 
1216 | type0: sub  xy, iw*10000h ; call bspcr
1217 |     test dword ptr [-4+EDI*4], -20o
1218 |     jnz  type1
1219 |         dec  EDI
1220 |         mov  lcad, EDI
1221 |         call space
1222 |         call qRING
1223 |         pop  EDX ; End of block
1224 |         DROP
1225 |         jmp  KEYBOARD
1226 | 
1227 | Cap: call white
1228 |     DUP_
1229 |     mov  EAX, [-4+EDI*4]
1230 |     and  EAX, -20o
1231 |     call unPACK
1232 |     add  AL, 48
1233 |     call EMIT
1234 |     jmp  type2
1235 | 
1236 | CAPS: call white
1237 |     DUP_
1238 |     mov  EAX, [-4+EDI*4]
1239 |     and  EAX, -20o
1240 | @@:     call unPACK
1241 |         jz   @f
1242 |         add  AL, 48
1243 |         call EMIT
1244 |         jmp  @b
1245 | 
1246 | text: call WHITE
1247 | TYPE_:
1248 | type1: DUP_
1249 |     mov  EAX, [-4+EDI*4]
1250 |     and  EAX, -20o
1251 | type2:  call unPACK
1252 |         jz   @f
1253 |         call EMIT
1254 |         jmp  type2
1255 | @@: call space
1256 |     DROP
1257 |     DROP
1258 |     ret
1259 | 
1260 | gsW: mov  EDX, [-4+EDI*4]
1261 |     sar  EDX, 5
1262 |     jmp  gnW1
1263 | 
1264 | var: call MAGENTA
1265 |     call TYPE_
1266 | gnW: mov  EDX, [EDI*4]
1267 |     inc  EDI
1268 | gnW1: DUP_
1269 |     mov  EAX, 0f800h ; Green
1270 |     cmp  bas, offset dot10
1271 |     jz   @f        
1272 |         mov  EAX, 0c000h ; dark green
1273 |     jmp  @f
1274 | 
1275 | sW: mov  EDX, [-4+EDI*4]
1276 |     sar  EDX, 5
1277 |     jmp  nW1
1278 | 
1279 | nW: mov  EDX, [EDI*4]
1280 |     inc  EDI
1281 | nW1: DUP_
1282 |     mov  EAX, yellow
1283 |     cmp  bas, offset dot10
1284 |     jz   @f        
1285 |         mov  EAX, 0c0c000h ; dark yellow
1286 | @@: call color
1287 |     DUP_
1288 |     mov  EAX, EDX
1289 |     jmp  [bas]
1290 | 
1291 | REFRESH: call SHOW
1292 |     call blank
1293 |     call text1
1294 |     DUP_            ; Counter
1295 |     mov  EAX, lcad
1296 |     mov  cad, EAX ; for curs beyond end
1297 |     xor  EAX, EAX
1298 |     mov  EDI, blk
1299 |     shl  EDI, 10-2
1300 |     mov  pcad, EDI ; for curs=0
1301 | ref1:   test dword ptr [EDI*4], 0fh
1302 |         jz   @f
1303 |             call qRING
1304 | @@:     mov  EDX, [EDI*4]
1305 |         inc  EDI
1306 |         mov  bas, offset dot10
1307 |         test DL, 20o
1308 |         jz   @f
1309 |             mov  bas, offset dot
1310 | @@:     and  EDX, 17o
1311 |         call display[EDX*4]
1312 |         jmp  ref1
1313 | 
1314 | ALIGN 4
1315 | display dd offset TYPE0, offset wW, offset nW, offset rW
1316 |         dd offset gW, offset gnW, offset gsW, offset mW
1317 |         dd offset sW, offset text, offset Cap, offset CAPS
1318 |         dd offset var, offset nul, offset nul, offset nul
1319 | tens dd 10, 100, 1000, 10000, 100000, 1000000
1320 |      dd 10000000, 100000000, 1000000000
1321 | bas dd offset dot10
1322 | blk    dd 18
1323 | curs   dd 0
1324 | cad    dd 0
1325 | pcad   dd 0
1326 | lcad   dd 0
1327 | trash  dd buffer*4
1328 | ekeys dd offset nul, offset DEL, offset Eout, offset destack
1329 |       dd offset act1, offset act3, offset act4, offset shadow
1330 |       dd offset mcur, offset mmcur, offset ppcur, offset pcur
1331 |       dd offset mblk, offset actv, offset act7, offset pblk
1332 |       dd offset nul, offset act11, offset act10, offset act9
1333 |       dd offset nul, offset nul, offset nul, offset nul
1334 | ekbd0 dd offset nul, offset nul, offset nul, offset nul
1335 |      db 25o, 45o,  7 ,  0  ; x  .  i
1336 | ekbd db 17o,  1 , 15o, 55o ; w  r  g  *
1337 |      db 14o, 26o, 20o,  1  ; l  u  d  r
1338 |      db 43o, 11o, 12o, 53o ; -  m  c  +
1339 |      db  0 , 70o, 72o,  2  ;    S  C  t
1340 |      db  0 ,  0 ,  0 ,  0
1341 |      db  0 ,  0 ,  0 ,  0
1342 | actc dd yellow, 0, 0ff0000h, 0c000h, 0, 0, 0ffffh
1343 |      dd 0, 0ffffffh, 0ffffffh, 0ffffffh, 8080ffh
1344 | vector dd 0
1345 | action db 1
1346 | 
1347 | act1: mov  AL, 1
1348 |     jmp  @f
1349 | act3: mov  AL, 3
1350 |     jmp  @f
1351 | act4: mov  AL, 4
1352 |     jmp  @f
1353 | act9: mov  AL, 9
1354 |     jmp  @f
1355 | act10: mov  AL, 10
1356 |     jmp  @f
1357 | act11: mov  AL, 11
1358 |     jmp  @f
1359 | act7: mov  AL, 7
1360 | @@: mov  action, AL
1361 |     mov  EAX, [actc-4+EAX*4]
1362 |     mov  aword, offset insert
1363 | actn: mov  keyc, EAX
1364 |     pop  EAX
1365 |     DROP
1366 |     jmp  ACCEPT
1367 | 
1368 | actv: mov  action, 12
1369 |     mov  EAX, 0ff00ffh ; Magenta
1370 |     mov  aword, offset @f
1371 |     jmp  actn
1372 | 
1373 | @@: DUP_
1374 |     xor  EAX, EAX
1375 |     inc  words
1376 |     jmp  insert    
1377 | 
1378 | mcur: dec  curs
1379 |     jns  @f
1380 | pcur: inc  curs
1381 | @@: ret
1382 | 
1383 | mmcur: sub  curs, 8
1384 |     jns  @f
1385 |         mov  curs, 0
1386 | @@: ret
1387 | ppcur: add  curs, 8
1388 |     ret
1389 | 
1390 | pblk: add  blk, 2
1391 |     add  dword ptr [ESI], 2
1392 |     ret
1393 | mblk: cmp  blk, 20
1394 |     js   @f
1395 |         sub  blk, 2 
1396 |         sub  dword ptr [ESI], 2
1397 | @@: ret
1398 | 
1399 | shadow: xor  blk, 1
1400 |     xor  dword ptr [ESI], 1
1401 |     ret
1402 | 
1403 | E0: DROP
1404 |     jmp  @f
1405 | 
1406 | edit: mov  blk, EAX
1407 |     DROP
1408 | E:  DUP_
1409 |     mov  EAX, blk
1410 |     mov  anumber, offset FORMAT
1411 |     mov  byte ptr alpha0+4*4, 45o ; .
1412 |     mov  alpha0+4, offset E0
1413 |     call REFRESH
1414 | @@: mov  shift, offset ekbd0
1415 |     mov  board, offset ekbd-4
1416 |     mov  keyc, yellow
1417 | @@:     call KEY
1418 |         call ekeys[EAX*4]
1419 |         DROP
1420 |         jmp  @b
1421 | 
1422 | eout: pop  EAX
1423 |     DROP
1424 |     DROP
1425 |     mov  aword, offset EX1
1426 |     mov  anumber, offset nul
1427 |     mov  byte ptr alpha0+4*4, 0
1428 |     mov  alpha0+4, offset nul0
1429 |     mov  keyc, yellow
1430 |     jmp  ACCEPT
1431 | 
1432 | destack: mov  EDX, trash
1433 |     cmp  EDX, buffer*4
1434 |     jnz  @f
1435 |         ret
1436 | @@: sub  EDX, 2*4
1437 |     mov  ECX, [EDX+1*4]
1438 |     mov  words, ECX
1439 | @@:     DUP_
1440 |         mov  EAX, [EDX]
1441 |         sub  EDX, 1*4
1442 |         next @b
1443 |     add  EDX, 1*4
1444 |     mov  trash, EDX
1445 | 
1446 | insert0: mov  ECX, lcad  ; room available?
1447 |      add  ECX, words
1448 |      xor  ECX, lcad
1449 |      and  ECX, -100h
1450 |      jz   insert1
1451 |          mov  ECX, words ; no
1452 | @@:          DROP
1453 |              next @b
1454 |          ret
1455 | insert1: push ESI
1456 |      mov  ESI, lcad
1457 |      mov  ECX, ESI
1458 |      dec  ESI
1459 |      mov  EDI, ESI
1460 |      add  EDI, words
1461 |      shl  EDI, 2
1462 |      sub  ECX, cad
1463 |      js   @f
1464 |          shl  ESI, 2
1465 |          std
1466 |          rep movsd
1467 |          cld
1468 | @@: pop  ESI
1469 |     shr  EDI, 2
1470 |     inc  EDI
1471 |     mov  curs, EDI ; like abort
1472 |     mov  ECX, words
1473 | @@:     dec  EDI
1474 |         mov  [EDI*4], EAX
1475 |         DROP ; requires cld
1476 |         next @b
1477 |     ret
1478 | 
1479 | insert: call insert0
1480 |     mov  CL, action
1481 |     xor  [EDI*4], CL
1482 |     jmp  ACCEPT
1483 | 
1484 | FORMAT: test action, 12o ; ignore 3 and 9
1485 |     jz   @f
1486 |         DROP
1487 |         ret
1488 | @@: mov  EDX, EAX
1489 |     and  EDX, 0FC000000h
1490 |     jz   @f
1491 |         cmp  EDX, 0FC000000h
1492 |         jnz  FORMAT2
1493 | @@: shl  EAX, 5
1494 |     xor  AL, 2 ; 6
1495 |     cmp  action, 4
1496 |     jz   @f
1497 |         xor  AL, 13o ; 8
1498 | @@: cmp  base, 10
1499 |     jz   @f
1500 |         xor  AL, 20o
1501 | @@: mov  words, 1
1502 |     jmp  insert
1503 | 
1504 | FORMAT2: DUP_
1505 |     mov  EAX, 1 ; 5
1506 |     cmp  action, 4
1507 |     jz   @f
1508 |         mov  AL, 3 ; 2
1509 | @@: cmp  base, 10
1510 |     jz   @f
1511 |         xor  AL, 20o
1512 | @@: xchg EAX, [ESI]
1513 |     mov  words, 2
1514 |     jmp  insert
1515 | 
1516 | DEL: call enstack
1517 |     mov  EDI, pcad
1518 |     mov  ECX, lcad
1519 |     sub  ECX, EDI
1520 |     shl  EDI, 2
1521 |     push ESI
1522 |      mov  ESI, cad
1523 |      shl  ESI, 2
1524 |      rep movsd
1525 |     pop  ESI
1526 |     jmp  mcur
1527 | 
1528 | enstack: DUP_
1529 |     mov  EAX, cad
1530 |     sub  EAX, pcad
1531 |     jz   ens
1532 |       mov  ECX, EAX
1533 |       xchg EAX, EDX
1534 |       push ESI
1535 |        mov  ESI, cad
1536 |        lea  ESI, [ESI*4-4]
1537 |        mov  EDI, trash
1538 | @@:      std
1539 |          lodsd
1540 |          cld
1541 |          stosd
1542 |          next @b
1543 |        xchg EAX, EDX
1544 |        stosd
1545 |        mov  trash, EDI
1546 |     pop  ESI
1547 | ens: DROP
1548 |     ret
1549 | 
1550 | pad: pop  EDX
1551 |     mov  vector, EDX
1552 |     add  EDX, 28*5
1553 |     mov  board, EDX
1554 |     sub  EDX, 4*4
1555 |     mov  shift, EDX
1556 | @@:     call KEY
1557 |         mov  EDX, vector
1558 |         add  EDX, EAX
1559 |         lea  EDX, [5+EAX*4+EDX]
1560 |         add  EDX, [-4+EDX]
1561 |         DROP
1562 |         call EDX
1563 |         jmp  @b
1564 | 
1565 | org (1200h-1)*4
1566 |     dd 0
1567 | end start
1568 | 


--------------------------------------------------------------------------------