Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт дек 05, 2019 19:03

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 159 ]  На страницу Пред.  1 ... 6, 7, 8, 9, 10, 11  След.
Автор Сообщение
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Ср окт 31, 2012 18:05 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
урря, нашлось:
Код:
; 14.01.2010 mOleg
; набросок трехстековой Форт Виртуальной Машины (ФВМ)
; стеки: данных, возвратов, адресов

; подпрограммный шитый код без оптимизаций
; в двух секциях: код отдельно от пространства имен

; без VALUE и VECT переменных
; без многопоточности и локальных областей данных
; без словарей (один список слов)
; без опроса клавиш (через readfile)
; без поддержки механизма исключений
; без ускорения поиска имен в списке слов
; без отдельного распознавания чисел (спец префиксы перед числами)

format PE console ; под винду

entry _cold ; стартовый адрес

include 'include\win32a.inc'
include 'include\macro\struct.inc'

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

section '.import' import data readable writeable
                               ;
  library kernel,'KERNEL32.DLL'

  import kernel,\
         LoadLibrary, 'LoadLibrary',\
         GetProcAddress, 'GetProcAddress',\
         ExitProcess, 'ExitProcess',\
         GetStdHandle, 'GetStdHandle',\
         WriteFile, 'WriteFile',\
         ReadFile, 'ReadFile'
; ------------------------------------------------------------------------------

; использование регистров

  tos equ EAX ; кеш вершины стека данных
  toa equ EBX ; кеш вершины стека возвратов

temp equ EDX ; временный регистра
cnt  equ ECX

  tad equ EBP ; указатель на вершину стека данных
  tar equ ESP ; указатель на вершину стека возвратов
  taa equ ESI ; указатель на вершину стека адресов

; типы данных

struct cell
        body dd ? ;
    ends

struct addr
        body dd ? ;
    ends

struct token
        call db 0xE8
        ref  dd ?
     ends

struct scnt
        body db ?
     ends

struct ref
        body dd ?
     ends

; ------------------------------------------------------------------------------
; объявление констант

ADDR  = sizeof.addr  ; размер адресной ссылки
CELL  = sizeof.cell  ; размер ячейки данных
REF   = sizeof.ref   ; размер ссылки
TOKEN = sizeof.token ; размер токена
SCNT  = sizeof.scnt  ; размер счетчика длины


dStack equ 0x1000 ; размер стека данных
aStack equ 0x1000 ; размер стека адресов
rStack equ 0x1000 ; размер стека возвратов

TIB_size = 0x50
PAD_size = 0x50

NamesSpace = 0x10000
CodeSpace  = 0x10000

ImmWord = -1 ; признак слова немедленного исполнения
StdWord =  1 ; признак обычного слова

; вычисляем сколько места надо выделять под стеки
stack (dStack+aStack+rStack)*2, dStack+aStack+rStack

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

latest = 0

; описатель форт-строк
macro fstr [string]
       { common local .count, .body
        .count scnt ?
        .body  db string,0
        store $-.body-1 at .count
        }

macro slit [str]
      { local labxx
        call _box
        addr labxx
         fstr str
        align
        labxx: }

; формат заголовка имени (подробнее см. _sHeader)
macro def string,cfa,flg
       { dd latest
         latest=$-CELL
         addr cfa
         db flg
         common local .count, .body
         .count scnt ?
         .body db string,0
        store $-.body-1 at .count
        }

; перемещение указателей стеков
macro dheave val { lea tad , [tad+val] }
macro aheave val { lea taa , [taa+val] }
macro rheave val { lea tar , [tar+val] }

macro rpop reg
       { pop reg }
macro rpush reg
       { push reg }

macro dpush reg
       { dheave -CELL
         mov [tad], tos
         if reg eq tos
          else
            mov tos, reg
         end if }

macro dpop reg
       { mov reg, [tad]
         lea tad, [tad+CELL] }

macro apush reg
       { aheave -CELL
         mov [taa], toa
         if reg eq toa   ; если dup, то не надо mov r,r
          else
            mov toa, reg
         end if }

macro apop reg
       { mov reg, [taa]
         lea taa, [taa+ADDR] }

macro dlit val
       { call _dlit
         cell val }
macro alit val
       { call _alit
         addr val }
macro rlit val { push val }

allot equ rb

; macro mIF ; как написать макро для компиляции перехода вперед?

macro align
      { repeat (($+CELL-1)and -CELL)-$
          nop
        end repeat }

macro VARIABLE deffname
      { label deffname
        call _avariable
        allot ADDR
        align }

macro CREATE defname
      { label defname
        call _create }

macro fcode [words]
        { call words }

macro exit
      { ret
        align }

macro ERROR [msg]
      { slit msg
        call _count
        call _error }

macro MESSAGE [string]
      { slit string
        call _print
        call _cr }

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

section '.fvm' code executable readable writeable

;
_dup:   ;( d: n --> d: n n )
        dpush tos
;
_noop:  ;( --> )
        exit
;
_drop:  ;( d: n --> )
        dpop tos
        exit
;
_swap:  ;( d: a b --> d: b a )
        mov temp, [tad]
        mov [tad], tos
        mov tos, temp
        exit
;
_over:  ;( d: a b --> d: a b a )
        mov temp, [tad]
        dpush temp
        exit
;
_plus:  ;( d: a b --> d: a+b )
        add tos, [tad]
        dheave CELL
        exit
;
_minus: ;( d: a b --> d: a-b )
        sub tos, [tad]
        dheave CELL
        exit
;
_mul: ;( d: a b --> d: a-b )
        mul dword [tad]
        dheave CELL
        exit
;
_xor:   ;( d: a b --> d: n )
        xor tos, [tad]
        dheave CELL
        exit
;
_and:   ;( d: a b --> d: n )
        and tos, [tad]
        dheave CELL
        exit
;
_or:    ;( d: a b --> d: n )
        or tos, [tad]
        dheave CELL
        exit
;
_abs:   ;( d: n --> d: u )
        mov temp , tos
        sar temp , 31
        add tos , temp
        xor tos , temp
        exit
;
_moddiv: ;( d: n n --> d: n n )
        mov cnt, tos
        xor temp, temp
        mov tos, [tad]
        div cnt
        mov [tad], EDX
        exit
;
_dlit:  ;( --> d: n )
        pop temp
        dpush [temp]
        lea temp, [temp+CELL]
        jmp temp
        align
;
_adup:  ;( a: addr --> addr addr )
        apush toa
        exit
;
_alit:  ;( --> a: addr )
        pop temp
        apush toa
        mov toa, [temp]
        lea temp, [temp+CELL]
        jmp temp
        align
;
_rlit:  ;( --> r: addr )
        rpop temp
        rpush dword [temp]
        lea temp, [temp+ADDR]
        jmp temp
        align
;
_qnil:  ;( a: addr --> a: addr d: flag )
        dpush tos
        mov tos, toa
        sub tos, 1
        sbb tos, tos
        exit
;
_aadd: ;( a: addr d: u --> a: addr+u )
        lea toa, [toa+tos]
        dpop tos
        exit
;
_create: ;( --> a: addr )
_avariable: ;( --> a: addr )
        apush toa
        pop toa
        exit
;
_Astore: ;( a: addr addr --> )
        apop temp
        mov dword [toa], temp
        apop toa
        exit
;
_Afetch: ;( a: addr --> a: addr )
        mov toa, dword [toa]
        exit
;
_store: ;( a: addr d: n --> )
        mov dword [toa], tos
        dpop tos
        apop toa
        exit
;
_fetch: ;( a: addr --> d: n )
        dpush tos
        mov tos, dword [toa]
        apop toa
        exit
;
_execute: ;( a: xt --> )
        mov temp, toa
        apop toa
        call temp
        exit
;
_branch: ;( --> )
        rpop temp
        jmp dword [temp]
        align
;
_0branch: ;( d: flag --> d: flag ) без удаления флагового значения
        rpop temp
        or tos,tos
        jz lab00
        lea temp, [temp+REF]
        jmp temp
lab00: jmp dword [temp]
        align
;
_d2r:   ;( d: n --> r: n )
        rpop temp
        rpush tos
        dpop tos
        jmp temp
        align
