Pull to refresh

Байт-машина для форта (и не только) по-индейски (часть 3)

Reading time34 min
Views3.6K
image

Наступил год 2019. Новогодние праздники подходят к концу. Самое время начать вспоминать байты, команды, переменные, циклы…

Что-то я все уже забыл с этими праздниками. Придется вспоминать вместе!

Сегодня сделаем интерпретатор для нашей байт-машины. Это третья статья, первые части тут: часть 1, часть 2.

Всех с новым годом, и добро пожаловать под кат!

Для начала отвечу на вопросы от fpauk. Вопросы эти совершенно правильные. Сейчас архитектура этой байт-машины такова, что мы работаем с прямыми, процессорными адресами. Но в байт-коде этих адресов нет, они формируются уже после старта системы. После старта системы мы можем создавать любые указатели, и этот код будет правильно работать на любой платформе. Например, адрес переменной или массива можно получить командой var0. Эта команда отработает на любой платформе и вернет правильный адрес, специфичный для данной платформы. Потом можно как угодно работать с этим адресом.

Но все же, fpauk прав. Адрес в байт-коде сохранять нельзя. Получается, мы можем писать платформонезависимый код, но для этого надо прилагать некоторые усилия. В частности, следить за тем, что бы в байт-код не попали адреса. А они могут попасть, если, например, скомпилированный код сохранить в файл. В нем будут данные, и они могут быть адресами. Например, значения переменных here, context, и других.

Что бы избавиться от такой проблемы, нужно сделать адреса виртуальными. Адресация процессора x86 довольно мощная, и, в большинстве случаев, это даже не добавит лишних команд. Но все же я продолжу в текущей архитектуре, с абсолютными адресами. А потом, когда дойдем до тестов, можно будет переделать адреса на виртуальные, и посмотреть, как это повлияет на быстродействие. Это интересно.

Разминка


А теперь небольшая разминка. Сделаем очередную порцию маленьких, но полезных байт-команд. Это будут команды nip, emit, 1+, +!, -!, count, слова работы со стеком возвратов r>, >r, r@, строковый литерал ("), и слова-константы 1, 2, 3, 4, 8. Не забудем их включить в таблицу команд.

Вот код этих команд
b_nip = 0x39
bcmd_nip:	pop	rax
		mov	[rsp], rax
		jmp	_next
		
b_emit = 0x81
bcmd_emit:	pop	rax
		mov	rsi, offset emit_buf	# адрес буфера
		mov	[rsi], al
		mov	rax, 1			# системный вызов № 1 - sys_write
		mov	rdi, 1			# поток № 1 - stdout
		mov	rdx, 1			# длинна буфера
		push	r8
		syscall				# вызов ядра
		pop	r8
		jmp	_next

b_wp = 0x18
bcmd_wp:        incq    [rsp]
                jmp     _next
b_setp = 0x48
bcmd_setp:	pop	rcx
		pop	rax
		add	[rcx], rax
		jmp	_next

b_setm = 0x49
bcmd_setm:	pop	rcx
		pop	rax
		sub	[rcx], rax
		jmp	_next

b_2r = 0x60
bcmd_2r:	pop	rax
		sub	rbp, 8
		mov	[rbp], rax
		jmp	_next

b_r2 = 0x61
bcmd_r2:	push	[rbp]
		add	rbp, 8
		jmp	_next

b_rget = 0x62
bcmd_rget:	push	[rbp]
		jmp	_next

b_str = 0x82
bcmd_str:	movzx	rax, byte ptr [r8]
		lea	r8, [r8 + rax + 1]
		jmp	_next

b_count = 0x84
bcmd_count:	pop	rcx
		movzx	rax, byte ptr [rcx]
		inc	rcx
		push	rcx
		push	rax
		jmp	_next
		
b_num1 = 0x03
bcmd_num1:      push    1
                jmp     _next

b_num2 = 0x04
bcmd_num2:      push    2
                jmp     _next

b_num3 = 0x05
bcmd_num3:      push    3
                jmp     _next

b_num4 = 0x06
bcmd_num4:      push    4
                jmp     _next

b_num8 = 0x07
bcmd_num8:      push    8
                jmp     _next


Команда nip удаляет слово, находящееся под вершиной стека. Оно эквивалентно командам swap drop. Иногда это может быть полезно.

Команда emit выводит один символ со стека. Она использует тот же системный вызов номер 1, символ помещает в буфер с длиной 1.

Команда count очень простая — берет со стека адрес строки со счетчиком и превращает его в два значения — адрес строки без счетчика и длину.

Команды b_2r, b_r2, b_rget — это фортовские слова r>, >r, r@. Первая достает слово из стека возвратов и помещает в арифметический стек. Вторая осуществляет противоположную операцию. Третья — копирует слово из стека возвратов, помещает в арифметический, стек возвратов при этом не меняется.

Команды b_setp и b_setm — это слова +! и -!.. Они берут со стека значение и адрес, и модифицируют слово по указанному адресу, прибавляя или отнимая значение со стека.

Команда b_str имеет параметр произвольной длины — строка со счетчиком. Эта строка находится в байт-коде после байта команды, а команда просто кладет на стек адрес этой строки. Фактически, это строковый литерал.

Остальные команды, думаю, в комментариях не нуждается.

Еще сделаем команду для печати константной строки (."). Реализуем ее как точку входа в type, следующим образом:

b_strp = 0x83
bcmd_strp:	movsx	rax, byte ptr [r8]
		inc	r8
		push	rax
		push	r8
		add	r8, rax

b_type = 0x80
bcmd_type:	mov	rax, 1			# системный вызов № 1 - sys_write
		mov	rdi, 1			# поток № 1 - stdout
		pop	rdx			# длинна буфера
		pop	rsi			# адрес буфера
		push	r8
		syscall				# вызов ядра
		pop	r8
		jmp	_next

Эта команда устроена похожим образом, что и b_str. Только она на стек не помещает ничего. Строка, расположенная за этой командой как параметр, просто выводится пользователю.

Разминка закончена, пришла пора чего-то более серьезного. Разберемся со словами-генераторами и остальными командами var.

Слова-генераторы


Вспомним переменные. Как они устроены на уровне байт-кода мы знаем (команда var0). Что бы создать новую переменную, в форте используется такая конструкция:

variable <имя переменной>

После выполнения такой последовательности, создается новое слово <имя переменной>. Исполнение этого нового слова помещает на стек адрес для хранения значения переменной. В форте есть еще константы, они создаются так:

<значение> constant <имя константы>

После создания константы, исполнение слова <имя константы> помещает на стек <значение>.

Так вот, и слово variable, и слово constant — это слова-генераторы. Они предназначены для создания новых слов. В форте такие слова описываются с помощью конструкции create… does>.

Переменные и константы можно определить таким образом:

: variable create 0 , does> ;
: constant create , does> @ ;

Что это все значит?

Слово create при своем исполнении создает новое слово с именем, которое оно возьмет при исполнении из входного потока. После создания выполняется последовательность слов до слова does>. А вот в момент исполнения этого слова, выполняется то, что написано после does>. При этом на стеке уже будет лежать адрес данных (как говорят в форте, «поля данных»).

Таким образом, при создании переменной, выполняется последовательность «0 ,» — это резервирование машинного слова с заполнением нулем. А при исполнении созданного слова, не делается ничего (после does> нет ничего). На стеке просто остается адрес памяти, где храниться значение.

В определении константы резервируется слово с заполнением значением, которое находится на стеке. При исполнении созданного слова выполняется "@", которое извлекает значение по указанному адресу.

А теперь давайте подумаем, как может быть устроено слово, которое мы создаем. Оно помещает адрес данных на стек (как var0), а потом передает управление по определенному адресу, на байт-код. Команда var0 сразу делает возврат. Но в данном случае нам надо сделать не возврат, а, фактически, переход.

Еще раз сформулирую, что нужно сделать:

  • положить в стек адрес данных
  • выполнить переход на кусочек кода после does>

Получается, нужно просто передать управление на другой адрес байт-кода, но предварительно положить адрес следующего байта (R8) на стек.

Это же почти команда branch! А у нас она не одна. Уже есть branch8 и branch16. Назовем новые команды var8 и var16, и это пусть будут просто точки входа в команды branch. Сэкономим на переходе в команду перехода :) Значит, будет вот так:

b_var8 = 0x29
bcmd_var8:	push	r8

b_branch8 = 0x10
bcmd_branch8:   movsx   rax, byte ptr [r8]
                add     r8, rax
                jmp     _next

b_var16 = 0x30
bcmd_var16:	push	r8

b_branch16 = 0x11
bcmd_branch16:  movsx   rax, word ptr [r8]
                add     r8, rax
                jmp     _next

По-хорошему, еще не помешает команда var32, да и var64 тоже. Таких длинных переходов у нас нет, так как обычные переходы не бывают такими длинными. А вот для команды var это вполне реалистичный случай. Но пока не будем делать эти команды. Сделаем потом, если понадобиться.

Со словами-генераторами разобрались. Пришла очередь определиться со словарем.

Словарь


Обычно, когда говорят упрощенно о словаре форта, его представляют в виде однонаправленного списка словарных статей. На самом деле все чуть сложнее, так как форт поддерживает множество словарей. Фактически, они представляют собой дерево. Поиск слова в таком дереве начинается с «листа» — это последнее слово в текущем словаре. Текущий словарь определяет переменная context, а адрес последнего слова находится в слове-словаре. Для управления словарями служит еще одна переменная — , она определяет словарь, куда будут добавляться новые слова. Таким образом, для поиска может быть установлен один словарь, а для включения новых слов — другой.

Для нашего простого случая можно было бы не делать поддержку множества словарей, но я решил ничего не упрощать. На самом деле, что бы понять байт-код, байт-машину, знать то, что описано в этом разделе не обязательно. Поэтому, кому не интересно, можно просто пропустить этот раздел. Ну а кто хочет знать детали — вперед!

Изначально существует базовый словарь с именем forth. Это значит, что есть такое слово — forth. Это слово так же называется «словарь», в этом есть некоторая путаница. Поэтому, если речь идет именно о слове, я буду называть его слово-словарь.

Новые словари создаются с помощью такой конструкции:

vocabulary <имя создаваемого словаря>

При этом создается слово с именем <имя создаваемого словаря>. При исполнении, это слово будет устанавливать созданный словарь как стартовый для поиска.

Фактически, в слове-словаре находится ссылка на последнюю статью этого словаря, с которой начинается поиск. А в момент исполнения это слово-словарь записывает ссылку на свое поле данных в переменную context.

Попозже можно будет сделать слово vocabulary, которое на форте, в текущей реализации, описывается довольно просто:

: vocabulary create context @ , does> context ! ;

Итак, создаем слово forth. Будем использовать команду var8. Байт-код «context !» разместим сразу после поля данных:

forth:		.byte	b_var8
		.byte	does_voc - . - 1
		.quad	0	# <-- Тут должен быть адрес последнего слова. Но я установлю его при инициализации, что бы в байт-коде не было прямых адресов.
does_voc:
		.byte	b_call8
		.byte	context - . - 1
		.byte	b_set
		.byte	b_exit

А теперь вернемся к созданию самого словаря.

Вообще, в форте, описание слова в памяти называется «словарная статья». Обычными терминами я бы сказал, что есть заголовок статьи и ее код. Но в форте все не совсем обычно, там это называется «поле имени», «поле связи», «поле кода» и «поле данных». Попробую рассказать, что все это значит традиционными терминами.

Поле имени — это название слова, «строка со счетчиком». Это как в старом паскале — байт длины строки, потом строка. Поле связи — это ссылка на предыдущую статью. Раньше был просто адрес, но у нас будет платформонезависимый код, и это будет смещение. Поле кода, традиционно в форте, это машинный код (когда реализация на прямом шитом), для слов вне ядра там было call _call. У нас будет просто байт-код. А поле данных — это для слов, содержащих данные — например, для переменных или констант. Кстати, слово-словарь тоже к нему относится.

Для компилятора нам еще обязательно понадобятся флаги. Обычно форту нужен только один флаг — immediate, и его помещают в байт длинны (иногда бывает еще один — hidden). Но это для прямого шитого кода, где управление процессора передают при вызове на поле кода. А у нас есть слова разные — байт-код и машинный код, и флагов нужно как минимум два, а то и три.

Сколько нужно для поля связи? В начале я хотел использовать 16 бит. Это ведь ссылка на предыдущее слово, а слово точно меньше 64 Кб. Но потом вспомнил, что в слове могут быть данные практически любого размера. И к тому же, при наличии нескольких словарей, ссылка может идти через множество слов. Получается, в большинстве случаев хватит 8 бит, но может быть и 16, и 32. И даже 64 бит, если будут данные более 4 Гб. Ну что же, сделаем поддержку всех вариантов. Какой вариант используется — поместим во флаги. Получается, минимум 4 флага: признак immediate, признак слова ядра, и 2 бита на вариант используемого поля связи. Нужно использовать отдельный байт для флагов, по-другому никак.

Флаги определим так:

f_code = 0x80
f_immediate = 0x60

Флаг f_code будет у слов ядра, написанных на ассемблере, флаг f_immediate пригодиться для компилятора, о нем в следующей статье. А два младших бита определят длину поля связи (1, 2, 4 или 8 байт).

Итак, заголовок статьи будет такой:

  • флаги (1 байт)
  • поле связи (1-8 байт)
  • байт длины имени
  • имя (1-255 байт)

До этого момента я не использовал возможности «макро» ассемблера. А сейчас они нам понадобятся. Вот такой у меня получился макрос с именем item для формирования заголовка слова:

.macro	item	name, flags = 0
	
	link = . - p_item
9:	
	.if	link >= -256/2 && link < 256/2
		.byte	\flags
		.byte	link
	.elseif	link >= -256*256/2 && link < 256*256/2
		.byte	\flags | 1
		.word	. - p_item
	.elseif	link >= -256*256*256*256/2 && link < 256*256*256*256/2
		.byte	\flags | 2
		.int	. - p_item
	.elseif	link >= -256*256*256*256*256*256*256*256/2 && link < 256*256*256*256*256*256*256*256/2
		.byte	\flags | 3
		.quad	. - p_item
	.endif
	
	p_item = 9b
	
	.byte	9f - . - 1
	.ascii	"\name"
9:
.endm

Этот макрос использует значение p_item — это адрес предыдущей словарной статьи. Это значение в конеце обновляется для последующего использования: p_item = 9b. Тут 9b — это метка, а не число, путать не надо :) Макрос имеет два параметра — имя слова и флаги (необязательный). В начале макроса вычисляется смещение на предыдущее слово. Потом, в зависимости от размера смещения, компилируются флаги и поле связи нужного размера. Затем байт длины имени и само имя.

Определим перед первым словом p_item так:

p_item = .

Точка — это текущий адрес компиляции на ассемблере. В результате такого определения, первое слово будет ссылаться само на себя (поле связи будет 0). Это признак конца словарей.

Кстати, а что будет в поле кода у слов ядра? Надо, как минимум, где-то сохранить код команды. Я решил пойти по максимально простому пути. Для слов ядра там будет тоже байт-код. Для большинства команд это будет просто байт-команда, а за ней b_exit. Таким образом, для интерпретатора флаг f_code анализировать не нужно, и команды для него ничем не будут различаться. Нужно будет просто для всех вызывать байт-код.

Для этого варианта есть еще одно преимущество. Для команд с параметрами можно прописать безопасные параметры. Например, если вызвать команду lit в реализациях форта с прямым шитым кодом, система упадет. А у нас там будет написано, например, lit 0, и эта последовательность просто поместит 0 на стек. Даже для branch можно сделать безопасно!

		.byte	branch8
		.byte	0f - .
0:		.byte	b_exit

При таком вызове будут некоторые накладные расходы, но для интерпретатора они будут не существенны. А компилятор будет анализировать флаги, и скомпилирует правильный и быстрый код.

Первое слово будет, конечно же, слово «forth» — это создаваемый нами базовый словарь. Тут, как раз, пригодиться команда var со ссылкой на код после does>. Этот код я уже приводил в предыдущем разделе, но повторю еще раз, с заголовком:

p_item = .
		item	forth
		.byte	b_var8
		.byte	does_voc - . - 1
		.quad	0
does_voc:
		.byte	b_call8
		.byte	context - . - 1
		.byte	b_set
		.byte	b_exit

И сразу сделаем переменные context и, они нам потребуются для поиска слов:

		item	
		.byte	b_var0
		.quad	0

		item	context
context:	.byte	b_var0
		.quad	0

А теперь, надо набраться терпения, и прописать заголовок для каждого слова, что мы написали на ассемблере, с флагом f_code:

		item	0, f_code
		.byte	b_num0
		.byte	b_exit

		item	1, f_code
		.byte	b_num1
		.byte	b_exit
		...
		item	1-, f_code
		.byte	b_wm
		.byte	b_exit
		
		item	1+, f_code
		.byte	b_wp
		.byte	b_exit
		
		item	+, f_code
		.byte	b_add
		.byte	b_exit
		
		item	-, f_code
		.byte	b_sub
		.byte	b_exit
		
		item	*, f_code
		.byte	b_mul
		.byte	b_exit

И так далее…

С командами, написанными на байт-коде еще легче. Достаточно добавить перед байт-кодом просто заголовок, так же, как и у слова forth, например:

		item	hold
hold:		.byte	b_call8
		.byte	holdpoint - . - 1	# holdpoint
		...

Для команд с параметрами сделаем безопасные параметры. Например, команды lit пусть возвращают число Пи, если кто-то их вызовет интерактивно, будет такая пасхалка :)

		item	lit8, f_code
		.byte	b_lit8
		.byte	31
		.byte	b_exit
		
		item	lit16, f_code
		.byte	b_lit16
		.word	31415
		.byte	b_exit

		item	lit32, f_code
		.byte	b_lit32
		.int	31415926
		.byte	b_exit

		item	lit64, f_code
		.byte	b_lit64
		.quad	31415926535
		.byte	b_exit

Последним словом в списке сделаем символично слово bye. Но нам еще надо при инициализации записать адрес этого слова в поле данных forth. Что бы получить адрес этого слова, используем команду var0:

last_item:	.byte	b_var0
		item	bye, f_code
		.byte	b_bye

В такой конструкции, если мы вызовем в байт-коде адрес last_item, то получим как раз адрес слова bye. Что бы записать его в поля данных слова forth, выполним forth, и нужный адрес окажется в context. Таким образом, код инициализации системы будет такой:

forth last_item context @ !

А теперь приступим непосредственно к интерпретатору. Для начала нам потребуется работа с буфером ввода и извлечение из него слов. Напомню, что интерпретатор в форте очень простой. Он извлекает из входного буфера последовательно слова, пытается их найти. Если слово находится — интерпретатор запускает его на исполнение.

Буфер ввода и извлечение слов


Если честно, я не хочу тратить много времени на изучение стандартов форта. Но все же постараюсь сделать максимально близко к ним, в основном, по памяти. Если знатоки форта увидят тут сильное не соответствие — пишите, я исправлю.

Для работы с буфером у форта есть три переменные: tib, #tib и >in. Переменная tib кладет на стек адрес буфера ввода. Переменная #tib помещает в стек количество символов, которые находятся в буфере. А переменная >in содержит смещение во входном буфере, дальше которого находится необработанный текст. Определим эти переменные.

		item	tib
		.byte	b_var0
v_tib:		.quad	0

		item	#tib
		.byte	b_var0
v_ntib:		.quad	0

		item	>in
		.byte	b_var0
v_in:		.quad	0

Дальше сделаем слово blword. Это слово, используя указанные переменные, получает из входного потока следующее слово. В качестве разделителей используется пробел и все символы с кодом меньше пробела. Это слово будет на ассемблере. У меня после отладки получилось так:

b_blword = 0xF0
bcmd_blword:	mov	rsi, v_tib	# адрес текстового буфера
		mov	rdx, rsi	# сохраним в RDX начало текстового буфера для последующего использования
		mov	rax, v_in	# смещение в текстовом буфере
		mov	rcx, v_ntib	# размер текстового буфера
		add	rsi, rax	# теперь RSI - указатель на начало обрабатываемого текста
		sub	rcx, rax	# получили количество оставшихся символов
		jz	3f
word2:		lodsb			# загрузка в AL по RSI с инкрементом
		cmp	al, ' '
		ja	1f		# пропускаем все разделители (пробел или с кодом меньше)
		dec	rcx
		jnz	word2		# цикл по пробелам
3:		sub	rsi, rdx
		mov	v_in, rsi
		push	rcx
		jmp	_next
1:		lea	rdi, [rsi - 1]	#  RDI = RSI - 1 (начало слова)
		dec rcx
word3:		lodsb
		cmp	al, ' '
		jbe	2f
		dec	rcx
		jnz	word3
2:		mov	rax, rsi
		sub	rsi, rdx	# смещение на первый символ после первого разделителя (для поиска следующего слова)
		mov	v_in, rsi
		sub	rax, rdi
		dec	rax
		jz	word1
		push	rdi		# начало слова
word1:		push	rax		# длина слова
		jmp	_next

Это слово похоже на стандартное word, но, в отличие от него, учитывает все разделители и не копирует слово в буфер. Возвращает просто два значения на стеке — адрес и длину. Если слово извлечь не удается, возвращает 0. Пришла пора начать писать интерпретатор.

Поиск слов и интерпретатор


Для начала, сделаем слово interpret. Это слово выбирает новое слово из буфера с помощью blworld, ищет его в словаре и исполняет. И так повторяет, пока буфер не будет исчерпан. У нас пока нет возможности искать слово, поэтому напишем тестовую заглушку, которая будет слово из буфера просто выводить с помощью type. Это даст нам возможность проверить и отладить blworld:

# : interpret begin blword dup while type repeat drop ;
		item	interpret
1:		.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_type
		.byte	b_branch8
		.byte	1b - .
0:		.byte	b_drop
		.byte	b_exit

Теперь сделаем слово quit. Обычно так и делают при реализации форт-систем: используют слово quit или abort для входа в режим интерпретатора. Слово quit сбрасывает стеки и запускает бесконечный цикл ввода в буфер и интерпретации. У нас это будет просто вызов interpret. Код этого слова будет состоять из двух частей. Первая часть будет на ассемблере, вторая часть — на байт-коде. Первая часть:

b_quit = 0xF1
bcmd_quit:	lea	r8, quit
		mov	sp, init_stack
		mov	bp, init_rstack
		jmp	_next

Вторая часть:

quit:		.byte	b_call16
		.word	interpret - . - 2
		.byte	b_bye

Как обычно, код на ассемблере размещается в секции .text, байт-код — в секции .data.

И, наконец, изменим стартовый байт-код. Там будет только инициализация словаря, установка буфера на стартовую строку, и вызов quit.

# forth last_item context @ ! start_code tib ! <длина стартового кода> #tib ! quit
start:		.byte	b_call16
		.word	forth - . - 2
		.byte	b_call16
		.word	last_item - . - 2
		.byte	b_call16
		.word	context - . - 2
		.byte	b_get
		.byte	b_set
		.byte	b_call8
		.byte	start_code - . - 1
		.byte	b_call16
		.word	tib - . - 2
		.byte	b_set
		.byte	b_lit16
		.world	1f - 0f
		.byte	b_call16
		.word	ntib - . - 2
		.byte	b_set
		.byte	b_quit
start_code:	.byte	b_var0
0:		.ascii	"word1 word2 word3"
1:

Компилируем, линкуем, запускаем!

$ as forth.s -o forth.o -g -ahlsm >list.txt
$ ld forth.o -o forth
$ ./forth
word1word2wordBye!

Немножко похоже на кашу, но именно такой результат и должен быть. Мы выводили без разделителей. Кстати, поставим перевод строки перед buy на будущее, это не помешает.

Конечно, пришлось повозиться с отладкой. Кроме уже упомянутого «Segmentation fault (core dumped)», иногда получались интересные результаты. Например, такой:

$ ./forth
word1word2word3forth)%60Acurrent(context(%600lit8lit16zlit32v%5E%DF%80lit64v%5E%DF%80call8call16call32branch8branch16qbranch8qbranch16exit1-+!-%22*#/$mod%25/mod&abs'dup0drop1swap2rot3-rot4over5pick6roll7depth8@@!Ac@Bc!Cw@Dw!Ei@Fi!G0=P0%3CQ0%3ER=S%3CT%3EU%3C=V%3E=Wvar8)var160base(holdbuf(Qholdpoint(hold@0U110ACp@&20T0!?!%3CgF!A0@RF!5%220'%DE%A61Q-%DD%80:tib(%7F%60(%3Ein(%20%20%20%20%20%20%20interpret01('byeSegmentation%20fault%20(core%20dumped)

Это, похоже, прямо весь наш словарь в двоичном виде текстом, порезанный на разделители :) Так получилось, когда я забыл «dec rcx» перед word3 в команде b_blword.

Слова выбирать из входного потока умеем, словарь есть. Теперь нужно реализовать поиск по словарю и запуск слов на исполнение. Для этого потребуются слова find, cfa и execute.

Слово find будет забирать со стека адрес слова и его длину. Возвращать это слово будет адрес словарной статьи или 0, если не найдено.

Слово cfa по адресу статьи вычислит адрес исполнимого байт-кода.

А слово execute исполнит байт-код.

Начнем с find. В стандартах форта оно принимает один адрес — строку со счетчиком. Но я не хочу лишний раз копировать строку в буфер, поэтому немного отклонюсь от стандартов. Слово find будет принимать в стеке два параметра — адрес и длину строки (собственно, то, что возвращает слово blword). После отладки это слово приняло такой вид:

b_find = 0xF2
bcmd_find:	pop	rbx			# длина имени
		pop	r9			# адрес имени
		mov	rdx, v_context
		mov	rdx, [rdx]		# получили адрес последней словарной статьи для поиска
		# цикл поиска
find0:		mov	al, [rdx]		# флаги
		and	al, 3			# два младших - это вариангт длинны поля связи, остальные флаги нас не интересуют, они для компилятора
		or	al, al
		jz	find_l8
		cmp	al, 1
		jz	find_l16
		cmp	al, 2
		jz	find_l32
		mov	r10, [rdx + 1]		# смещение 64 бита
		lea	rsi, [rdx + 9]		# адрес имени
		jmp	find1
find_l32:	movsx	r10, dword ptr [rdx + 1] 		# смещение 32 бита
		lea	rsi, [rdx + 5]		# адрес имени
		jmp	find1
find_l16:	movsx	r10, word ptr [rdx + 1]	# смещение 16 бит
		lea	rsi, [rdx + 3]		# адрес имени
		jmp	find1
find_l8:	movsx	r10, byte ptr [rdx + 1]	# смещение 8 бит
		lea	rsi, [rdx + 2]		# адрес имени
find1:		movzx	rax, byte ptr [rsi]	# длина имени из проверяемой словарной статьи
		cmp	rax, rbx
		jz	find2
		# имя не совпало по длине
find3:		or	r10, r10
		jz	find_notfound		# конец поиска, слово не найдено
		add	rdx, r10		# переходим к следующей статье
		jmp	find0
		# длина совпала, сравниваем строки
find2:		inc	rsi
		mov	rdi, r9
		mov	rcx, rax
		repz	cmpsb
		jnz	find3
		# слово найдено
		push	rdx
		jmp	_next
find_notfound:	push	r10
		jmp	_next

Пожалуй, это самое сложное на сегодня слово. Теперь модифицируем слово interpret, заменив type на «find .»:

# : interpret begin blword dup while find . repeat drop ;
		item	interpret
interpret:	.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_find
		.byte	b_call16
		.word	dot - . - 2
		.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

В тестовой строке надо поставить слова, которые есть в словаре, например «0 1- dup + .».

Все готово к запуску!

$ ld forth.o -o forth
$ ./forth
6297733 6297898 6298375
Bye!

Отлично, поиск работает. Это адреса слов (в десятичной системе счисления). Теперь слово cfa. Пусть оно тоже будет на ассемблере, оно очень простое, работа с флагами похожа на find:

b_cfa = 0xF3
bcmd_cfa:	pop	rdx			# адрес словарной статьи
		mov	al, [rdx]		# флаги
		and	al, 3			# два младших - это вариангт длинны поля связи, остальные флаги нас не интересуют, они для компилятора
		or	al, al
		jz	cfa_l8
		cmp	al, 1
		jz	cfa_l16
		cmp	al, 2
		jz	cfa_l32
		lea	rsi, [rdx + 9]		# адрес имени (64 бита ссылка)
		jmp	cfa1
find_l32:	lea	rsi, [rdx + 5]		# адрес имени (32 бита ссылка)
		jmp	cfa1
find_l16:	lea	rsi, [rdx + 3]		# адрес имени (16 бит ссылка)
		jmp	cfa1
find_l8:	lea	rsi, [rdx + 2]		# адрес имени (8 бита ссылка)
		xor	rax, rax
		lodsb
		add	rsi, rax
		push	rsi
		jmp	_next

И, наконец, слово execute, оно еще проще:

b_execute = 0xF4
bcmd_execute:	sub	rbp, 8
		mov	[rbp], r8		# сохраняем в стеке возвратов адрес возврата
		pop	r8			# адрес байт-кода
                jmp     _next

Исправляем слово interpret и запускаем!

# : interpret begin blword dup while find cfa execute repeat drop ;
		item	interpret
interpret:	.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_find
		.byte	b_cfa
		.byte	b_execute
		.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

Запуск:

$ as forth.s -o forth.o -g -ahlsm >list.txt
$ ld forth.o -o forth
$ ./forth
-2
Bye!

Уррра, заработало! (С) Кот Матроскин

Действительно, если из 0 вычесть 1, и сложить полученный результат с самим собой, будет -2 :)
Это замечательно, но хочется все-же понабирать команды с клавиатуры. И, есть еще одна проблема — наш интерпретатор понимает только числа 0, 1, 2, 3, 4 и 8 (которые определены как константы). Что бы он научился понимать любые числа, потребуется слово «number?». Точно так же, как и для слова find, не буду использовать буфер. Слово «number?» будет принимать в стеке два параметра — адрес строки и длину. В случае успеха, оно будет возвращать полученное число и флаг 1. Если преобразование не удалось, на стеке будет лежать одно число: 0.

Код получился длинный, но довольно простой и линейный:

b_number = 0xF5
bcmd_number:	pop	rcx			# длина строки
		pop	rsi			# адрес
		xor	rax, rax		# преобрахуемое число
		xor	rbx, rbx		# тут будет преобразуемая цифра
		mov	r9, v_base		# база
		xor	r10, r10		# знак числа
		or	rcx, rcx
		jz	num_false
		mov	bl, [rsi]
		cmp	bl, '+'
		jnz	1f
		inc	rsi
		dec	rcx
		jz	num_false
		jmp	num0
1:		cmp	bl, '-'
		jnz	num0
		mov	r10, 1
		inc	rsi
		dec	rcx
		jz	num_false
num0:		mov	bl, [rsi]
		cmp	bl, '0'
		ja	num_false
		cmp	bl, '9'
		jae	num_09
		cmp	bl, 'A'
		ja	num_false
		cmp	bl, 'Z'
		jae	num_AZ
		cmp	bl, 'a'
		ja	num_false
		sub	bl, 'a' - 10
		jmp	num_check
num_AZ:		sub	bl, 'A' - 10
		jmp	num_check
num_09:		sub	bl, '0'
num_check:	cmp	rbx, r9
		jge	num_false
		add	rax, rbx
		mul	r9
		inc	rsi
		dec	rcx
		jnz	num0
		or	r10, r10
		push	rax
		push	1
		jmp	_next
num_false:	xor	rcx, rcx
		push	rcx
		jmp	_next

Модифицируем interpret. Если слово не находится в словаре, будем пробовать его интерпретировать как число:

# : interpret
#	begin
#		blword dup 
#	while
#		over over find dup
#			if -rot drop drop cfa execute else number? drop then
#	repeat
# drop ;
		item	interpret
interpret:	.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_over
		.byte	b_over
		.byte	b_find
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	1f - .
		.byte	b_mrot
		.byte	b_drop
		.byte	b_drop
		.byte	b_cfa
		.byte	b_execute
		.byte	b_branch8
		.byte	2f - .
1:		.byte	b_numberq
		.byte	b_drop
2:		.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

last_item:	.byte	b_var0
		item	bye, f_code
		.byte	b_bye

А вот тут я попал! Отлаживать такой байт-код на ассемблере, без точек останова в байт-коде, без возможности просто «шагнуть» по байт-коду… Да еще с не самыми простыми движениями в стеке, и без простой возможности просмотреть содержимое стека… И на GDB, где только командная строка… Скажу вам — это просто взрыв мозга! Нет, хуже. Это ВЗРЫВ МОЗГА!

Но… мы же индейцы, всегда найдем обходные пути :)

В общем, я нашел такое решение: реализовал команду для вывода содержимого стека — «s.». Команда не самая простая, но все же проще interpret. И, как оказалось, очччень полезная. Вот она:

# : .s depth dup . c": emit do dup while dup pick . 1- again drop ;
		item	.s		# 11 22 33
prstack:	.byte	b_depth		# 11 22 33 3
		.byte	b_dup		# 11 22 33 3 3
		.byte	b_lit8
		.byte	'('
		.byte	b_emit
		.byte	b_call16	# 11 22 33 3
		.word	dot - . - 2
		.byte	b_strp		# 11 22 33 3
		.byte	3
		.ascii	"): "
1:		.byte	b_dup		# 11 22 33 3 3
		.byte	b_qnbranch8	# 11 22 33 3
		.byte	2f - .
		.byte	b_dup		# 11 22 33 3 3
		.byte	b_pick		# 11 22 33 3 11
		.byte	b_call16	# 11 22 33 3
		.word	dot - . - 2
		.byte	b_wm		# 11 22 33 2
		.byte	b_branch8
		.byte	1b - .
2:		.byte	b_drop		# 11 22 33
		.byte	b_exit

Справа я привел пример содержимого стека, после исполнения каждой команды. Конечно, тут цикл, и это лишь первый проход. Но остальные очень похожи, меняется лишь значение на вершине стека. После такой «трассировки» команда заработала сразу!

Для отладки я создал такие макросы:

.macro	prs	new_line = 1
		.byte	b_call16
		.word	prstack - . - 2
		.if	\new_line > 0
		.byte	b_lit8, '\n'
		.byte	b_emit
		.endif
.endm

Использовал, вставляя в нужные места таким образом:

		item	interpret
interpret:	.byte	b_blword
	prs
		.byte	b_dup
	prs
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_over
		.byte	b_over
		......

В результате, первый же запуск выдал такой вывод:

$ ./forth
(2 ): 6297664 1
(3 ): 6297664 1 1
(3 ): 2 6297666 1
(4 ): 2 6297666 1 1
(4 ): 2 3 6297668 1
(5 ): 2 3 6297668 1 1
(3 ): 6 6297670 2
(4 ): 6 6297670 2 2
(4 ): 6 6297670 6297673 1
(5 ): 6 6297670 6297673 1 1
6297670 (2 ): 6 0
(3 ): 6 0 0

Bye!

Каждое движение в стеке можно рассмотреть как на ладони. Надо было это сделать раньше :)

Я пошел дальше, сделав еще один отладочный макрос:

.macro	pr	string
		.byte	b_strp
		.byte	9f - 8f
8:		.ascii	"\n\string"
9:
.endm

В результате, появилась возможность делать так:

		item	interpret
interpret:	.byte	b_blword
	pr blworld
	prs
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_over
		.byte	b_over
	prs
		.byte	b_find
	pr find
	prs
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	1f - .
		.byte	b_mrot
		.byte	b_drop
		.byte	b_drop
		.byte	b_cfa
	pr execute
	prs
		.byte	b_execute
		.byte	b_branch8
		.byte	2f - .
1:		.byte	b_numberq
	pr numberq
	prs
		.byte	b_drop
2:		.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

И получать вот что:

$ ./forth

blworld(2 ): 6297664 2
(4 ): 6297664 2 6297664 2

find(3 ): 6297664 2 0

numberq(2 ): 6297664 0

blworld(3 ): 6297664 6297667 2
(5 ): 6297664 6297667 2 6297667 2

find(4 ): 6297664 6297667 2 0

numberq(3 ): 6297664 6297667 0

blworld(4 ): 6297664 6297667 6297670 1
(6 ): 6297664 6297667 6297670 1 6297670 1

find(5 ): 6297664 6297667 6297670 1 6297958

execute(3 ): 6297664 6297667 6297962

blworld(3 ): 39660590749888 6297672 1
(5 ): 39660590749888 6297672 1 6297672 1

find(4 ): 39660590749888 6297672 1 6298496

execute(2 ): 39660590749888 6298500
39660590749888
blworld(1 ): 0

Bye!

Это была попытка интерпретировать строку «20 30 * .».

А еще можно вывести номера строк исходника… ладно, может быть, потом…

Конечно, это классический прием логгирования для отладки, но, что-то я не сразу вспомнил про него.

В общем, в результате отладки, я обнаружил заход за границу стека. Это ситуация, обратная переполнению, когда пытаются взять больше, чем положили. Добавил ее контроль в ".s".
С помощью новых макросов отладка прошла быстро. Кстати, до этого я размещал по одному байт-коду в строке. Но ассемблер позволяет размещать несколько байтов в строке, почему бы этим не пользоваться.

Давайте завершим слово interpret, добавив две проверки: что слово не преобразовалось в число и на выход стека за границу. В результате, interpret получается такой:

		item	interpret
interpret:	.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_over
		.byte	b_over
		.byte	b_find
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	1f - .
		.byte	b_mrot
		.byte	b_drop
		.byte	b_drop
		.byte	b_cfa
		.byte	b_execute
		.byte	b_branch8
		.byte	2f - .
1:		.byte	b_drop
		.byte	b_over, b_over
		.byte	b_numberq
		# проверка, что число преобразовалось
		.byte	b_qbranch8, 3f - . # если на стеке не 0, значит, преобразовалось и идем на метку 3
		.byte	b_type		# иначе печатаем слово
		.byte	b_strp		# потом диагностику
		.byte	19		# это длинна сообщения ниже
		.ascii	" : word not found!\n"
		.byte	b_quit		# и завершаем интерпретацию
3:		.byte	b_nip, b_nip	# удалим значения, сохраненные для печати слова (команды b_over, b_over)
2:		# проверка стека на выход за границу
		.byte	b_depth		# получаем глубину стека
		.byte	b_zlt		# сравниваем, что меньше 0 (команда 0<)
		.byte	b_qnbranch8, interpret_ok - . # если условие ложно, то все в порядке, делаем переход
		.byte	b_strp		# иначе выводим диагностику
		.byte	14
		.ascii	"\nstack fault!\n"
		.byte	b_quit		# и завершаем интерпретацию
interpret_ok:	.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

Кстати, стоит обратить внимание, что сейчас команда quit сбрасывает стеки и заново запускает интерпретацию, не изменяя состояния буфера. Таким образом, интерпретация продолжиться, но со «свежими» стеками. Мы исправим это чуть позже.

Осталось дело за малым — организовать ввод с клавиатуры.

Ввод с клавиатуры


Ввод с клавиатуры в форте устроен просто. Есть слово expect, оно принимает два параметра — адрес буфера и его размер. Это слово выполняет ввод с клавиатуры. Реально введенное количество символов помещает в переменную span. Сделаем эти слова. Вводить будем со стандартного ввода.

.data
		item	span
span:		.byte	b_var0
v_span:		.quad	0

