nedoPC.org

(
    С константами-массивами можно работать только в режиме интерпертации.
    Но - голь на выдумки хитра!
    Пример программки, которая на лету синтезирует массив из 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

( ------------------------------------------------------------------------------------------------- )
(
    Добавить сообщение
    <массив-список> <сообщение> 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
;
( ------------------------------------------------------------------------------------------------- )

( Слово 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 )

 : onerror "Ошибка [" . dup . "]: " . strerror . '\n' .C 0 ;