;
_RPfetch: ;( --> a: addr )
        apush tar
        exit
;
_APfetch: ;( --> a: addr )
        apush taa
        exit
;
_SPfetch: ;( --> a: addr )
        apush tad
        exit
;
_RPstore: ;( a: addr --> )
        rpop temp
        mov tar, toa
        apop toa
        jmp temp
;
_APstore: ;( a: addr --> )
        mov taa, toa
        apop toa
        exit
;
_SPstore: ;( a: addr --> )
        mov tad, toa
        apop toa
        exit
;
_a2r: ;( a: addr --> r: addr )
        rpop temp
        rpush toa
        apop toa
        jmp temp
        align
;
_rdrop: ;( r: addr --> )
        rpop temp
        rheave -CELL
        jmp temp
        align
;
_off:   ;( a: addr --> )
        mov dword [toa], 0
        apop toa
        exit
;
_count: ;( a: addr --> a: addr d: # )
        dpush tos
        and tos, tos
        mov AL, [toa]
        lea toa, [toa+SCNT]
        exit
;
_Aswap: ;( a: a1 a2 --> a2 a1 )
        xchg toa, dword [taa]
        exit
;
_r2a: ;( r: addr --> a: addr )
      rpop temp
      apush toa
      rpop toa
      jmp temp
;
_adrop: ;( a: addr --> )
      apop toa
      exit
; удалить адресную ссылку, находящуюся под вершиной стека адресов
_anip: ;( a: a1 a2 --> a: a2 )
      aheave ADDR
      exit
; извлечь байт данных из памяти по адресу,
; хранимому на вершине стека адресов, на вершину стека данных
_bfetch: ;( a: addr --> d: byte )
      dpush tos
      movzx tos, byte [toa]
      apop toa
      exit
; сохранить байт данных с вершины стека данных по адресу,
; хранимому на вершине стека адресов
_bstore: ;( a: addr d: byte --> )
      mov byte [toa], AL ; tos
      dpop tos
      apop toa
      exit
; переслылка указанного количества # минимально адресуемых единиц
; c адреса src в пространства начинающегося с адреса dst
_cmove: ;( d: # a: src dst --> )
       mov cnt, tos
       apop temp
       jcxz lab31
lab30: mov AL, byte [temp]
        mov byte [toa], AL
       lea temp, [temp+1]
       add toa, 1
       loop lab30
lab31: apop toa
       dpop tos
       exit

; переменная last хранит адрес последнего слова в цепочке имен
_last: call _create
       dd LATEST ; LATEST определен в конце списка имен
align
;
VARIABLE _latest
;
_MAIN: call _create
       dd _abort ; главное слово системы
align
;
_DP: call _create
       dd _there ; указатель на первый свободный байт системы
align
;
_NDP: call _create
       dd NSADDR ; указатель на первый свободный байт в пространстве имен
align

VARIABLE _S0 ; переменная для хранения дна стека данных
VARIABLE _A0 ;                                   адресов
VARIABLE _R0 ;                                   возвратов

; входной буфер системы
CREATE _tib
       allot TIB_size
       align
; буфер для форматного преобразования строк
CREATE _pad
       allot PAD_size
       align

VARIABLE _STATE ; текущий режим работы системы: компиляция\интерпретация
VARIABLE _BASE  ; текущая система счисления системы

VARIABLE _CURRENT ; хранит адрес хвоста списка добавляемых слов
VARIABLE _CONTEXT ; хранит адрес хвоста списка искомых слов

VARIABLE _TIBsize ; количество байт в tib
VARIABLE _IN      ; текущая позиция трансляции текста

VARIABLE _STDIN  ;
VARIABLE _STDOUT ;
VARIABLE _STDERR ;

VARIABLE _WARNING
VARIABLE _HLD

;
CREATE _NewLine
       fstr 0x0d,0x0a
       align

;-------------------------------------------------------------------------------
_cell: ;( --> d: cell# )
       dpush CELL
       exit
_addr: ;( --> d: addr# )
       dpush ADDR
       exit
_token: ;( --> d: token# )
       dpush TOKEN
       exit
_scnt: ;( --> d: scnt# )
       dpush SCNT
       exit
_ref: ;( --> d: ref# )
       dpush REF
       exit
;
_son: ;( --> )
      mov dword [_STATE+TOKEN], -1
      exit
;
_soff: ;( --> )
      mov dword [_STATE+TOKEN], 0
      exit
;
_here: ;( --> a: addr )
       apush dword [_DP+TOKEN]
       exit
;
_nhere: ;( --> a: addr )
       apush dword [_NDP+TOKEN]
       exit
; аналог ALLOT
_reserve: ;( d: u --> a: addr )
       apush toa
       MOV toa, dword [_DP+TOKEN]
       LEA tos, [tos+toa]
       MOV dword [_DP+TOKEN], tos
       dpop tos
       exit
;
_atod: ;( a: xt --> d: disp )
       dpush tos
       mov tos, dword [_DP+TOKEN]
       sub tos, toa
       apop toa
       exit
;
_cbyte: ;( d: byte --> )
       MOV temp, [_DP+TOKEN]
       INC dword [_DP+TOKEN]
       MOV byte [temp], AL ; tos
       dpop tos
       exit
;
_cref: ;( d: ref --> )
       mov temp, [_DP+TOKEN]
       add dword [_DP+TOKEN], REF
       mov dword [temp], tos
       dpop tos
       exit
;
_dcomp: ;( d: n --> )
       mov temp, [_DP+TOKEN]
       add dword [_DP+TOKEN], CELL
       mov dword [temp], tos
       dpop tos
       exit
;
_acomp: ;( a: addr --> )
       MOV temp, dword [_DP+TOKEN]
       ADD dword [_DP+TOKEN], ADDR
       MOV dword [temp], toa
       apop toa
       exit
; NA,
_nacomp: ;( a: addr --> )
       mov temp, dword [_NDP+TOKEN]
       add dword [_NDP+TOKEN], ADDR
       mov dword [temp], toa
       apop toa
       exit
; NB,
_nbcomp: ;( d: byte --> )
       mov temp, dword [_NDP+TOKEN]
       inc dword [_NDP+TOKEN]
       mov byte [temp], AL
       dpop tos
       exit
;
_nccomp: ;( d: n --> )
       mov temp, dword [_NDP+TOKEN]
       add dword [_NDP+TOKEN], CELL
       mov dword [temp], tos
       dpop tos
       exit
;
_ctoken: ;( a: xt --> )
       dpush 0xE8
       call _cbyte
       call _atod
       call _cref
       exit
;
_cexit: ;( --> )
       dpush 0xC3
       call _cbyte
       exit
; NS, компиляция строки в пространство имен
_cns: ;( a: asc d: # --> )
       apush toa
       mov toa, [_NDP+TOKEN]
       add dword [_NDP+TOKEN], tos
       call _cmove
       exit
; компиляция строки со счетчиком в пространство имен
_cnstr: ;( a: addr d: # --> )
       dpush tos
       call _nbcomp
       call _cns
       dpush 0
       call _nbcomp
       exit
;
_cs: ;( a: asc d: # --> )
       apush toa
       mov toa, [_DP+TOKEN]
       add dword [_DP+TOKEN], tos
       call _cmove
       exit
;
_cstr: ;( a: addr d: # --> )
       dpush tos
       call _cbyte
       call _cs
       dpush 0
       call _cbyte
       exit
;-------------------------------------------------------------------------------
; <#
_lbdiez: ;( --> )
       lea temp, [_pad+TOKEN+TIB_size-1]
       mov dword [_HLD+TOKEN], temp
       mov byte [temp], 0
       exit
; #>
_diezrb: ;( d: x --> a: addr d: # )
       apush toa
       mov toa, [_HLD+TOKEN]
       lea tos, [_pad+TOKEN+TIB_size-1]
       sub tos, toa
       exit
;
_hold: ;( d: char --> )
       dec dword [_HLD+TOKEN]
       mov temp, [_HLD+TOKEN]
       mov [temp], AL
       dpop tos
       exit
;
_sign: ;( --> )
       dpush 0x2D
       call _hold
       exit
; >DIGIT
_digit: ;( d: u --> d: char )
       cmp tos, 0x0A
       js lab15
       lea tos, [tos+7]
lab15: lea tos, [tos+0x30]
       exit
; в отличие от стандартного форта, числа одинарной длины
_diez: ;( d: u --> d: u )
       xor edx,edx
       idiv dword [_BASE+TOKEN]
       dpush temp
       call _digit
       call _hold
       exit
; #S в отличие от стандартного форта число одинарной длины
_sdiez: ;( d: u --> d: 0 )
lab16: or tos, tos
       jz lab17
       call _diez
       jmp lab16
lab17: exit
;
_unum: ;( d: u --> a: addr d: # )
       call _lbdiez
       call _sdiez
       call _diezrb
       exit
;
_snumt: ;( d: u --> )
       call _unum
       call _type
       exit
;-------------------------------------------------------------------------------
;
_2cipher: ;( d: char --> d: u )
       cmp tos, 0x3A
       js lab20
       cmp tos, 0x5B
       js lab21
       lea tos, [tos-87]
       exit
lab21: lea tos, [tos-55]
       exit
lab20: lea tos, [tos-48]
       exit
;
_val: ;( a: addr d: # --> d: ?? )
       mov cnt, tos
       xor tos, tos
       jcxz lab23
       cmp byte [toa], 0x2D ; ? -
       pushf
       jnz lab22 ; число положительное
       lea toa, [toa+1]
       sub cnt, 1
       jnz lab22
lab23: ERROR 'Must be number!'
       align
lab22: imul dword [_BASE+TOKEN]
       rpush tos
       movzx tos, byte [toa]
       call _2cipher
       cmp tos, dword [_BASE+TOKEN]
       jns lab23
       add tos, dword [tar]
       lea tar, [tar+CELL]
       inc toa
       loop lab22
       apop toa
       popf
       jnz lab24
       neg tos
lab24: exit
;-------------------------------------------------------------------------------
;
_clit: ;( d: n --> )
       apush _dlit
       call _ctoken
       call _dcomp
       exit
;
_calit: ;( a: addr --> )
       apush _alit
       call _ctoken
       call _acomp
       exit
;
_literal: ;( d: n --> | n )
       cmp dword [_STATE+TOKEN], 0
       jz lab25
       call _clit
lab25: exit
;
_dnum:  ;( / decimal --> d: n )
       call _NextToken
       call _val
       call _literal
       exit
;
_aliteral: ;( a: addr --> a: addr | )
       cmp dword [_STATE+TOKEN], 0
       jz lab26
       call _calit
lab26: exit
;
_anum: ;( / hex --> a: addr )
       call _NextToken
       rpush dword [_BASE+TOKEN]
       mov dword [_BASE+TOKEN], 0x10
       call _val
       apush toa
       mov toa, tos
       dpop tos
       rpop dword [_BASE+TOKEN]
       call _aliteral
       exit
;-------------------------------------------------------------------------------
; завершить последнее определение
_ecreate: ;( --> )
       mov cnt, dword [_latest+TOKEN] ;
       jcxz lab40
       mov temp, dword [_last+TOKEN]
       mov dword [cnt], temp
       mov dword [_last+TOKEN], cnt   ; сохранить LATEST в LAST
       mov dword [_latest+TOKEN], 0
lab40: exit
;
_round: ;( a: addr d: # --> )
        XOR EDX, EDX
        mov cnt, tos
        lea tos, [toa+tos-1]
        idiv cnt
        imul cnt
        mov toa, tos
        dpop tos
        exit
;
_align: ;( --> )
       call _here
       call _cell
       call _round
       mov dword [_DP+TOKEN], toa
       apop toa
       exit
;
_nalign: ;( --> )
       call _nhere
       call _cell
       call _round
       mov dword [_NDP+TOKEN], toa
       apop toa
       exit

; формат заголовка:
; addr[] off_back
; addr[] off_code
; byte[] off_attr
; scnt[] off_name#
; ...    тут само имя
; byte[] off_zerobyte \ завершающий нулевой байт
; создать новый заголовок слова
_sHeader: ;( a: addr d: # --> )
       call _ecreate ; завершить предыдущее определение
       call _nalign
       mov temp, dword [_NDP+TOKEN]
       mov dword [_latest+TOKEN], temp
       apush 0       ; тут в последствии будет ссылка на предыдущее определение
       call _nacomp  ; а в начале хранится нуль
       call _align
       apush dword [_DP+TOKEN]
       call _nacomp ; ссылка на код
       dpush 0
       call _nbcomp ; тут будет лежать флаг
       call _cnstr
       exit
; создание нового определения
_new: ;( / name --> )
       call _NextToken ; NextToken
       call _sHeader   ; SHEADER
       call _son       ; ]
       exit
; завершение создания определения ';'
_fin: ;( --> )
       call _qcomp     ; ?COMP
       call _cexit     ; COMPILE EXIT
       call _soff      ; [
       exit
;
_created: ;( asc # --> )
       call _ecreate   ; ;CREATE
       call _sHeader   ; SHEADER
       dpush _create   ; ['] (CREATE)
       call _ctoken    ; TOKEN,
       exit
;
_create_: ;( / name --> )
       call _NextToken ; NextToken
       call _created   ; CREATED
       exit
;
_variable: ;( / name --> )
       call _create_   ; CREATE
       apush 0         ; a: 0
       call _acomp     ; A,
       exit
;-------------------------------------------------------------------------------
;
_query: ;( --> )
       pushad
       rlit 0
       rpush _TIBsize+TOKEN
       rlit TIB_size
       rpush _tib+TOKEN
       rpush dword [_STDIN+TOKEN]
       call [ReadFile]
       popad
       mov dword [_IN+TOKEN], 0
       exit
;
_type: ;( d: addr d: # --> # )
       pushad
       lea temp, [tad+CELL]
       mov ebp, esp ; чтобы вызываемая ф-ция могла убрать параметры
       rlit 0 ; overlap
       rpush temp
       rpush tos
       rpush toa
       rpush dword [_STDOUT+TOKEN]
       call [WriteFile]
       popad
       apop toa ; удаляются ненужные параметры со стека адресов
       dpop tos ; и данных
       exit
;
_box: ;( --> a: addr )  ...][call][addr][data][align]addr:[...
       apush toa
       rpop temp
       lea toa, [temp+ADDR]
       mov temp, [temp]
       jmp temp
       align
;
_print: ;( a: addr --> )
        fcode _count, _type
       exit
;
_cr: ;( --> )
      call _NewLine
      call _print
      exit
;
_prompt: ;( --> )
       cmp dword [_STATE+TOKEN], -1
       jz lab10
       slit '>'
       call _print
       exit
lab10: slit ']'
       call _print
       exit
;
_ok:   ;( --> )
       cmp dword [_STATE+TOKEN], -1
       jz lab11
       slit ' Ok'
       call _print
       call _cr
lab11: exit
;
_qStack: ;( --> )
       cmp dword [_S0+TOKEN], tad
       jb lab04
       cmp dword [_A0+TOKEN], taa
       jb lab05
       exit
lab04: ERROR 'Data stack underflow'
lab05: ERROR 'Address stack underflow'
       align
;
_ViewPoint: ;( --> a: addr )
       apush toa
       mov toa, dword[_IN]
       lea toa, [toa+_tib+TOKEN]
       exit
;
_SkipDelim: ;( --> a: addr )
       mov temp, dword [_IN+TOKEN]
       cmp temp, dword [_TIBsize+TOKEN]
       jns lab02 ; если достигнут последний байт в tib
       movzx temp , byte [temp+_tib+TOKEN]
       cmp temp, 0x21
       jns lab02 ; если встречен первый непробельный символ
       inc dword [_IN+TOKEN]
       jmp _SkipDelim ; повторять, пока пробельные символы
lab02: apush toa
       mov toa, [_IN+TOKEN]
       lea toa, [toa+_tib+TOKEN]
       exit
;
_SkipUpTo: ;( d: char --> a: addr )
       mov temp, dword [_IN+TOKEN]
       cmp temp, dword [_TIBsize+TOKEN]
       jns lab03 ; если достигнут последний байт в tib
       movzx temp, byte [temp+_tib+TOKEN]
       cmp temp, tos
       jle lab03 ; если встречен первый непробельный символ
       inc dword [_IN+TOKEN]
       jmp _SkipUpTo ; повторять, пока пробельные символы
lab03: dpop tos
       apush toa
       mov toa, [_IN+TOKEN]
       lea toa, [toa+_tib+TOKEN]
       exit
;
_range: ;( a: a1 a2 --> d: # )
       dpush tos
       mov tos, dword [taa]
       sub tos, toa
       neg tos
       apop toa
       apop toa
       exit
;
_NextToken: ;( --> a: addr d: # )
       call _SkipDelim
       call _adup
       dlit 0x20
       call _SkipUpTo
       call _range
       exit
;
_char: ;( a: addr d: # --> d: char )
       call _NextToken
       movzx tos, byte [toa]
       apop toa
       exit
;
_error: ;( a: asc d: # --> )
       call _type
       call _cr
       jmp _abort
;
;-------------------------------------------------------------------------------
;
_quest: ;( a: addr d: # --> a: lfa | nil )
       rpush taa
       mov taa, dword [_last+TOKEN]
lab0A: or taa, taa
       jz lab09 ; если в списке не осталось слов
       ; toa = sample  tos = #  taa = exsample
       cmp AL, byte [taa+ADDR+CELL+SCNT]
       jnz lab0B ; если длины не равны
       mov cnt, tos
lab0C: ; cmp byte [temp+cnt+ADDR+CELL+1],
       mov DL, byte [taa+cnt+ADDR+CELL+SCNT]
       cmp DL, byte [toa+cnt-1]
       jnz lab0B
       dec cnt
       jnz lab0C ; проверка до последнего символа
lab09: mov toa, taa
       rpop taa
       dpop tos
       exit
lab0B: mov taa, [taa] ; на предыдущее слово
       jmp lab0A
align
;
_tick: ;( / name --> a: xt )
       call _NextToken
       call _quest
       or toa, toa
       jnz lab12
       ERROR 'Cannot find name!'
lab12: mov toa, [toa+ADDR]
       exit
;
_qcomp: ;( --> )
       MOV cnt, [_STATE+TOKEN]
       JCXZ lab13
       exit
lab13: ERROR 'For compile mode only!'
align
;
_unique: ;( a: addr d: # --> )
       apush toa
       dpush tos
       call _quest
       or toa, toa
       jnz lab14
       apop toa
       exit
lab14: MESSAGE 'Name not unique!'
align
;
_regular: ;( a: xt --> )
       cmp dword [_STATE+TOKEN], 0
       jz lab08
       call _ctoken
       exit
lab08: call _execute
       exit
;
_xtimm: ;( a: lfa --> a: xt d: flag )
       dpush tos
       movsx tos, byte [toa+ADDR+ADDR]
       mov toa, [toa+ADDR]
       exit
;
_EvalToken: ;( a: asc d: # --> )
       call _quest  ; a: lfa
       or toa, toa  ; если не найдено, в toa хранится nil
       jnz lab06
       ERROR 'Name not found!'
lab06:
       call _xtimm ;( a: lfa --> a: lfa d: flag )
       or tos, tos ;
       jz lab07
       dpop tos
       call _execute
       exit
lab07: dpop tos
       call _regular
       exit
;
_interpret: ;( --> )
       call _NextToken ; a: a d: #
       or tos, tos
       jz lab01
       call _EvalToken
       call _qStack
       jmp _interpret
lab01:
       apop toa
       dpop tos
       exit
;
_title: ;( --> )
       MESSAGE 'tri-stack forth engine.'
       MESSAGE 'Copyright 2010 mOleg'
       MESSAGE 'mail to mOlegg@ya.ru'
       exit
;
_abort: ; переход на abort выполняется в случае ошибки
       mov tar, dword [_R0+TOKEN]
       mov taa, dword [_A0+TOKEN]
       mov tad, dword [_S0+TOKEN]
       mov dword [_STATE+TOKEN], 0
       mov dword [_BASE+TOKEN], 0x0A ; десятичная система счисления
       mov dword [_IN+TOKEN], 0
       mov dword [_WARNING+TOKEN], -1 ; включить режим предупреждений
       mov dword [_latest+TOKEN], 0  ; чтобы небыло рецидивов с ;CREATE
_quit:  ; основной цикл системы
       fcode _prompt, _query, _interpret, _ok
       jmp _quit
       align
;
_initmem: ; выделение места под стеки
        rpop temp
        lea taa, [tar-aStack]
        lea tad, [tar-aStack-dStack]
        lea tar, [tar-aStack-dStack-rStack]
        rpush temp
        ; сохранение указателей на дно каждого из стеков
        fcode _SPfetch, _S0, _Astore,\
              _RPfetch, _R0, _Astore,\
              _APfetch, _A0, _Astore
        exit
;
_ioinit: ;( --> )
         rlit -10            ; параметры функций сразу выкладываем на стек возвратов
         dpush tos           ; значение возвращается в EAX, который tos
         call [GetStdHandle] ; GetStdHandle адресная метка, по которой хранится адрес перехода
         call _STDIN
         call _store
         rlit -11
         dpush tos
         call [GetStdHandle]
         call _STDOUT
         call _store
         rlit -12
         dpush tos
         call [GetStdHandle]
         call _STDERR
         call _store
        exit
; инициализация системы
_cold:
   fcode _initmem, _ioinit, _title, _MAIN, _Afetch, _execute
_bye:  ;( --> )
        rlit 0     ; без ошибки
_halt: ;( err --> )
        call [ExitProcess]
        align

_int: int3
      exit
;
_limit: ; последнее слово форт-системы
        call _create
_there:
allot CodeSpace-($-$$)

; ------------------------------------------------------------------------------
section '.names' data readable writeable

;   Имя          Метка      Флаг
def 'NOOP',      _noop,      0
def 'DUP',       _dup,       0
def 'DROP',      _drop,      0
def 'SWAP',      _swap,      0
def 'OVER',      _over,      0
def '+',         _plus,      0
def '-',         _minus,     0
def '*',         _mul,       0
def 'MOD/',      _moddiv,    0
def 'XOR',       _xor,       0
def 'AND',       _and,       0
def 'OR',        _or,        0
def 'ABS',       _abs,       0
def '(DLIT)',    _dlit,      0
def 'ADUP',      _adup,      0
def '(ALIT)',    _alit,      0
def '(RLIT)',    _rlit,      0
def '?NIL',      _qnil,      0
def 'A+',        _aadd,      0
def '(CREATE)',  _create,    0
def 'A!',        _Astore,    0
def 'A@',        _Afetch,    0
def '!',         _store,     0
def '@',         _fetch,     0
def 'EXECUTE',   _execute,   0
def 'BRANCH',    _branch,    0
def '?BRANCH',   _0branch,   0
def 'D>R',       _d2r,       0
def 'RP@',       _RPfetch,   0
def 'SP@',       _SPfetch,   0
def 'AP@',       _APfetch,   0
def 'RP!',       _RPstore,   0
def 'AP!',       _APstore,   0
def 'SP!',       _SPstore,   0
def 'A>R',       _a2r,       0
def 'RDROP',     _rdrop,     0
def 'OFF',       _off,       0
def 'COUNT',     _count,     0
def 'ASWAP',     _Aswap,     0
def 'R>A',       _r2a,       0
def 'ADROP',     _adrop,     0
def 'ANIP',      _anip,      0
def 'B@',        _bfetch,    0
def 'B!',        _bstore,    0
def 'CMOVE',     _cmove,     0
def 'LAST',      _last,      0
def 'MAIN',      _MAIN,      0
def 'HERE',      _DP,        0
def 'NHERE',     _NDP,       0
def 'S0',        _S0,        0
def 'A0',        _A0,        0
def 'R0',        _R0,        0
def 'TIB',       _tib,       0
def 'PAD',       _pad,       0
def 'STATE',     _STATE,     0
def 'BASE',      _BASE,      0
def 'CURRENT',   _CURRENT,   0
def 'CONTEXT',   _CONTEXT,   0
def 'TIB#',      _TIBsize,   0
def 'IN',        _IN,        0
def 'STDIN',     _STDIN,     0
def 'STDOUT',    _STDOUT,    0
def 'STDERR',    _STDERR,    0
def 'NewLine',   _NewLine,   0
def 'QUERY',     _query,     0
def 'TYPE',      _type,      0
def '(BOX)',     _box,       0
def 'PRINT',     _print,     0
def 'CR',        _cr,        0
def 'PROMPT',    _prompt,    0
def 'OK',        _ok,        0
def '?STACK',    _qStack,    0
def 'ViewPoint', _ViewPoint, 0
def 'SkipDelim', _SkipDelim, 0
def 'SkipUpTo',  _SkipUpTo,  0
def 'RANGE',     _range,     0
def 'NextToken', _NextToken, 0
def 'ERROR',     _error,     0
def 'QUEST',     _quest,     0
def 'REGULAR',   _regular,   0
def 'XTIMM',     _xtimm,     0
def 'EvalToken', _EvalToken, 0
def 'INTERPRET', _interpret, 0
def 'TITLE',     _title,     0
def 'ABORT',     _abort,     0
def 'QUIT',      _quit,      0
def 'BYE',       _bye,       0
def 'HALT',      _halt,      0
def 'RESERVE',   _reserve,   0
def 'CELL',      _cell,      0
def 'ADDR',      _addr,      0
def 'TOKEN',     _token,     0
def 'RET,',      _cexit,     0
def 'SCNT',      _scnt,      0
def 'REF',       _ref,       0
def 'HERE',      _here,      0
def 'NHERE',     _nhere,     0
def 'ATOD',      _atod,      0
def 'B,',        _cbyte,     0
def 'REF,',      _cref,      0
def ',',         _dcomp,     0
def 'A,',        _acomp,     0
def 'NA,',       _nacomp,    0
def 'NB,',       _nbcomp,    0
def 'N,',        _nccomp,    0
def 'NS,',       _cns,       0
def 'NSTR,',     _cnstr,     0
def 'S,',        _cs,        0
def 'STR,',      _cstr,      0
def 'ALIT,',     _calit,     0
def '[',         _soff,      1
def ']',         _son,       0
def "'",         _tick,      0
def '?COMP',     _qcomp,     0
def 'WARNING',   _WARNING,   0
def '?UNIQUE',   _unique,    0
def 'TOKEN,',    _ctoken,    0
def '<#',        _lbdiez,    0
def '#>',        _diezrb,    0
def 'HOLD',      _hold,      0
def '>DIGIT',    _digit,     0
def '#',         _diez,      0
def 'S#',        _sdiez,     0
def '(U)',       _unum,      0
def 'U.',        _snumt,     0
def 'SIGN',      _sign,      0
def 'CHAR',      _char,      0
def '>CIPHER',   _2cipher,   0
def 'sval',      _val,       0
def 'd:',        _dnum,      1
def 'a:',        _anum,      1
def ':',         _new,       0
def ';',         _fin,       1
def 'SHEADER',   _sHeader,   0
def 'LATEST',    _latest,    0
def 'LIT,',      _clit,      0
def 'LITERAL',   _literal,   0
def ';CREATE',   _ecreate,   0
def 'CREATED',   _created,   0
def 'CREATE',    _create_,   0
def 'VARIABLE',  _variable,  0
def 'ROUND',     _round,     0
def 'ALIGN',     _align,     0

def 'int',       _int,       0

LATEST: ; чтобы получить хвост цепочки имен
def 'LIMIT',_limit,0
NSADDR:

allot NamesSpace-($-$$) ;


_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Пт фев 23, 2018 11:31 
Не в сети

Зарегистрирован: Пт янв 06, 2017 14:57
Сообщения: 359
Благодарил (а): 16 раз.
Поблагодарили: 1 раз.
Нашкрябал описание слов:
Цитата:
namespace - пространство имён.
[codeonly] - слова есть только в кодофайле.
"Последуйщий(ие)" данные/адрес - всё то, что идют при компиляции за
вызовом соответствующего слова.
"Следующего слова" (из входного потока).
(выполнив преобразование) - необязательно, зависит от архитектуры
(есть кеш) - напоминание о кешах стека данных и стека адресов
(? использование в системе ?) - возможно ненужные или слова,
ещё не использованные в определениях этого релиза.
СС - Система Счисления

NOOP ( --> )
\ Нет операции.

DUP ( d: x --> x x )
\ Дублировать x на стеке данных.

DROP ( d: x --> )
\ Удалить x со стека данных.

SWAP ( d: a b --> b a )
\ Поменять местами два верхних элемента стека данных.

OVER ( d: a b --> a b a )
\ Поместить копию a на вершину стека данных.

+ ( d: a b --> a+b )
\ Прибавить к a число b.

- ( d: a b --> a-b )
\ Вычесть из a число b.

* ( d: a b --> a*b )
\ Умножить a на число b.

MOD/ ( d: a b --> a%b a/b )
\ a%b a/b - остаток и целое от деления a на b.

XOR ( d: a b --> n )
\ n - поразрядное исключающее или над a и b.

AND ( d: a b --> n )
\ n - поразрядное логическое "и" над a и b.

OR ( d: a b --> n )
\ n - поразрядное логическое "или" над a и b.

ABS ( d: n --> u )
\ Возвратить модуль числа.

(dlit) ( \\ --> d: n )
\ Исполнение: поместить последующий n на стек данных.

ADUP ( a: addr --> addr addr )
\ Дублировать addr на стеке адресов.

(alit) ( \\ --> a: addr )
\ Исполнение: поместить последующий addr на стек адресов.

(rlit) ( \\ --> r: addr )
\ Исполнение: поместить последующий addr на стек возвратов.

?NIL ( a: addr --> a: addr d: flag )
\ Проверить, является ли выражние "addr==0" истнным, не забирая addr со стека.
\ Результат поместить на стек данных.

A+ ( a: addr d: u --> a: addr+u )
\ Прибавить смещение u к адресу addr.

(CREATE) ( \\ --> a: addr )
\ Исполнение: Поместить адрес последующих данных на стек адресов.

A! ( a: addr1 addr2 --> )
\ Запомнить адрес addr1 по адресу addr2.

A@ ( a: addr --> addr1 )
\ Взять адрес addr1 по адресу addr.

! ( a: addr d: n --> )
\ Запомнить число n по адресу addr.

@ ( a: addr --> d: x )
\ Взять число x по адресу addr.

EXECUTE ( a: xt --> )
\ Исполнить xt.

BRANCH ( \\ r: retaddr --> )
\ Перейти к интерпретации последующего адреса.

?BRANCH ( \\ d: flag r: retaddr --> d: flag r: ? )
\ Перейти к интерпретации последующего адреса, если "flag==0".
\ Флаг при этом не удалять.

D>R ( d: n --> r: n )
\ Поместить n со стека данных на стек возвратов (выполнив преобразование).


SP@ ( --> a: addr )
\ Поместить указатель вершины стека данных на стек адресов (есть кеш).

RP@ ( --> a: addr )
\ Поместить указатель вершины стека возвратов на стек адресов (есть кеш).

AP@ ( --> a: addr )
\ Поместить указатель вершины стека адресов на стек адресов.

SP! ( a: addr --> )
\ Присвоить значение addr указателю вершины стека данных.

RP! ( a: addr --> )
\ Присвоить значение addr указателю вершины стека возвратов.

AP! ( a: addr --> )
\ Присвоить значение addr указателю вершины стека адресов.


A>R ( a: addr --> r: addr )
\ Поместить addr со стека адресов на стек возвратов (выполнив преобразование).

RDROP ( r: addr --> )
\ Удалить addr со стека возвратов.

OFF ( a: addr --> )
\ Удалить addr со стека адресов.

COUNT ( a: addr --> a: newaddr d: # )
\ Преобразовать строку со счетчиком в адрес/длину.

ASWAP ( a: a1 a2 --> a2 a1 )
\ Поменять местами два верхних элемента стека адресов.

R>A ( r: addr --> a: addr)
\ Поместить addr со стека возвратов на стек адресов (выполнив преобразование).

ADROP ( a: addr --> )
\ Удалить addr со стека адресов.

ANIP ( a: a1 a2 --> a2 )
\ Удалить второй элемент стека.

B@ ( a: addr --> d: byte )
\ Взять байт по адресу addr.

B! ( a: addr d: byte --> )
\ Напомнить байт по адресу addr.

CMOVE ( d: # a: src dst --> )
\ Копировать блок размера # по адресу src в место по адресу dst.

CREATE LAST
\ Указатель на последнее слово в цепочке имён.

CREATE MAIN
\ Указатель на слово, с которого стартует система.

CREATE HERE
\ Указатель на первый свободный байт в кодофайле.

CREATE NHERE
\ Указатель на первый свободный байт в namespace.


VARIABLE S0
\ Нижняя граница стека данных.

VARIABLE R0
\ Нижняя граница стека возвратов.

VARIABLE A0
\ Нижняя граница стека адресов.


CREATE TIB
\ Входной буфер системы [0x50].

CREATE PAD
\ Буфер для форматного преобразования строк [0x50].

VARIABLE STATE
\ Текущий режим работы системы: компиляция\интерпретация.

VARIABLE BASE
\ Текущая система счисления системы.

VARIABLE CURRENT
\ Хранит адрес хвоста списка добавляемых слов.
\ (? использование в системе ?)

VARIABLE CONTEXT
\ Хранит адрес хвоста списка искомых слов.
\ (? использование в системе ?)

VARIABLE TIB#
\ Количество прочитанных байт в tib.

VARIABLE IN
\ Текущая позиция трансляции текста.

VARIABLE STDIN
\ Хэндл стандартного устройства ввода.

VARIABLE STDOUT
\ Хэндл стандартного устройства вывода.

VARIABLE STDERR
\ Хэндл стандартного устройства вывода ошибок.

CREATE NewLine
\ Буфер под 0x0A0D - формат конца строк.

\ VARIABLE HLD \ [codeonly]

QUERY ( --> )
\ F94:
\ Делает пользовательское устройство ввода данных входным источником.
\ Получает ввод в буфер ввода терминала, заменяя любое предыдущее
\ содержимое. Делает результат, чей адрес возвращается TIB, входным
\ буфером. Установить >IN в ноль.

TYPE ( a: addr d: # --> )
\ Вывести строку через стандартное устройство вывода.

(BOX) ( \\ --> a: addr )

Код:
\ ...][call][addr][data][align]addr:[...
\     \__________BOX__________/
Цитата:
\ Обойти данные в коде, начинающиеся со следующей ячейки,
\ вернуть адрес начала данных.

PRINT ( a: addr --> )
\ Вывести строку по адресу addr.

CR ( --> )
\ Перейти на новую строку или вывести NewLine системы.

PROMPT ( --> )
\ Приглашение к вводу.

OK ( --> )
\ Состояние системы (OK или нет).

?STACK ( --> )
\ Проверка нижней границы стека данных и стека адресов,

ViewPoint ( --> a: addr )
\ Возвращает адрес просматриваемого символа в tib.

SkipDelim ( --> a: addr )
\ Пропустить все разделители. Вернуть адрес первого слова.

SkipUpTo ( d: char --> a: addr )
\ (аналог WORD ...)

RANGE ( a: a1 a2 --> d: # )
\ Возвратить расстояние между двумя адресами в байтах.

NextToken ( --> a: addr d: # )
\ Пропустить разделители, выделить слово.

ERROR ( a: asc d: # --> )
\ Вывести сообщение об ошибке и перейти к коду ABORT.

QUEST ( a: addr d: # --> a: lfa | nil )
\ Найти слово в словаре и возвратить его lfa.

REGULAR ( a: xt --> )
\ Компиляция или вызов адреса слова (аналог LITERAL для слов).

XTIMM ( a: lfa --> a: xt d: flag )
\ Возвратить адрес исполнения xt и поле флагов текущего слова.

EvalToken ( a: asc d: # --> )
\ 1. Взять слово из входного потока;
\ 2. Найти слово в словаре;
\ 3. В зависимости от признака IMMEDIATE, сразу вызвать слово, или передать REGULAR.

INTERPRET ( --> )
\ Цикл интерпретации. Навршается, если входной поток пуст.

TITLE ( --> )
\ Вывод информации о системе.

ABORT ( --> )
\ Код инициализайии (в данной системе). Обычно вызывается при ошибке.

QUIT ( --> )
\ Основной цикл системы.

\ INITMEM ( --> ) \ [codeonly]

\ IOINIT ( --> ) \ [codeonly]

BYE ( --> )
\ Возвратить управление внешней OS (Windows).

HALT ( err --> )
\ Возвратить управление внешней OS, передав ей код err.

RESERVE ( d: u --> a: addr )
\ Зарезервировать в кодофайле место, возвратив указатель
\ на начало зарезервированного пространства
\ (аналог ALLOT).

CELL ( --> d: cell# )
\ Возвратить размер CELL.

ADDR ( --> d: addr# )
\ Возвратить размер ADDR.

TOKEN ( --> d: tolen# )
\ Возвратить размер TOKEN.

RET, ( --> )
\ Компилировать байт возврата из слова (подпрограммы).

SCNT ( --> d: scnt#)
\ Возвратить размер SCNT.

REF ( --> d: ref# )
\ Возвратить размер REF.

HERE ( --> a: addr )
\ Возвратить адрес dp.

NHERE ( --> a: addr )
\ Возвратить адрес ndp.

A>D ( a: xt --> d: disp )
\ Поместить addr со стека адресов на стек данных (выполнив преобразование).

B, ( d: byte --> )
\ Компилировать байт в кодофайл.

REF, ( d: ref --> )
\ Компилировать сслыку в кодофайл.

, ( d: x --> )
\ Компилировать число в кодофайл.

A, ( a: addr --> )
\ Компилировать адрес в кодофайл.

NB, ( d: byte --> )
\ Компилировать байт в namespace.

N, ( d: x --> )
\ Компилировать число в namespace.

NA, ( a: addr --> )
\ Компилировать адрес в namespace.

NS, ( a: asc d: # --> )
\ Компилировать строку в namespace.

NSTR, ( a: addr d: # --> )
\ Компилировать строку со счетчиком в namespace.

S, ( a: asc d: # --> )
\ Компилировать строку в кодофайл.

STR, ( a: addr d: # --> )
\ Компилировать строку со счетчиком в кодофайл.

ALIT, ( a: addr --> )
\ Компилировать ALIT и адрес со стека.

[ ( --> ) IMMEDIATE
\ Переключить систему в режим интерпретации.

] ( --> )
\ Переключить систему в режим компиляции.

' ( / name --> a: xt )
\ Взять слово из входного потока, найти в словаре и возвратить xt

?COMP ( --> )
\ Проверка режима компиляции

VARIABLE WARNING
\ Флаг вывода сообщения "Name not unique!", при переопределении
\ существующего слова. (? использование в системе ?)

?UNIQUE ( a: addr d: # --> )
\ Если соответствующее слово найдено, то вывести сообщение "Name not unique!".

TOKEN, ( a: xt --> )
\ Компиляция: скомпилировать вызов подпрограммы по адресу xt.

<# ( --> )
\ ...

#> ( d: x --> a: addr d: # )
\ ...

HOLD ( d: char --> )
\ ...

>DIGIT ( d: u --> d: char )
\ Преобразовать значение в символ текущей СС.

# ( d: u --> d: u )
\ ...

S# ( d: u --> d: 0 )
\ ...

(U) ( d: u --> a: addr d: # )
\ ...

U. ( d: u --> )
\ Вывести число u в текущей СС

SIGN ( --> )
\ Поместить "-" в TAB

CHAR ( a: addr d: # --> d: char )
\ Взять первую букву следующего слова

>CIPHER ( d: char --> d: u )
\ Преобразовать цифру в значение

sval ( a: addr d: # --> d: ?? )
\ Преобразование числа в символьном виде во внутреннее представление

d: ( / decimal --> d: n ) IMMEDIATE
\ Выбрать следующее слово и распознать его как число в десятичном виде.

\ ALITERAL ( a: addr --> a: addr | ) \ [codeonly]

a: ( / hex --> a: addr ) IMMEDIATE
\ Выбрать следующее слово и распознать его как адрес (в шестнадцетеричном виде).

: ( / name--> )
\ Начать определение слова name.

; ( --> ) IMMEDIATE
\ Закончить определение слова.

SHEADER ( a: addr d: # --> )
\ Создать новый заголовок слова

VARIABLE LATEST
\ Возвратить адрес последнее системного слова (LIMIT).

LIT, ( d: n --> \\ --> n )
\ Компилировать LIT и число со стека.

LITERAL ( d: n --> \\ --> n )
\ Интерпретация: --
\ Компиляция: Компилировать LIT и число со стека.

;CREATE ( --> )
\ Завершить последнее определение.

CREATED ( asc # --> )
\ Cоздать словарную статью по имени, взятому на входе в виде строки.

CREATE ( / name --> )
\ Cоздать словарную статью по имени, выбиранного из входного потока.

VARIABLE ( / name --> )
\ Определить переменную name.

ROUND ( a: addr d: # --> )
\ Округлить адрес addr на заданную величину #.

ALIGN ( --> )
\ Выравниванить указатель HERE на величину, равную CELL.

\ NALIGN ( --> ) \ [codeonly]

int ( --> )
\ Вызов 3-го прерывания, для возможности отладки

CREATE LIMIT
\ Последнее системное слово.
\ Возвращает последний байт+1 системной области кодофайла.
Некоторые замечанные ошибки:
1. Слова, созданные мною, могут только компилироваться, но не исполняются с консоли :))
2.
Цитата:
toa equ EBX ; кеш вершины стека возвратов
кеш вершины стека адресов;
3. Кое-что ещё не связано, но находится в системе: (? использование в системе ?);
4. Отрицательные числа не распознаются;
Ну, и ещё возможно кое-что... (к примеру, не хватает TRUE и FALSE, ведь OFF же есть!).

P.s. Поправлял меня кое-где конечно-же автор, mOleg.


Последний раз редактировалось _KROL Чт мар 08, 2018 12:41, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 09:12 
Не в сети
Аватара пользователя

Зарегистрирован: Ср фев 23, 2011 20:42
Сообщения: 588
Откуда: Карелия
Благодарил (а): 3 раз.
Поблагодарили: 23 раз.
Ну и кому нужна эта умозрительная схема, пока она не вылилась во что-то работающее ? Обсуждать саму схему ? Так она даже словами описана неоднозначно. Что-такое стек адресов, если это не стек возвратов ? Или адреса возвратов уже адресами не являются ? Может это стек указателей ?
>CIPHER ( d: char --> d: u )
\ Преобразовать цифру в значение

А если преобразовать невозможно, что тогда ?
MOD/ ( d: a b --> a%b a/b )
\ a%b a/b - остаток и целое от деления a на b.

А делить-то как будем ? Если пополам, то в смысле 2/ или в смысле 2 / ?
d: ( / decimal --> d: n ) IMMEDIATE
\ Выбрать следующее слово и распознать его как число в десятичном виде.

А нахрен тогда переменная BASE ?
int ( --> )
\ Вызов 3-го прерывания, для возможности отладки

IBM PC only ?
RET, ( --> )
\ Компилировать байт возврата из слова (подпрограммы).

Подпрограммный шитый код only ? Случай байт-кода оставляю Ява-филам.
ALIT, ( a: addr --> )
\ Компилировать ALIT и адрес со стека.

А если подпрограммный шитый код, то зачем ALIT ? Может мне захочется сразу нативный код занесения addr на стек "адресов" ?
LITERAL ( d: n --> \\ --> n )
\ Интерпретация: --
\ Компиляция: Компилировать LIT и число со стека.

Аналогично зачем подпрограммному коду LIT ? Может сразу
sub ebp,4
mov [ebp],n
BYE ( --> )
\ Возвратить управление внешней OS (Windows).

HALT ( err --> )
\ Возвратить управление внешней OS, передав ей код err.

Так HALT это и есть BYE. Вернуть управление ОС Windows не передав ей что-нибудь в качестве кода завершения ведь невозможно.
У меня вот так :
Код:
      ENTRY   3, 'BYE', BYE
; Terminates a program with an optional exit code from the top of stack.
      DD   $+4
      push   ebx         ;ebx есть TOS
      call   ExitProcess
Хошь завершайся BYE , хошь err BYE, все идет через одно слово.
Используешь BYE когда по%ую какой код возврата и err BYE когда не по%ую.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 10:02 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
Ethereal писал(а):
Ну и кому нужна эта умозрительная схема, пока она не вылилась во что-то работающее ?

ну, любая схема кому-то нужна, если с ней возятся. К тому же, пример системы есть, пускай и схематичный, но, вполне собираемый, кстати, у меня есть подозрение, что на сам код вы внимания не обратили.

Ethereal писал(а):
Обсуждать саму схему ? Так она даже словами описана неоднозначно. Что-такое стек адресов, если это не стек возвратов ? Или адреса возвратов уже адресами не являются ? Может это стек указателей ?

это не стек возвратов, а, скажем так, Муровский адресный регистр, под которым нарастили стек.
Можно его назвать и стеком указателей, а смысл в том, чтобы отделить адреса от данных,
что позволит, во-первых, несколько уменьшить количество перестановок на стеке данных (этих самых SWAP OVER и т.п.), во-вторых, развязать разрядность адресов от разрядности данных (имхо, очень важный момент), в-третьих, обеспечить контроль за адресным пространством (тут сложнее всего).
Важно понимать, что доступны следующие перемещения между стеками:
R> >A, A> >R и все! т.е. со стека данных на стек адресов, а так же, со стека возвратов на стек данных перемещение данных не возможно.

Ethereal писал(а):
>CIPHER ( d: char --> d: u )
\ Преобразовать цифру в значение

Проверка дальше, система счисления в данном месте еще не задана.

Ethereal писал(а):
MOD/ ( d: a b --> a%b a/b )
\ a%b a/b - остаток и целое от деления a на b.
А делить-то как будем ? Если пополам, то в смысле 2/ или в смысле 2 / ?

вопроса не понял, т.к. обычная для Форта команда.

Ethereal писал(а):
d: ( / decimal --> d: n ) IMMEDIATE
\ Выбрать следующее слово и распознать его как число в десятичном виде.
А нахрен тогда переменная BASE ?

дык, чтоб было. Просто было лень возиться - это, все-таки, набросок для иллюстрации идеи.
Кстати, я практически никогда этой самой BASE не пользуюсь по жизни...
Может не так она уж и нужна, т.к. для случаев, когда она явно должна быть задана, я делаю так:
Код:
  .. 0x0A {# # # .. #S #> ...

оказалось, что это очень удобно (задавать в явном виде систему счисления перед преобразованием),
нежели плясать вокруг BASE, сохраняя, восстанавливая ее текущее значение.

Ethereal писал(а):
int ( --> )
\ Вызов 3-го прерывания, для возможности отладки
IBM PC only ?

да, безусловно, т.к. был этап отладки. Если вы обратили внимание, все написано на fasm.

Ethereal писал(а):
RET, ( --> )
\ Компилировать байт возврата из слова (подпрограммы).
Подпрограммный шитый код only ? Случай байт-кода оставляю Ява-филам

Да, был выбран, как наиболее простой в отладке OllyDebug-ером

Ethereal писал(а):
ALIT, ( a: addr --> )
\ Компилировать ALIT и адрес со стека.
А если подпрограммный шитый код, то зачем ALIT ? Может мне захочется сразу нативный код занесения addr на стек "адресов" ?

это особенность выбранной модели системы. На стек адресов можно положить данные только из следующих источников:
память - с помощью A@ (если не ошибаюсь в названии),
стек возвратов - для операций ветвлений, всяких там CREATE и подобного,
память в коде - как раз ALIT (ну, для случая ..][alit][addr][.. если что, в [скобках] токены
Собственно, у нас нет возможности перенести значение со стека данных на стек адресов, а, значит, должна быть возможность помещения фиксированной адресной ссылки прямо на стек адресов.

Ethereal писал(а):
Аналогично зачем подпрограммному коду LIT ? Может сразу

В общем случае да, к этому можно прийти, но было проще реализовать именно как отдельное определение,
чтобы не было проблем с отслеживанием режимов работы ( immediate ) системы. Собственно, можно и всякие DUP SWAP и прочее сразу компилировать в код без вызова. Но цели такой в данном случае просто не было.
Хотелось понять, во что выльются основные части системы при такой работе с памятью и стеками.

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 15:13 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6819
Благодарил (а): 16 раз.
Поблагодарили: 112 раз.
У меня вот такой пример:

CREATE X[] 100 CELLS ALLOT

100 0 DO
I X[] I CELLS + !
LOOP

В первом случае I это данные, а во втором - адрес. И как их распределить между стеком данных и адресов?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 15:52 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
Hishnik писал(а):
У меня вот такой пример:


ну, прикинем, первая строчка останется такой же:
CREATE X[] 100 CELLS ALLOT
а вот дальше нужно вспомнить, что адрес должен лежать только на адресном стеке.
Код:
100 0 DO
                I X[] I CELLS A+ !
         LOOP

что изменилось? а вот что:
X[] выложил адрес начала массива на вершину стека адресов,
I CELLS вычислил смещение на вершине стека данных
A+ добавил смещение к адресу, в результате чего получился адрес же на вершине стека адресов
! записал значение I с вершины стека данных в память по адресу, лежащему на вершине стека адресов.

я бы не сказал, что что-то особо поменялось.

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 16:30 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6819
Благодарил (а): 16 раз.
Поблагодарили: 112 раз.
mOleg писал(а):
A+ добавил смещение к адресу, в результате чего получился адрес же на вершине стека адресов

Вот-вот. Надо помнить, что слово A+ имеет нотацию D, A: X -- A: D+X. А еще надо отличать A+ от слова, которое сложит два числа на стеке адресов (если такое нужно). Ну и если смещения все равно вычисляются на стеке данных, то где же польза от стека адресов, который по идее призван обеспечить встроенный контроль типов, разделяя данные и указатели?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 17:13 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
Hishnik писал(а):
Вот-вот. Надо помнить, что слово A+ имеет нотацию D, A: X -- A: D+X

ну, типа того, ( d: n a: addr --> a: addr )

Hishnik писал(а):
А еще надо отличать A+ от слова, которое сложит два числа на стеке адресов (если такое нужно).

ну, нет, а для чего складывать адрес с адресом? Такого быть не должно, а вот A- должно из адреса вычитать адрес, и результат класть на вершину стека данных. Кстати, тут появляется неявный механизм контроля адресной арифметики 8)

Hishnik писал(а):
Ну и если смещения все равно вычисляются на стеке данных, то где же польза от стека адресов, который по идее призван обеспечить встроенный контроль типов, разделяя данные и указатели?

ну, во-первых, на стеке данных становится меньше данных, а, значит, меньше перестановок данных,
во-вторых, я уже говорил, разделяется разрядность данных и адресов, к тому же адреса могут быть более сложными по своей природе, та же сегментная адресация, когда адрес представлен парой чисел: база + смещение. Или вообще быть индексами.
Кстати, решение очень фортовое: у нас есть отдельный тип данных - мы для него создаем отдельный стек.

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

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 19:35 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6819
Благодарил (а): 16 раз.
Поблагодарили: 112 раз.
mOleg писал(а):
ну, нет, а для чего складывать адрес с адресом? Такого быть не должно

Раз есть стек, то где гарантия, что не возникнет такая ситуация?

mOleg писал(а):
ну, во-первых, на стеке данных становится меньше данных, а, значит, меньше перестановок данных,

На стеке и так не надо держать слишком много чисел. Тем более что появляются по сути шаблоны вида "положили на стек данных - переложили на стек адресов - использовали". Зачем при таком подходе промежуточная стадия?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 19:50 
Не в сети

Зарегистрирован: Пт янв 06, 2017 14:57
Сообщения: 359
Благодарил (а): 16 раз.
Поблагодарили: 1 раз.
Цитата:
Тем более что появляются по сути шаблоны вида "положили на стек данных - переложили на стек адресов - использовали". Зачем при таком подходе промежуточная стадия?

Да и если реализовать полностью эту идею, то скорее всего она прокатит не на всех архитектурах хорошо...
Но я уже решил попробовать, пишу... надеюсь что допишу :D


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 20:37 
Не в сети
Аватара пользователя

Зарегистрирован: Ср фев 23, 2011 20:42
Сообщения: 588
Откуда: Карелия
Благодарил (а): 3 раз.
Поблагодарили: 23 раз.
mOleg писал(а):
Ethereal писал(а):
Ну и кому нужна эта умозрительная схема, пока она не вылилась во что-то работающее ?

ну, любая схема кому-то нужна, если с ней возятся. К тому же, пример системы есть, пускай и схематичный, но, вполне собираемый, кстати, у меня есть подозрение, что на сам код вы внимания не обратили.
Так я же не про Ваш пример, я отреагировал на сообщение KROL-а. Где его пример ? Да хоть с какими идеями, лишь бы работающий ? Просто уже когда-нибудь он что-нибудь доделает до конца ? Он очередной раз увлекся новой идеей, забросив на пол пути предыдущую. Причем идеей, по ее описанию понятно, что еле-еле оформившейся. Про это я и ворчал.
Да и сильно неправильно это писать небывалый Форт, не сумевши еще написать классический. Куда за более сложную задачу, не справившись с простой ?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 21:10 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
Hishnik писал(а):
mOleg писал(а):
ну, нет, а для чего складывать адрес с адресом? Такого быть не должно

Раз есть стек, то где гарантия, что не возникнет такая ситуация?

никаких гарантий быть не может в принципе.
Если просто нет операций, складывающих адрес с адресом,
то такую ситуацию создать сложнее, так как необходимо создать такой механизм.
то есть путь реализации ошибки длиннее и извилистее.

Hishnik писал(а):
mOleg писал(а):
ну, во-первых, на стеке данных становится меньше данных, а, значит, меньше перестановок данных,

На стеке и так не надо держать слишком много чисел. Тем более что появляются по сути шаблоны вида "положили на стек данных - переложили на стек адресов - использовали". Зачем при таком подходе промежуточная стадия?

вот только лозунгов не надо. Я вполне представляю, как писать на форте и как данные располагать и хранить.
про промежуточную стадию я не понял. где она?

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 21:24 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6819
Благодарил (а): 16 раз.
Поблагодарили: 112 раз.
mOleg писал(а):
вот только лозунгов не надо. Я вполне представляю, как писать на форте и как данные располагать и хранить.

Довольно много рекомендаций "не иметь много чисел на стеке". Стек - не решение проблем, характерное для Форта, а вынужденная мера, проистекающая из особенностей грамматики. Профилирование показывает, что со временем программисты держат на стеке все меньше чисел и все реже используют слова, манипулирующие данными на стеке.
mOleg писал(а):
про промежуточную стадию я не понял. где она?

Перекладывание данных на стек адреса, чтобы использовать число как адрес.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 21:27 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
_KROL писал(а):
Да и если реализовать полностью эту идею, то скорее всего она прокатит не на всех архитектурах хорошо...

ну, тут только, если регистров в процессоре не будет хватать адресных.

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: 3-х стековая виртуальная машина. размышления.
СообщениеДобавлено: Чт мар 08, 2018 21:35 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4997
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 20 раз.
Поблагодарили: 58 раз.
Ethereal писал(а):
Так я же не про Ваш пример

ясно.
однако, учиться иногда проще и так - начав все с самого начала.
Иногда даже необходимо выкинуть то, что имеется и начать сначала.

Ethereal писал(а):
Да и сильно неправильно это писать небывалый Форт, не сумевши еще написать классический. Куда за более сложную задачу, не справившись с простой ?

Вот тут согласен. Но, иногда, легче решать более сложную, но более интересную задачу.

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 159 ]  На страницу Пред.  1 ... 6, 7, 8, 9, 10, 11  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 4


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB