Rev 4867 | Details | Compare with Previous | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 4867 | leency | 1 | DECIMAL |
| 2 | |||
| 3 | \ ' DUP VALUE 'DUP_V |
||
| 4 | \ ' DROP VALUE 'DROP_V |
||
| 5 | |||
| 6 | USER HLD \ переменная - позиция последней литеры, перенесенной в PAD |
||
| 7 | |||
| 8 | |||
| 9 | 1 VALUE H-STDOUT \ хэндл файла - стандартного вывода |
||
| 10 | 1 VALUE H-STDERR \ хэндл файла - стандартного вывода ошибок |
||
| 11 | |||
| 12 | USER ALIGN-BYTES |
||
| 13 | |||
| 14 | : ALIGNED ( addr -- a-addr ) \ 94 |
||
| 15 | \ a-addr - первый выровненный адрес, больший или равный addr. |
||
| 16 | ALIGN-BYTES @ DUP 0= IF 1+ DUP ALIGN-BYTES ! THEN |
||
| 17 | 2DUP |
||
| 18 | MOD DUP IF - + ELSE 2DROP THEN |
||
| 19 | ; |
||
| 20 | |||
| 21 | : ALIGN ( -- ) \ 94 |
||
| 22 | \ Если указатель пространства данных не выровнен - |
||
| 23 | \ выровнять его. |
||
| 24 | DP @ ALIGNED DP @ - ALLOT |
||
| 25 | ; |
||
| 26 | |||
| 27 | : ALIGN-NOP ( n -- ) |
||
| 28 | \ выровнять HERE на n и заполнить NOP |
||
| 29 | HERE DUP ROT 2DUP |
||
| 30 | MOD DUP IF - + ELSE 2DROP THEN |
||
| 31 | OVER - DUP ALLOT 0x90 FILL |
||
| 32 | ; |
||
| 33 | |||
| 34 | : IMMEDIATE ( -- ) \ 94 |
||
| 35 | \ Сделать последнее определение словом немедленного исполнения. |
||
| 36 | \ Исключительная ситуация возникает, если последнее определение |
||
| 37 | \ не имеет имени. |
||
| 38 | LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP C! |
||
| 39 | ; |
||
| 40 | |||
| 41 | |||
| 42 | : :NONAME ( C: -- colon-sys ) ( S: -- xt ) \ 94 CORE EXT |
||
| 43 | \ Создать выполнимый токен xt, установить состояние компиляции и |
||
| 44 | \ начать текущее определение, произведя colon-sys. Добавить семантику |
||
| 45 | \ инициализации к текущему определению. |
||
| 46 | \ Семантика выполнения xt будет задана словами, скомпилированными |
||
| 47 | \ в тело определения. Это определение может быть позже выполнено по |
||
| 48 | \ xt EXECUTE. |
||
| 49 | \ Если управляющий стек реализован с импользованием стека данных, |
||
| 50 | \ colon-sys будет верхним элементом на стеке данных. |
||
| 51 | \ Инициализация: ( i*x -- i*x ) ( R: -- nest-sys ) |
||
| 52 | \ Сохранить зависящую от реализации информацию nest-sys о вызове |
||
| 53 | \ определения. Элементы стека i*x представляют аргументы xt. |
||
| 54 | \ xt Выполнение: ( i*x -- j*x ) |
||
| 55 | \ Выполнить определение, заданное xt. Элементы стека i*x и j*x |
||
| 56 | \ представляют аргументы и результаты xt соответственно. |
||
| 57 | HERE ] |
||
| 58 | HERE TO :-SET ; |
||
| 59 | |||
| 60 | : INCLUDED INCLUDED_ ; |
||
| 61 | ' NOOP TO |
||
| 62 | ' FIND1 TO FIND |
||
| 63 | ' ?LITERAL2 TO ?LITERAL |
||
| 64 | ' ?SLITERAL2 TO ?SLITERAL |
||
| 65 | ' OK1 TO OK. |
||
| 66 | ' (ABORT1") TO (ABORT") |
||
| 67 | |||
| 68 | VECT TYPE ' _TYPE TO TYPE |
||
| 69 | VECT EMIT ' _EMIT TO EMIT |
||
| 70 | |||
| 71 | |||
| 72 | : H. BASE @ SWAP HEX U. BASE ! ; |
||
| 73 | |||
| 9587 | vitalkrilo | 74 | : TST S" /sys/autoload.f" INCLUDED_ ; |
| 4867 | leency | 75 | : TST1 S" WORDS" EVALUATE ; |
| 76 |