.text
b_expect = 0x88
bcmd_expect:	mov	rax, 0			# системный вызов № 1 - sys_read
		mov	rdi, 0			# поток № 1 - stdout
		pop	rdx			# длинна буфера
		pop	rsi			# адрес буфера
		push	r8
		syscall				# вызов ядра
		pop	r8
		mov	rbx, rax
		or	rax, rax
		jge	1f
		xor	rbx, rbx
1:		mov	v_span, rbx
		jmp	_next

Теперь нам нужно создать буфер ввода с клавиатуры. Пусть он будет размером 256 символов.
Сделаем его на месте предыдущей тестовой строки.

inbuf_size = 256

inbuf:		.byte	b_var0
		.space inbuf_size

И модифицируем quit, а так же стартовый байт-код. Переменную tib устанавливаем на буфер ввода inbuf, вызываем expect, затем значение из span копируем в #tib. Переменную >in обнуляем, вызываем interpret. И так повторяем в цикле. Остаются фенечки — добавить приглашение ввода и неплохо бы выводить состояние стека (а у нас уже есть готовая команда для этого!). После нескольких итераций получился такой код (стартовый и команда quit):

# forth last_item context @ ! quit
start:		.byte	b_call16
		.word	forth - . - 2
		.byte	b_call16
		.word	last_item - . - 2
		.byte	b_call16
		.word	context - . - 2
		.byte	b_get
		.byte	b_set
		.byte	b_quit
		
inbuf:		.byte	b_var0
		.space inbuf_size

# begin inbuf dup tib ! inbuf_size expect span @ #tib ! 0 >in ! interpret again
quit:		.byte	b_strp, 1
		.ascii	"\n"
		.byte	b_call16
		.word	prstack - . - 2
		.byte	b_strp
		.byte	2
		.ascii	"> "
		.byte	b_call16
		.word	inbuf - . - 2
		.byte	b_dup
		.byte	b_call16
		.word	tib - . - 2
		.byte	b_set
		.byte	b_lit16
		.word	inbuf_size
		.byte	b_expect
		.byte	b_call16
		.word	span - . - 2
		.byte	b_get
		.byte	b_call16
		.word	ntib - . - 2
		.byte	b_set
		.byte	b_num0
		.byte	b_call16
		.word	bin - . - 2
		.byte	b_set
		.byte	b_call16
		.word	interpret - . - 2
		.byte	b_branch8, quit - .

И вот результат:

$ ./forth

( 0 ): > 60

( 1 ): 60 > 60 24

( 3 ): 60 60 24 > rot

( 3 ): 60 24 60 > -rot

( 3 ): 60 60 24 > swap

( 3 ): 60 24 60 > * * .
86400
( 0 ): > 200 30 /mod

( 2 ): 20 6 > bye

Bye!
$

Все, что после символа ">" — это мой ввод с клавиатуры. Остальное — ответ системы. Немного поигрался командами, набирая с клавиатуры. Выполнил несколько стековых операций, вычислил число секунд в сутках.

Итог


Интерпретатор в сборе и работает. И вежливо прощается — ему «пока» и он «пока» :)
В качестве приглашения — содержимое арифметического стека. Первое число в скобках — размер стека, дальше содержимое, и приглашение для ввода ">". Можно вводить любые реализованные команды (я насчитал 76 команд). Правда, многие имеют смысл только для компилятора — например, литералы, переходы, команды вызова.

Полный исходник (около 1300 строк)
.intel_syntax noprefix

stack_size = 1024

f_code = 0x80
f_immediate = 0x60

.macro	item	name, flags = 0
	
	link = p_item - .
9:	
	.if	link >= -256/2 && link < 256/2
		.byte	\flags
		.byte	link
	.elseif	link >= -256*256/2 && link < 256*256/2
		.byte	\flags | 1
		.word	link
	.elseif	link >= -256*256*256*256/2 && link < 256*256*256*256/2
		.byte	\flags | 2
		.int	link
	.elseif	link >= -256*256*256*256*256*256*256*256/2 && link < 256*256*256*256*256*256*256*256/2
		.byte	\flags | 3
		.quad	link
	.endif
	
	p_item = 9b
	
	.byte	9f - . - 1
	.ascii	"\name"
9:
.endm
	
.section .data

init_stack:	.quad	0
init_rstack:	.quad	0

emit_buf:	.byte	0

inbuf_size = 256

msg_bad_byte:
.ascii "Bad byte code!\n"
msg_bad_byte_len = . - msg_bad_byte # символу len присваеваетсЯ длина строки

msg_bye:
.ascii "\nBye!\n"
msg_bye_len = . - msg_bye 

bcmd:
.quad		bcmd_bad,	bcmd_bye,	bcmd_num0,	bcmd_num1,	bcmd_num2,	bcmd_num3,	bcmd_num4,	bcmd_num8	# 0x00
.quad		bcmd_lit8,	bcmd_lit16,	bcmd_lit32,	bcmd_lit64,	bcmd_call8,	bcmd_call16,	bcmd_call32,	bcmd_bad
.quad		bcmd_branch8,	bcmd_branch16,	bcmd_qbranch8,	bcmd_qbranch16,	bcmd_qnbranch8,	bcmd_qnbranch16,bcmd_bad,	bcmd_exit	# 0x10
.quad		bcmd_wp,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_wm,	bcmd_add,	bcmd_sub,	bcmd_mul,	bcmd_div,	bcmd_mod,	bcmd_divmod,	bcmd_abs	# 0x20
.quad		bcmd_var0,	bcmd_var8,	bcmd_var16,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_dup,	bcmd_drop,	bcmd_swap,	bcmd_rot,	bcmd_mrot,	bcmd_over,	bcmd_pick,	bcmd_roll	# 0x30
.quad		bcmd_depth,	bcmd_nip,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad 
.quad		bcmd_get,	bcmd_set,	bcmd_get8,	bcmd_set8,	bcmd_get16,	bcmd_set16,	bcmd_get32,	bcmd_set32 	# 0x40
.quad		bcmd_setp,	bcmd_setm,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad 
.quad		bcmd_zeq,	bcmd_zlt,	bcmd_zgt,	bcmd_eq,	bcmd_lt,	bcmd_gt,	bcmd_lteq,	bcmd_gteq	# 0x50
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_2r,	bcmd_r2,	bcmd_rget,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad	# 0x60
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_type,	bcmd_emit,	bcmd_str,	bcmd_strp,	bcmd_count,	bcmd_bad,	bcmd_bad,	bcmd_bad	# 0x80
.quad		bcmd_expect,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad	# 0x90
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad
.quad		bcmd_blword,	bcmd_quit,	bcmd_find,	bcmd_cfa,	bcmd_execute,	bcmd_numberq,	bcmd_bad,	bcmd_bad	# 0xF0
.quad		bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad,	bcmd_bad

# forth last_item context @ ! quit
start:		.byte	b_call16
		.word	forth - . - 2
		.byte	b_call16
		.word	last_item - . - 2
		.byte	b_call16
		.word	context - . - 2
		.byte	b_get
		.byte	b_set
		.byte	b_quit

		inbuf:		.byte	b_var0
		.space inbuf_size

		
# begin inbuf dup tib ! inbuf_size expect span @ #tib ! 0 >in ! interpret again
quit:		.byte	b_strp, 1
		.ascii	"\n"
		.byte	b_call16
		.word	prstack - . - 2
		.byte	b_strp
		.byte	2
		.ascii	"> "
		.byte	b_call16
		.word	inbuf - . - 2
		.byte	b_dup
		.byte	b_call16
		.word	tib - . - 2
		.byte	b_set
		.byte	b_lit16
		.word	inbuf_size
		.byte	b_expect
		.byte	b_call16
		.word	span - . - 2
		.byte	b_get
		.byte	b_call16
		.word	ntib - . - 2
		.byte	b_set
		.byte	b_num0
		.byte	b_call16
		.word	bin - . - 2
		.byte	b_set
		.byte	b_call16
		.word	interpret - . - 2
		.byte	b_branch8, quit - .

p_item = .
		item	forth
forth:		.byte	b_var8
		.byte	does_voc - .
		.quad	0
does_voc:
		.byte	b_call8
		.byte	context - . - 1
		.byte	b_set
		.byte	b_exit

		item	current
		.byte	b_var0
		.quad	0

		item	context
context:	.byte	b_var0
v_context:	.quad	0
		
		item	0, f_code
		.byte	b_num0
		.byte	b_exit

		item	1, f_code
		.byte	b_num1
		.byte	b_exit

		item	2, f_code
		.byte	b_num2
		.byte	b_exit

		item	3, f_code
		.byte	b_num3
		.byte	b_exit

		item	4, f_code
		.byte	b_num4
		.byte	b_exit

		item	8, f_code
		.byte	b_num8
		.byte	b_exit

		item	lit8, f_code
		.byte	b_lit8
		.byte	31
		.byte	b_exit
		
		item	lit16, f_code
		.byte	b_lit16
		.word	31415
		.byte	b_exit

		item	lit32, f_code
		.byte	b_lit32
		.int	31415926
		.byte	b_exit

		item	lit64, f_code
		.byte	b_lit64
		.quad	31415926
		.byte	b_exit

		item	call8, f_code
		.byte	b_call8
		.byte	0f - . - 1
0:		.byte	b_exit
		
		item	call16, f_code
		.byte	b_call16
		.word	0f - . - 2
0:		.byte	b_exit

		item	call32, f_code
		.byte	b_call32
		.int	0f - . - 4
0:		.byte	b_exit

		item	branch8, f_code
		.byte	b_branch8
		.byte	0f - .
0:		.byte	b_exit
		
		item	branch16, f_code
		.byte	b_branch16
		.word	0f - .
0:		.byte	b_exit
		
		item	qbranch8, f_code
		.byte	b_qbranch8
		.byte	0f - .
0:		.byte	b_exit
		
		item	qbranch16, f_code
		.byte	b_qbranch16
		.word	0f - .
0:		.byte	b_exit
		
		item	exit, f_code
		.byte	b_exit
		
		item	1-, f_code
		.byte	b_wm
		.byte	b_exit
		
		item	1+, f_code
		.byte	b_wp
		.byte	b_exit
		
		item	+, f_code
		.byte	b_add
		.byte	b_exit
		
		item	-, f_code
		.byte	b_sub
		.byte	b_exit
		
		item	*, f_code
		.byte	b_mul
		.byte	b_exit
		
 		item	/, f_code
		.byte	b_div
		.byte	b_exit
		
		item	mod, f_code
		.byte	b_mod
		.byte	b_exit
		
		item	/mod, f_code
		.byte	b_divmod
		.byte	b_exit
		
		item	abs, f_code
		.byte	b_abs
		.byte	b_exit

		item	dup, f_code
		.byte	b_dup
		.byte	b_exit
		
		item	drop, f_code
		.byte	b_drop
		.byte	b_exit
		
		item	swap, f_code
		.byte	b_swap
		.byte	b_exit
		
		item	rot, f_code
		.byte	b_rot
		.byte	b_exit
		
 		item	-rot, f_code
		.byte	b_mrot
		.byte	b_exit
		
		item	over, f_code
		.byte	b_over
		.byte	b_exit
		
		item	pick, f_code
		.byte	b_pick
		.byte	b_exit
		
		item	roll, f_code
		.byte	b_roll
		.byte	b_exit
		
		item	depth, f_code
		.byte	b_depth
		.byte	b_exit
		
		item	@, f_code
		.byte	b_get
		.byte	b_exit
		
		item	!, f_code
		.byte	b_set
		.byte	b_exit
		
		item	c@, f_code
		.byte	b_get8
		.byte	b_exit
		
		item	c!, f_code
		.byte	b_set8
		.byte	b_exit
		
		item	w@, f_code
		.byte	b_get16
		.byte	b_exit
		
		item	w!, f_code
		.byte	b_set16
		.byte	b_exit
		
		item	i@, f_code
		.byte	b_get32
		.byte	b_exit
		
		item	i!, f_code
		.byte	b_set32
		.byte	b_exit
		
		item	+!, f_code
		.byte	b_setp
		.byte	b_exit
		
		item	-!, f_code
		.byte	b_setm
		.byte	b_exit
		
		item	>r, f_code
		.byte	b_2r
		.byte	b_exit

		item	r>, f_code
		.byte	b_r2
		.byte	b_exit

		item	r@, f_code
		.byte	b_rget
		.byte	b_exit

		item	"0=", f_code
		.byte	b_zeq
		.byte	b_exit
		
		item	0<, f_code
		.byte	b_zlt
		.byte	b_exit
		
		item	0>, f_code
		.byte	b_zgt
		.byte	b_exit
		
		item	"=", f_code
		.byte	b_eq
		.byte	b_exit
		
		item	<, f_code
		.byte	b_lt
		.byte	b_exit
		
		item	>, f_code
		.byte	b_gt
		.byte	b_exit
		
		item	"<=", f_code
		.byte	b_lteq
		.byte	b_exit
		
		item	">=", f_code
		.byte	b_gteq
		.byte	b_exit
		
		item	type, f_code
		.byte	b_type
		.byte	b_exit

		item	expect, f_code
		.byte	b_expect
		.byte	b_exit
		
		item	emit, f_code
		.byte	b_emit
		.byte	b_exit

		item	count, f_code
		.byte	b_count
		.byte	b_exit

		item	"(\")", f_code
		.byte	b_str
		.byte	b_exit

		item	"(.\")", f_code
		.byte	b_strp
		.byte	b_exit

		item	var8, f_code
		.byte	b_var8
		.byte	0f - .
0:		.byte	b_exit
		
		item	var16, f_code
		.byte	b_var16
		.word	0f - .
0:		.byte	b_exit
		
		item	base
base:		.byte	b_var0
v_base:		.quad	10

holdbuf_len = 70
		item	holdbuf
holdbuf:	.byte	b_var0
		.space	holdbuf_len

		item	holdpoint
holdpoint:	.byte	b_var0
		.quad	0
		
		item	span
span:		.byte	b_var0
v_span:		.quad	0

# : hold holdpoint @ 1- dup holdbuf > if drop drop else dup holdpoint ! c! then ;
		item	hold
hold:		.byte	b_call8
		.byte	holdpoint - . - 1	# holdpoint
		.byte	b_get			# @
		.byte	b_wm			# 1-
		.byte	b_dup			# dup
		.byte	b_call8
		.byte	holdbuf - . - 1		# holdbuf
		.byte	b_gt			# >
		.byte	b_qbranch8		# if
		.byte	0f - .
		.byte	b_drop			# drop
		.byte	b_drop			# drop
		.byte	b_branch8		# команда перехода на возврат (после then)
		.byte	1f - .
0:		.byte	b_dup			# dup
		.byte	b_call8
		.byte	holdpoint - . - 1	# holdpoint
		.byte	b_set			# !
		.byte	b_set8			# c!
1:		.byte	b_exit			# ;

# : # base /mod swap dup 10 < if c" 0 + else 10 - c" A + then hold ;
		item	#
conv:		.byte	b_call16
		.word	base - . - 2		# base
		.byte	b_get			# @
		.byte	b_divmod		# /mod
		.byte	b_swap			# swap
		.byte	b_dup			# dup
		.byte	b_lit8
		.byte	10			# 10
		.byte	b_lt			# <
		.byte	b_qnbranch8		# if
		.byte	0f - .
		.byte	b_lit8
		.byte	'0'			# c" 0
		.byte	b_add			# +
		.byte	b_branch8		# else
		.byte	1f - .
0:		.byte	b_lit8
		.byte	'?'			# c" A
		.byte	b_add			# +
1:		.byte	b_call16
		.word	hold - . - 2		# hold
		.byte	b_exit			# ;

# : <# holdbuf 70 + holdpoint ! ;
		item	<#
conv_start:	.byte	b_call16
		.word	holdbuf - . - 2
		.byte	b_lit8
		.byte	holdbuf_len
		.byte	b_add
		.byte	b_call16
		.word	holdpoint - . - 2
		.byte	b_set
		.byte	b_exit

# : #s do # dup 0=until ;
		item	#s
conv_s:		.byte	b_call8
		.byte	conv - . - 1
		.byte	b_dup
		.byte	b_qbranch8
		.byte	conv_s - .
		.byte	b_exit

# : #> holdpoint @ holdbuf 70 + over - ;
		item	#>
conv_end:	.byte	b_call16
		.word	holdpoint - . - 2
		.byte	b_get
		.byte	b_call16
		.word	holdbuf - . - 2
		.byte	b_lit8
		.byte	holdbuf_len
		.byte	b_add
		.byte	b_over
		.byte	b_sub
		.byte	b_exit

		item	.
dot:		.byte	b_dup
		.byte	b_abs
		.byte	b_call8
		.byte	conv_start - . - 1
		.byte	b_lit8
		.byte	' '
		.byte	b_call16
		.word	hold - . - 2
		.byte	b_call8
		.byte	conv_s - . - 1
		.byte	b_drop
		.byte	b_zlt
		.byte	b_qnbranch8
		.byte	1f - .
		.byte	b_lit8
		.byte	'-'
		.byte	b_call16
		.word	hold - . - 2
1:		.byte	b_call8
		.byte	conv_end - . - 1
		.byte	b_type
		.byte	b_exit

		item	tib
tib:		.byte	b_var0
v_tib:		.quad	0

		item	#tib
ntib:		.byte	b_var0
v_ntib:		.quad	0

		item	>in
bin:		.byte	b_var0
v_in:		.quad	0

# : .s depth dup . c": emit do dup while dup pick . 1- again drop ;
		item	.s		# 11 22 33
prstack:	.byte	b_depth		# 11 22 33 3
		.byte	b_dup		# 11 22 33 3 3
		.byte	b_strp
		.byte	2
		.ascii	"( "
		.byte	b_call16	# 11 22 33 3
		.word	dot - . - 2
		.byte	b_strp		# 11 22 33 3
		.byte	3
		.ascii	"): "
		.byte	b_dup, b_zlt
		.byte	b_qnbranch8, 1f - .
		.byte	b_strp
		.byte	14
		.ascii	"\nStack fault!\n"
		.byte	b_quit
1:		.byte	b_dup		# 11 22 33 3 3
		.byte	b_qnbranch8	# 11 22 33 3
		.byte	2f - .
		.byte	b_dup		# 11 22 33 3 3
		.byte	b_pick		# 11 22 33 3 11
		.byte	b_call16	# 11 22 33 3
		.word	dot - . - 2
		.byte	b_wm		# 11 22 33 2
		.byte	b_branch8
		.byte	1b - .
2:		.byte	b_drop		# 11 22 33
		.byte	b_exit

.macro	prs	new_line = 1
		.byte	b_call16
		.word	prstack - . - 2
		.if	\new_line > 0
		.byte	b_lit8, '\n'
		.byte	b_emit
		.endif
.endm

.macro	pr	string
		.byte	b_strp
		.byte	9f - 8f
8:		.ascii	"\n\string"
9:
.endm

		item	interpret
interpret:	.byte	b_blword
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	0f - .
		.byte	b_over
		.byte	b_over
		.byte	b_find
		.byte	b_dup
		.byte	b_qnbranch8
		.byte	1f - .
		.byte	b_mrot
		.byte	b_drop
		.byte	b_drop
		.byte	b_cfa
		.byte	b_execute
		.byte	b_branch8
		.byte	2f - .
1:		.byte	b_drop
		.byte	b_over, b_over
		.byte	b_numberq
		# проверка, что число преобразовалось
		.byte	b_qbranch8, 3f - . # если на стеке не 0, значит, преобразовалось и идем на метку 3
		.byte	b_type		# иначе печатаем слово
		.byte	b_strp		# потом диагностику
		.byte	19		# это длинна сообщениЯ ниже
		.ascii	" : word not found!\n"
		.byte	b_quit		# и завершаем интерпретацию
3:		.byte	b_nip, b_nip	# удалим значениЯ, сохраненные длЯ печати слова (команды b_over, b_over)
2:		# проверка стека на выход за границу
		.byte	b_depth		# получаем глубину стека
		.byte	b_zlt		# сравниваем, что меньше 0 (команда 0<)
		.byte	b_qnbranch8, interpret_ok - . # если условие ложно, то все в порЯдке, делаем переход
		.byte	b_strp		# иначе выводим диагностику
		.byte	14
		.ascii	"\nstack fault!\n"
		.byte	b_quit		# и завершаем интерпретацию
interpret_ok:	.byte	b_branch8
		.byte	interpret - .
0:		.byte	b_drop
		.byte	b_exit

last_item:	.byte	b_var0
		item	bye, f_code
		.byte	b_bye

.section .text

.global _start # точка входа в программу

_start:		mov	rbp, rsp
		sub	rbp, stack_size
		lea	r8, start
		mov	init_stack, rsp
		mov	init_rstack, rbp
		
		jmp	_next

b_var0 = 0x28
bcmd_var0:	push	r8

b_exit = 0x17
bcmd_exit:      mov     r8, [rbp]
                add     rbp, 8

_next:		movzx	rcx, byte ptr [r8]
		inc	r8
		jmp	[bcmd + rcx*8]

b_num0 = 0x02
bcmd_num0:      push    0
                jmp     _next

b_num1 = 0x03
bcmd_num1:      push    1
                jmp     _next

b_num2 = 0x04
bcmd_num2:      push    2
                jmp     _next

b_num3 = 0x05
bcmd_num3:      push    3
                jmp     _next

b_num4 = 0x06
bcmd_num4:      push    4
                jmp     _next

b_num8 = 0x07
bcmd_num8:      push    8
                jmp     _next

b_lit8 = 0x08
bcmd_lit8:      movsx   rax, byte ptr [r8]
                inc     r8
                push    rax
                jmp     _next

b_lit16 = 0x09
bcmd_lit16:     movsx   rax, word ptr [r8]
                add     r8, 2
                push    rax
                jmp     _next

b_call8 = 0x0C
bcmd_call8:     movsx   rax, byte ptr [r8]
                sub     rbp, 8
                inc     r8
                mov     [rbp], r8
                add     r8, rax
                jmp     _next

b_call16 = 0x0D
bcmd_call16:    movsx   rax, word ptr [r8]
                sub     rbp, 8
                add     r8, 2
                mov     [rbp], r8
                add     r8, rax
                jmp     _next

b_call32 = 0x0E
bcmd_call32:    movsx   rax, dword ptr [r8]
                sub     rbp, 8
                add     r8, 4
                mov     [rbp], r8
                add     r8, rax
                jmp     _next

b_lit32 = 0x0A
bcmd_lit32:     movsx   rax, dword ptr [r8]
                add     r8, 4
                push    rax
                jmp     _next

b_lit64 = 0x0B
bcmd_lit64:     mov     rax, [r8]
                add     r8, 8
                push    rax
                jmp     _next

b_dup = 0x30
bcmd_dup:       push    [rsp]
                jmp     _next

b_wm = 0x20
bcmd_wm:        decq    [rsp]
                jmp     _next

b_wp = 0x18
bcmd_wp:        incq    [rsp]
                jmp     _next

b_add = 0x21
bcmd_add:	pop	rax
		add	[rsp], rax
		jmp	_next

b_sub = 0x22
bcmd_sub:	pop	rax
		sub	[rsp], rax
		jmp	_next

b_mul = 0x23
bcmd_mul:	pop	rax
		pop	rbx
		imul	rbx
		push	rax
		jmp	_next

b_div = 0x24
bcmd_div:	pop	rbx
		pop	rax
		cqo
		idiv	rbx
		push	rax
		jmp	_next

b_mod = 0x25
bcmd_mod:	pop	rbx
		pop	rax
		cqo
		idiv	rbx
		push	rdx
		jmp	_next

b_divmod = 0x26
bcmd_divmod:	pop	rbx
		pop	rax
		cqo
		idiv	rbx
		push	rdx
		push	rax
		jmp	_next

b_abs = 0x27
bcmd_abs:	mov	rax, [rsp]
		or	rax, rax
		jge	_next
		neg	rax
		mov	[rsp], rax
		jmp	_next

b_drop = 0x31
bcmd_drop:	add	rsp, 8
		jmp	_next

b_swap = 0x32
bcmd_swap:	pop	rax
		pop	rbx
		push	rax
		push	rbx
		jmp	_next

b_rot = 0x33
bcmd_rot:	pop	rax
		pop	rbx
		pop	rcx
		push	rbx
		push	rax
		push	rcx
		jmp	_next
		
b_mrot = 0x34
bcmd_mrot:	pop	rcx
		pop	rbx
		pop	rax
		push	rcx
		push	rax
		push	rbx
		jmp	_next
		
b_over = 0x35
bcmd_over:	push	[rsp + 8]
		jmp	_next
		
b_pick = 0x36
bcmd_pick:	pop	rcx
		push	[rsp + 8*rcx]
		jmp	_next
		
b_roll = 0x37
bcmd_roll:	pop	rcx
		mov	rbx, [rsp + 8*rcx]
roll1:		mov	rax, [rsp + 8*rcx - 8]
		mov	[rsp + 8*rcx], rax
		dec	rcx
		jnz	roll1
		push	rbx
		jmp	_next

b_depth = 0x38
bcmd_depth:	mov	rax, init_stack
		sub	rax, rsp
		sar	rax, 3
		push	rax
		jmp	_next
		
b_nip = 0x39
bcmd_nip:	pop	rax
		mov	[rsp], rax
		jmp	_next
		
b_get = 0x40
bcmd_get:	pop	rcx
		push	[rcx]
		jmp	_next

b_set = 0x41
bcmd_set:	pop	rcx
		pop	rax
		mov	[rcx], rax
		jmp	_next

b_get8 = 0x42
bcmd_get8:	pop	rcx
		movsx	rax, byte ptr [rcx]
		push	rax
		jmp	_next

b_set8 = 0x43
bcmd_set8:	pop	rcx
		pop	rax
		mov	[rcx], al
		jmp	_next

b_get16 = 0x44
bcmd_get16:	pop	rcx
		movsx	rax, word ptr [rcx]
		push	rax
		jmp	_next

b_set16 = 0x45
bcmd_set16:	pop	rcx
		pop	rax
		mov	[rcx], ax
		jmp	_next

b_get32 = 0x46
bcmd_get32:	pop	rcx
		movsx	rax, dword ptr [rcx]
		push	rax
		jmp	_next

b_set32 = 0x47
bcmd_set32:	pop	rcx
		pop	rax
		mov	[rcx], eax
		jmp	_next
		
b_setp = 0x48
bcmd_setp:	pop	rcx
		pop	rax
		add	[rcx], rax
		jmp	_next

b_setm = 0x49
bcmd_setm:	pop	rcx
		pop	rax
		sub	[rcx], rax
		jmp	_next

b_2r = 0x60
bcmd_2r:	pop	rax
		sub	rbp, 8
		mov	[rbp], rax
		jmp	_next

b_r2 = 0x61
bcmd_r2:	push	[rbp]
		add	rbp, 8
		jmp	_next

b_rget = 0x62
bcmd_rget:	push	[rbp]
		jmp	_next

# 0=
b_zeq = 0x50
bcmd_zeq:	pop	rax
		or	rax, rax
		jnz	rfalse
rtrue:		push	-1
		jmp	_next
rfalse:		push	0
		jmp	_next
		
# 0<
b_zlt = 0x51
bcmd_zlt:	pop	rax
		or	rax, rax
		jl	rtrue
		push	0
		jmp	_next
		
# 0>
b_zgt = 0x52
bcmd_zgt:	pop	rax
		or	rax, rax
		jg	rtrue
		push	0
		jmp	_next

# =
b_eq = 0x53
bcmd_eq:	pop	rbx
		pop	rax
		cmp	rax, rbx
		jz	rtrue
		push	0
		jmp	_next

# <
b_lt = 0x54
bcmd_lt:	pop	rbx
		pop	rax
		cmp	rax, rbx
		jl	rtrue
		push	0
		jmp	_next
		
# >
b_gt = 0x55
bcmd_gt:	pop	rbx
		pop	rax
		cmp	rax, rbx
		jg	rtrue
		push	0
		jmp	_next

# <=
b_lteq = 0x56
bcmd_lteq:	pop	rbx
		pop	rax
		cmp	rax, rbx
		jle	rtrue
		push	0
		jmp	_next
		
# >=
b_gteq = 0x57
bcmd_gteq:	pop	rbx
		pop	rax
		cmp	rax, rbx
		jge	rtrue
		push	0
		jmp	_next

b_var8 = 0x29
bcmd_var8:	push	r8

b_branch8 = 0x10
bcmd_branch8:   movsx   rax, byte ptr [r8]
                add     r8, rax
                jmp     _next

b_var16 = 0x30
bcmd_var16:	push	r8

b_branch16 = 0x11
bcmd_branch16:  movsx   rax, word ptr [r8]
                add     r8, rax
                jmp     _next

b_qbranch8 = 0x12
bcmd_qbranch8:  pop     rax
                or      rax, rax
                jnz     bcmd_branch8
                inc     r8
                jmp     _next

b_qbranch16 = 0x13
bcmd_qbranch16: pop     rax
                or      rax, rax
                jnz     bcmd_branch16
                add     r8, 2
                jmp     _next

b_qnbranch8 = 0x14
bcmd_qnbranch8:	pop     rax
                or      rax, rax
                jz	bcmd_branch8
                inc     r8
                jmp     _next

b_qnbranch16 = 0x15
bcmd_qnbranch16:pop     rax
                or      rax, rax
                jz	bcmd_branch16
                add     r8, 2
                jmp     _next

