aForth - кросплатформенный FORTH-подобный язык.

Использование и разработка софта (преимущественно на ПЦ)

Moderator: Shaos

SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

А вот и кода пример:

Code: Select all

(
    С константами-массивами можно работать только в режиме интерпертации.
    Но - голь на выдумки хитра!
    Пример программки, которая на лету синтезирует массив из 3х переменных.
    Причём массив может быть int short или byte
)
"dict.af" include
( Пустой массив А )

{ } array A "Пустой массив. A=" . A size . CR

( Переменные )
0x10 variable I1
0x20 variable I2
0x30 variable I3

( mode - хранит режим синтеза массива  - byte, short или int )
"" variable mode

(
    Слово array-syntes - синтезирует строку
    "{ <mode> I1 I2 I3 }" и выполняет её в режиме интерпретации с
    помощью слова doword, затем сохраняет синтезированный массив в том,
    что находится на стеке.
)
: array-syntes "{ " mode + " I1 I2 I3 }" + doword swap !! ;

"Синтезируем массив байт" . CR
"byte" mode !!
A array-syntes
A VARDUMP
CR

"Синтезируем массив коротких целых" . CR
"short" mode !!
A array-syntes
A VARDUMP
CR

"Синтезируем массив целых" . CR
"int" mode !!
A array-syntes
A VARDUMP
CR
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

Вот исходники и документация.
Со всеми правками - команды сохранения состояния, работа с массивами.

Приятная вещь получилась, типа

30 array A
40 array B
{ A B } array C

Типа как объединение множеств :)

http://www.nedopc.org/nedopc/upload/afo ... .6.tar.bz2
http://www.nedopc.org/nedopc/upload/afo ... .6.tar.bz2
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

Практически применимый кусок кода - добавляет сообщения в массив, очищает его, выдаёт на стек сообщение по номеру :) Язык вполне дорос до написания мелкоигрушек типа тектсовых :) Осталось доделать слова обработки строк - их разбиения, поиска, вставки - уже можно приложения простенькие писать.

Code: Select all

( ------------------------------------------------------------------------------------------------- )
(
    Добавить сообщение
    <массив-список> <сообщение> msg-add
)
: msg-add
    ( Запоминаем сообщение )
    dup size
    malloc
    swap
    over
    setmstr
    ( Добавляем его в глобальный список сообщений )
    ( MSG_LIST dup size )
    over dup size
    if
        ( Уже есть сообщения в списке )
        dup
            dup  size intsize + swap aresize ( размер увеличиваем на размер int-адреса )
        &       ( адрес массива на стеке )
        begin
            dup getmint
            if
                ( если не NULL, то переход к след. элементу )
                intsize +
                0
            else
                setmint
                1
            endif
        until
        ( Цикл подсчёта сообщений )

    else
        ( Ещё нет сообщений в списке )
        dup intsize 2 * swap aresize &
        setmint
    endif
    drop
;

( ------------------------------------------------------------------------------------------------- )
(
    Распечатка всех сообщений
     <array> msg-list
)
: msg-list
    & ( Адрес - на стек )
    dup
    if ( Проверка на пустоту массива )
        0 swap
        begin
            dup getmint dup
            if ( 0 a aa )
                1 nswap dup . 1+ ": " . 1 nswap
                getmstr . "\n" .
                intsize +
                0
            else
               drop 1
            endif
        until
        drop
    endif
    drop
;

( ------------------------------------------------------------------------------------------------- )

(
    Очистка массива сообщений
     <array> msg-clean
)
: msg-clean
    dup
    & ( Адрес - на стек )
    dup
    if ( Проверка на пустоту массива )
        begin
            dup getmint dup
            if ( 0 a aa )
                free
                intsize +
                0
            else
               drop 1
            endif
        until
    endif
    drop
     0 swap aresize
;

( ------------------------------------------------------------------------------------------------- )
(
    Помещает на стек сообщение номер N или пустую строку, если его нет.
    <array> <номер> msg-get
)
: msg-get
    4 * over over ( a 4n a 4n )
    swap size intsize - ( a 4n 4n size )
    < if
        swap & + getmint getmstr
    else
        drop drop ""
    endif
;
( ------------------------------------------------------------------------------------------------- )

SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

На очереди мысли о пространствах слов.
Чтобы определять несколько независимых пространств слов, связанных только общим стеком. Изначально - на чистой машине - доступного только пространство base. Это же пространство доступно и в любом другом пространстве слов.
Но если мы дадим команду, например:
"myspace" addwordspace
то создастся новое пространство слов и все слова будут определяться в нём.
Пространства слов можно переключать.
'youspace" setwordspace
Ни одно пространство слов не может пересекаться с базовым пространством.

Слова с одинаковыми именами могут определяться в разных пространствах слов.

Пространства слов можно удалять целиком.
Такие вот мысли. Это позволит как угодно обзывать слова, главное, чтобы они не повторяли слов, пространства "base".

Правда по реализации этого пока мутновато. Мысли бродят в голове.

Пока доделываю то, что уже ясно. В основном кое-какие глючки уничтожаю.
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

Добавил слова работы с типами и слово isword, проверяющее - есть ли слово в словаре. Ещё - принудительное приведение типов:

Code: Select all

( Слово istype снимает со стека значение ивозвращает на стек константу-код, соответствующую типу снятого значения. Каждый тип данных имеет свой уникальный код. Слова array-type, int-type, real-type, str-type возвращают на стек код соответствующего типа. )


    ( Проверка типов. На стеке значение неизвестного типа. )

    : checktype

        istype

        dup array-type = if "Тип: массив" CR endif

        dup int-type = if "Тип: целое" CR endif

        dup real-type = if "Тип: вещественное" CR endif

            str-type = if "Тип: строка" CR endif
    ;


( Слово принудительно приводит тип значения на вершине стека к указанному, если типы совместимы. Всегда возвращает константу указанного типа на стеке.

    Формат команды: <значение> <код типа> typecast )


    ( Приведение к целому типу )
    2.345 int-type typecast . CR ( Напечатает 2 - целое число )
    ( Приведение к вещественному типу )
    5     real-type typecast . CR ( Напечатает 5.00000 - вещестенное число )

( Проверка - есть ли слово в словаре )
"dup" isword . CR ( напечатает 1 )
"ee" isword . CR ( напечатает 0 )
Исходники и дока тут:

http://www.nedopc.org/nedopc/upload/afo ... .8.tar.bz2

http://www.nedopc.org/nedopc/upload/afo ... .8.tar.bz2

PS
Открыл тему про aForth на фортовском ресурсе:
http://fforum.winglion.ru/viewtopic.php?p=15838#15838
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

Появился первый платформо-зависимый словарь linux.dict

Туда сведены слова получения информации со стандартного ввода getchar и getcharnb - они отличаются тем, что getchar ждёт символа, а getcharnb не ждёт.

И уже на форте описана таблица перекодировки ESC-последовательностей в одночисловой код. Т.е. многобайтовая ESC-последовательность переводится в код, больший 255, что позволяет её удобно сравнивать.

Сейчас пишу на форте строковый редактор (самый простенький - под Linux-терминал).

Исходники и дока обновлённой версии тут:

http://www.nedopc.org/nedopc/upload/afo ... .1.tar.bz2
http://www.nedopc.org/nedopc/upload/afo ... .1.tar.bz2
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

Сделал обработку ошибок пользователем.
SfS
Doomed
Posts: 491
Joined: 16 Apr 2005 22:35
Location: Томск

Post by SfS »

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

Сделал обработку ошибок пользователем. Принцип прост. В случае возникновения ошибки - aForth ищет слово onerror. Если такое слово есть - то на стек помещается код ошибки и выполняется это слово. После выполнения слова onerror со стека снимается код ошибки. Если слово onerror помещает на стек 0 (нет ошибок), то система, сняв его со стека, считает, что ошибок нет и продолжает выполнение программы.

Так же существует функция strerror, которая берёт со стека код ошибки и помещает на стек строку-описатель ошибки.

Пример простейшего слова onerror, которое все ошибки выводит в текстовом виде на терминал и заставляет систему продолжать выполнение программы:

Code: Select all

 : onerror "Ошибка [" . dup . "]: " . strerror . '\n' .C 0 ;
Версия доработанного aForth:

http://www.nedopc.org/nedopc/upload/afo ... .0.tar.bz2

HINT: Документация по словарям конкретной версии собирается командой make doc