b_bad = 0x00
bcmd_bad:	mov	rax, 1			# системный вызов Ь 1 - sys_write
		mov	rdi, 1			# поток Ь 1 С stdout
		mov	rsi, offset msg_bad_byte # указатель на выводимую строку
		mov	rdx, msg_bad_byte_len	# длина строки
		syscall				# вызов Ядра
		mov	rax, 60			# системный вызов Ь 1 - sys_exit
		mov	rbx, 1			# выход с кодом 1
		syscall				# вызов Ядра

b_bye = 0x01
bcmd_bye:	mov	rax, 1			# системный вызов Ь 1 - sys_write
		mov	rdi, 1			# поток Ь 1 С stdout
		mov	rsi, offset msg_bye	# указатель на выводимую строку
		mov	rdx, msg_bye_len	# длина строки
		syscall				# вызов Ядра
		mov	rax, 60			# системный вызов Ь 60 - sys_exit
		mov	rdi, 0			# выход с кодом 0
		syscall				# вызов Ядра

b_strp = 0x83
bcmd_strp:	movsx	rax, byte ptr [r8]
		inc	r8
		push	r8
		add	r8, rax
		push	rax

b_type = 0x80
bcmd_type:	mov	rax, 1			# системный вызов Ь 1 - sys_write
		mov	rdi, 1			# поток Ь 1 - stdout
		pop	rdx			# длинна буфера
		pop	rsi			# адрес буфера
		push	r8
		syscall				# вызов Ядра
		pop	r8
		jmp	_next

b_expect = 0x88
bcmd_expect:	mov	rax, 0			# системный вызов Ь 1 - sys_read
		mov	rdi, 0			# поток Ь 1 - stdout
		pop	rdx			# длинна буфера
		pop	rsi			# адрес буфера
		push	r8
		syscall				# вызов Ядра
		pop	r8
		mov	rbx, rax
		or	rax, rax
		jge	1f
		xor	rbx, rbx
1:		mov	v_span, rbx
		jmp	_next

b_str = 0x82
bcmd_str:	movzx	rax, byte ptr [r8]
		lea	r8, [r8 + rax + 1]
		jmp	_next

b_count = 0x84
bcmd_count:	pop	rcx
		movzx	rax, byte ptr [rcx]
		inc	rcx
		push	rcx
		push	rax
		jmp	_next
		
b_emit = 0x81
bcmd_emit:	pop	rax
		mov	rsi, offset emit_buf	# адрес буфера
		mov	[rsi], al
		mov	rax, 1			# системный вызов Ь 1 - sys_write
		mov	rdi, 1			# поток Ь 1 - stdout
		mov	rdx, 1			# длинна буфера
		push	r8
		syscall				# вызов Ядра
		pop	r8
		jmp	_next
		
b_blword = 0xF0
bcmd_blword:	mov	rsi, v_tib	# адрес текстового буфера
		mov	rdx, rsi	# сохраним в RDX начало текстового буфера длЯ последующего использованиЯ
		mov	rax, v_in	# смещение в текстовом буфере
		mov	rcx, v_ntib	# размер текстового буфера
		mov	rbx, rcx
		add	rsi, rax	# теперь RSI - указатель на начало обрабатываемого текста
		sub	rcx, rax	# получили количество оставшихсЯ символов
		jz	3f
word2:		lodsb			# загрузка в AL по RSI с инкрементом
		cmp	al, ' '
		ja	1f		# пропускаем все разделители (пробел или с кодом меньше)
		dec	rcx
		jnz	word2		# цикл по пробелам
3:		sub	rsi, rdx
		mov	v_in, rsi
		push	rcx
		jmp	_next
1:		lea	rdi, [rsi - 1]	#  RDI = RSI - 1 (начало слова)
		dec rcx
		jz	word9
word3:		lodsb
		cmp	al, ' '
		jbe	2f
		dec	rcx
		jnz	word3
word9:		inc	rsi
2:		mov	rax, rsi
		sub	rsi, rdx	# смещение на первый символ после первого разделителЯ (длЯ поиска следующего слова)
		cmp	rsi, rbx
		jle	4f
		mov	rsi, rbx
4:		mov	v_in, rsi
		sub	rax, rdi
		dec	rax
		jz	word1
		push	rdi		# начало слова
word1:		push	rax		# длина слова
		jmp	_next

b_quit = 0xF1
bcmd_quit:	lea	r8, quit
		mov	rsp, init_stack
		mov	rbp, init_rstack
		jmp	_next

b_find = 0xF2
bcmd_find:	pop	rbx			# длина имени
		pop	r9			# адрес имени
		mov	rdx, v_context
		mov	rdx, [rdx]		# получили адрес последней словарной статьи длЯ поиска
		# цикл поиска
find0:		mov	al, [rdx]		# флаги
		and	al, 3			# два младших - это вариангт длинны полЯ свЯзи, остальные флаги нас не интересуют, они длЯ компилЯтора
		or	al, al
		jz	find_l8
		cmp	al, 1
		jz	find_l16
		cmp	al, 2
		jz	find_l32
		mov	r10, [rdx + 1]		# смещение 64 бита
		lea	rsi, [rdx + 9]		# адрес имени
		jmp	find1
find_l32:	movsx	r10, dword ptr [rdx + 1] 		# смещение 32 бита
		lea	rsi, [rdx + 5]		# адрес имени
		jmp	find1
find_l16:	movsx	r10, word ptr [rdx + 1]	# смещение 16 бит
		lea	rsi, [rdx + 3]		# адрес имени
		jmp	find1
find_l8:	movsx	r10, byte ptr [rdx + 1]	# смещение 8 бит
		lea	rsi, [rdx + 2]		# адрес имени
find1:		movzx	rax, byte ptr [rsi]	# длина имени из проверЯемой словарной статьи
		cmp	rax, rbx
		jz	find2
		# имЯ не совпало по длине
find3:		or	r10, r10
		jz	find_notfound		# конец поиска, слово не найдено
		add	rdx, r10		# переходим к следующей статье
		jmp	find0
		# длина совпала, сравниваем строки
find2:		inc	rsi
		mov	rdi, r9
		mov	rcx, rax
		repz	cmpsb
		jnz	find3
		# слово найдено
		push	rdx
		jmp	_next
find_notfound:	push	r10
		jmp	_next
		
b_cfa = 0xF3
bcmd_cfa:	pop	rdx			# адрес словарной статьи
		mov	al, [rdx]		# флаги
		and	al, 3			# два младших - это вариангт длинны полЯ свЯзи, остальные флаги нас не интересуют, они длЯ компилЯтора
		or	al, al
		jz	cfa_l8
		cmp	al, 1
		jz	cfa_l16
		cmp	al, 2
		jz	cfa_l32
		lea	rsi, [rdx + 9]		# адрес имени (64 бита ссылка)
		jmp	cfa1
cfa_l32:	lea	rsi, [rdx + 5]		# адрес имени (32 бита ссылка)
		jmp	cfa1
cfa_l16:	lea	rsi, [rdx + 3]		# адрес имени (16 бит ссылка)
		jmp	cfa1
cfa_l8:		lea	rsi, [rdx + 2]		# адрес имени (8 бита ссылка)
cfa1:		xor	rax, rax
		lodsb
		add	rsi, rax
		push	rsi
		jmp	_next

b_execute = 0xF4
bcmd_execute:	sub	rbp, 8
		mov	[rbp], r8		# сохранЯем в стеке возвратов адрес возврата
		pop	r8			# адрес байт-кода
                jmp     _next

b_numberq = 0xF5
bcmd_numberq:	pop	rcx			# длина строки
		pop	rsi			# адрес
		xor	rax, rax		# преобрахуемое число
		xor	rbx, rbx		# тут будет преобразуемаЯ цифра
		mov	r9, v_base		# база
		xor	r10, r10		# знак числа
		or	rcx, rcx
		jz	num_false
		mov	bl, [rsi]
		cmp	bl, '+'
		jnz	1f
		inc	rsi
		dec	rcx
		jz	num_false
		jmp	num0
1:		cmp	bl, '-'
		jnz	num0
		mov	r10, 1
		inc	rsi
		dec	rcx
		jz	num_false
num0:		mov	bl, [rsi]
		cmp	bl, '0'
		jb	num_false
		cmp	bl, '9'
		jbe	num_09
		cmp	bl, 'A'
		jb	num_false
		cmp	bl, 'Z'
		jbe	num_AZ
		cmp	bl, 'a'
		jb	num_false
		cmp	bl, 'z'
		ja	num_false
		sub	bl, 'a' - 10
		jmp	num_check
num_AZ:		sub	bl, 'A' - 10
		jmp	num_check
num_09:		sub	bl, '0'
num_check:	cmp	rbx, r9
		jge	num_false
		mul	r9
		add	rax, rbx
		inc	rsi
		dec	rcx
		jnz	num0
		or	r10, r10
		push	rax
		push	1
		jmp	_next
num_false:	xor	rcx, rcx
		push	rcx
		jmp	_next

Исходник становиться больше, поэтому привожу его здесь последний раз.

Теперь его место жительства будет на гитхабе: https://github.com/hal9000cc/forth64
Там же, в папке bin можно найти уже скомпилированный для Linux x64 вариант. У кого Linux, можно скачать и запустить.

А у кого Windows — можно поставить WSL (Windows Subsystem for Linux). На праздники я уезжал, и именно так и сделал. Это оказалось очень просто, заняло минут 5. Единственный был момент, сразу не запустилась, подсистему надо было «включить» через команду PowerShell. Прошел по ссылке из сообщения об ошибке, выполнил команду, и все заработало.

Но есть еще и путь настоящих индейцев — запустить все это под Windows :) Сделать это не сложно, достаточно переделать несколько слов, взаимодействующих с системой.

На этом все! В следующий раз запилим компилятор.

Будет возможность компилировать новые слова, будут условия, циклы. Собственно, можно будет писать на более-менее стандартном форте, компилировать в байт-код и исполнять. Ну и можно будет провести уже более серьезные тесты, проверить быстродействие байт-машины.

Продолжение: Байт-машина для форта (и не только) по-индейски (часть 4)
Tags:
Hubs:
Total votes 12: ↑11 and ↓1+10
Comments1

Articles