\ four stack assembler 19jan94py
\ Copyright (C) 2000 Free Software Foundation, Inc.
\ This file is part of Gforth.
\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation; either version 2
\ of the License, or (at your option) any later version.
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU General Public License for more details.
\ You should have received a copy of the GNU General Public License
\ along with this program; if not, write to the Free Software
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
Vocabulary asm4stack
Vocabulary asmdefs
asm4stack also asmdefs also definitions Forth
' asm4stack Alias [A] immediate
' Forth Alias [F] immediate
: :A asm4stack definitions Forth ;
: :D asmdefs definitions Forth ;
\ assembly area setup 24apr94py
Defer '2@
Defer '2!
Defer 'c!
Defer '!
Defer 'SF!
Defer 'F!
Defer 4here
Defer 4allot
\ frame format:
\ { target addr, target length, host addr, framelink }
: 4there 4here ;
: op! '2! ;
: op, 4there op! 2 cells 4allot ;
: op@ '2@ ;
: caddr ; immediate
: waddr ; immediate
: laddr ; immediate
[THEN]
\ instruction generation 24apr94py
2Variable ibuf 0. ibuf 2!
Variable instfield 0 instfield !
Variable condfield 0 condfield !
Variable lastmove 0 lastmove !
Create instmasks $003FFFFF.FFFFFFFF , ,
$FFC00FFF.FFFFFFFF , ,
$FFFFF003.FFFFFFFF , ,
$FFFFFFFC.00FFFFFF , ,
$FFFFFFFF.FF003FFF , ,
$FFFFFFFF.FFFFC00F , ,
: instshift ( 10bit -- 64bit )
1 5 instfield @ - &10 * 4 + $20 /mod >r
lshift um* r> IF swap THEN ;
: 2and ( d1 d2 -- d ) rot and -rot and swap ;
: 2or ( d1 d2 -- d ) rot or -rot or swap ;
: !inst ( 10bit -- ) instshift
instfield @ 2* cells instmasks + 2@ ibuf 2@ 2and 2or ibuf 2!
1 instfield +! ;
: finish ( -- ) ibuf 2@ op,
0 0 ibuf 2! instfield off condfield off lastmove off ;
: finish? instfield @ IF finish THEN ;
:A
: ;; ( -- ) finish? postpone \ ;
: .org ( n -- ) 4here - 4allot ;
:D
\ checks for instruction slots 19jan94py
: alu? ( -- flag ) instfield @ 0 4 within ;
: move? ( -- flag ) instfield @ 4 6 within
ibuf cell+ @ 3 and 1 <> and ;
: call? ( -- flag ) instfield @ 4 < ;
: br? ( -- flag ) instfield @ 5 < ;
: ?finish ( -- ) instfield @ 6 = IF finish THEN ;
\ automatic feed of instructions 19jan94py
Variable lastalu
Variable lastalufield
: !alu ( 10bit -- )
alu? 0= IF finish THEN
dup lastalu !
instfield @ lastalufield !
!inst ;
: !data ( 10bit -- ) alu? IF 4 instfield ! THEN
move? 0= IF finish 4 instfield ! THEN
instfield @ lastmove ! !inst ;
: !br ( 10bit likelyhood -- addr )
br? 0= abort" No Data in Branch!"
alu? IF 4 instfield ! THEN >r !inst
ibuf 2@ 2 r> 3 and 2* 2* + 0 2or ibuf 2! 4here ;
:A
: do ( -- addr ) 0 0 !br finish ;
: br ( -- addr ) $200 1 !br ;
: br,0 ( -- addr ) $200 0 !br ;
: br,1 ( -- addr ) $200 1 !br ;
: call ( -- addr ) call? 0= IF finish THEN
6 instfield ! ibuf 2@ $0.00000003 2or ibuf 2! 4here ;
: jmp ( -- addr ) call? 0= IF finish THEN
6 instfield ! ibuf 2@ $1.00000003 2or ibuf 2! 4here ;
: calla ( -- addr ) call? 0= IF finish THEN
6 instfield ! ibuf 2@ $2.00000003 2or ibuf 2! 4here ;
: jmpa ( -- addr ) call? 0= IF finish THEN
6 instfield ! ibuf 2@ $3.00000003 2or ibuf 2! 4here ;
:D
\ branch conditions 20mar94py
Create and/or-tab
$08 c, $04 c, $02 c, $01 c,
$1C c, $1A c, $19 c, $16 c, $15 c, $13 c,
$1E c, $1D c, $1B c, $17 c,
$1F c,
$0C c, $0A c, $09 c, $06 c, $05 c, $03 c,
$0E c, $0D c, $0B c, $07 c,
$0F c,
: >and/or ( n -- stacks ) and/or-tab + c@ ;
: constants 0 ?DO constant LOOP ;
:A
hex
9 8 7 6 5 4 6 constants 0&1 0&2 0&3 1&2 1&3 2&3
D C B A 4 constants 0&1&2 0&1&3 0&2&3 1&2&3
E constant 0&1&2&3
14 13 12 11 10 F 6 constants 0|1 0|2 0|3 1|2 1|3 2|3
18 17 16 15 4 constants 0|1|2 0|1|3 0|2|3 1|2|3
19 constant 0|1|2|3
decimal
:D
\ branch conditions 20mar94py
Create condmasks $FF07FFFF ,
$FFF83FFF ,
$FFFFC1FF ,
$FFFFFE0F ,
: !cond ( n -- ) condfield @ 3 > abort" too much conds!"
$1F and 3 condfield @ - 5 * 4 + lshift
ibuf cell+ @ condmasks condfield @ cells + @ and or
ibuf cell+ ! 1 condfield +!
condfield @ 2/ 4 + instfield ! ;
\ branch conditions 20mar94py
: brcond ( n flag -- ) swap >and/or !cond !cond ;
: cond: ( n -- ) Create ,
DOES> ( n/ -- ) @ ibuf cell+ @ 3 and
dup 2 = IF drop condfield @ dup 0=
IF drop brcond EXIT THEN
ELSE dup 0=
IF 1 ibuf cell+ +!
ELSE 1 <> THEN THEN
abort" Misplaced condition" !cond ;
: conds: ( end start -- ) DO I cond: LOOP ;
:A
$08 $00 conds: :t :0= :0< :ov :u< :u> :< :>
$10 $08 conds: :f :0<> :0>= :no :u>= :u<= :>= :<=
$18 $10 conds: ?t ?0= ?0< ?ov ?u< ?u> ?< ?>
$20 $18 conds: ?f ?0<> ?0>= ?no ?u>= ?u<= ?>= ?<=
:D
\ loop/branch resolve 19mar94py
: resolve! ( dist addr -- )
>r r@ op@ drop 3 and
dup 2 = IF drop $3FF8 and 0 ELSE
dup 3 = IF drop -8 and 0
r@ op@ nip 2 and IF swap r@ 8 + + swap THEN
ELSE true abort" No Jump!" THEN THEN
r@ op@ 2or r> op! ;
:A
: .loop ( addr -- ) finish? dup >r 4here swap - 8 -
dup $2000 u>= abort" LOOP out of range!" r> resolve! ;
: .endif ( addr -- ) finish? dup >r 4here swap - 8 -
dup $1000 -$1000 within abort" BR out of range!"
r> resolve! ;
: .begin ( -- addr ) finish? 4here ;
: .until ( addr1 addr2 -- ) finish? dup >r - 8 -
dup $1000 -$1000 within abort" BR out of range! "
r> resolve! ;
: +IP ( addr1 rel -- ) finish? 8 * swap resolve! ;
: >IP ( addr1 addr -- ) finish? over 8 + - swap resolve! ;
:D
\ labels 23may94py
Vocabulary symbols
: symbols[ symbols definitions ;
: symbols] forth definitions ;
Create makesym" ," label: " here $40 allot AConstant symname
: sym-lookup? ( addr len -- xt/0 )
[ ' symbols >body ] ALiteral search-wordlist
0= IF 0 THEN ;
: >sym" ( addr len -- ) symname swap move ;
: sym, ( addr len -- addr ) drop ;
\ symframe cell+ 2@ + swap ( --> addr target len )
\ 2dup aligned dup cell+ symframe cell+ +!
\ 2dup + >r cell+ erase move r> ( --> addr ) ;
: symbol, ( addr len -- xt ) dup >r
2dup >sym" sym,
also asmdefs makesym" count r> + evaluate previous ;
: label: ( addr -- xt )
symbols[ Create symbols] 0 A, , lastxt
DOES> ( addr -- ) dup cell+ @ @ dup
IF nip >IP EXIT THEN
drop dup @ here rot ! A, , ;
: reveal: ( addr xt -- ) >body 2dup cell+ @ !
BEGIN @ dup WHILE
2dup cell+ @ swap >IP REPEAT 2drop ;
:A
: .globl ( -- ) 0 bl word count symbol, ;
:D
: is-label? ( addr u -- flag ) drop c@ '@ >= ;
: ?label ( addr u -- )
2dup is-label?
IF 2dup 1- + c@ ': = dup >r +
2dup sym-lookup? dup 0=
IF drop symbol, ELSE nip nip THEN
r@ IF finish? 4here over reveal: THEN
r> 0= IF execute ELSE drop THEN EXIT
THEN
defers interpreter-notfound ;
\ >call 09sep94py
: >call call? 0= IF finish THEN 3 instfield ! ;
\ simple instructions 19jan94py
: alu: ( 10bit -- ) Create , DOES> @ !alu ;
: readword ( -- )
BEGIN >in @ bl word count dup 0=
WHILE refill 2drop 2drop REPEAT 2drop >in ! ;
: alus: ( start end step -- ) -rot swap
?DO readword I alu:
\ s" --" compare
\ IF >in ! I alu: ELSE drop THEN
dup +LOOP drop ;
:A
%0000001001 %0110001001 %100000
alus: or add addc mul
and sub subc umul
xor subr subcr pass
\ s1p is default
\ mul@ 19jan94py
%0110100000 %0110110000 1
alus: mul@ mul<@ mulr@ mulr<@
-mul@ -mul<@ -mulr@ -mulr<@
mul@+ mul<@+ mulr@+ mulr<@+
-mul@+ -mul<@+ -mulr@+ -mulr<@+
\ flag generation 19jan94py
%0110110000 %0111000000 1
alus: t 0= 0< ov u< u> < >
f 0<> 0>= no u>= u<= >= <=
\ T4 19jan94py
%0111000000 %0111100000 1
alus: asr lsr ror rorc asl lsl rol rolc
ff1 popc lob loh extb exth hib hih
sp@ loops@ loope@ ip@ sr@ cm@ index@ flatch@
sp! loops! loope! ip! sr! cm! index! flatch!
\ T5, floating point: 19jan94py
%0111100000 %0111110000 1
alus: fadd fsub fmul fnmul
faddadd faddsub fmuladd fmulsub
fi2f fni2f fadd@ fmul@
fs2d fd2s fxtract fiscale
\ %0111110000 %0111110100 1
\ alus: ext extu mak clr
%0111110000 %0111110010 1 alus: bfu bfs
%0111110100 %0111110110 1 alus: cc@ cc!
%0111111000 %1000000000 1
alus: px1 px2 px4 px8
pp1 pp2 pp4 pp8
:D
\ Stack effects 19jan94py
: >curstack ( 5bit -- 5bit ) lastalufield @ 2* 2* xor ;
: >stack ( alu -- ) lastalufield @
dup 1+ instfield @ <> ABORT" Spurious stack address!"
instfield ! !alu ;
\ pick and pin 21jan94py
: pin, ( 5bit -- ) dup %10000 and
IF >curstack dup %11 and swap %01100 and
ELSE dup %11 and %100 + swap %10000 %01100 within
THEN ABORT" Only current stack!"
%0110000000 or >stack ;
: pick, ( 5bit -- )
dup %00000 %00100 within ABORT" No constant"
%0110000000 or >stack ;
:A
%0110000000 alu: pin
: pick ( -- )
alu? 0= IF finish THEN
instfield @ lastalufield ! %0110010000 >curstack !alu ;
:D
\ Stack addresses 21jan94py
: !stack ( 5bit -- )
lastalu @ %0110000000 = IF pin, EXIT THEN
lastalu @ %0110010000 >curstack = IF pick, EXIT THEN
lastalu @ %11111 and %01001 <> ABORT" Only one address!"
lastalu @ %1111100000 and or
dup %0110000000 u>= ABORT" no ALU instruction!" >stack ;
: stack: ( 5bit -- ) Create , DOES> @ !stack ;
: stacks: ( n -- )
0 ?DO readword I stack: LOOP ;
:A
$20 stacks: #0 #-1 #$7FFFFFFF #$80000000
c0 c1 c2 c3
s0p s1p s2p s3p
s4 s5 s6 s7
0s0 0s1 0s2 0s3
1s0 1s1 1s2 1s3
2s0 2s1 2s2 2s3
3s0 3s1 3s2 3s3
:D
\ relativ to current stack 21jan94py
: curstack: ( 5bit -- )
Create , DOES> @ >curstack !stack ;
:A
%10000 curstack: s0
%10001 curstack: s1
%10010 curstack: s2
%10011 curstack: s3
\ Abbrevations 21jan94py
' #$7FFFFFFF Alias #max
' #$80000000 Alias #min
\ FP abbrevations 21jan94py
[A]
: fabs and #max ;
: fneg xor #min ;
: f2* add c3 ;
: f2/ sub c3 ;
\ ALU abbrevations 21jan94py
: nop or #0 ;
: not xor #-1 ;
: neg subr #0 ;
: inc sub #-1 ;
: dec add #-1 ;
\ Stack abbrevations 21jan94py
: dup pick s0 ;
: over pick s1 ;
: swap pick s1p ;
: rot pick s2p ;
: drop pin s0 ;
: nip pin s1 ;
\ ret 19mar94py
: ret ( -- ) >call ip! ;
[F]
:D
\ Literals 21mar94py
: !a/d ( 10bit -- ) ?finish
alu? IF $200 or !alu ELSE !data THEN ;
Create lits 0. 2, 0. 2, 0. 2, 0. 2, 0. 2, 0. 2,
:A
: # ( 8bit -- ) dup $80 -$80 within abort" out of range"
$FF and !a/d ;
: #< ( 8bit -- ) dup $100 0 within abort" out of range"
$100 or !a/d ;
: ## ( 32bit -- ) ?finish 3
BEGIN over $FF800000 and dup $FF800000 = swap 0= or WHILE
1- swap 8 lshift swap dup 0= UNTIL THEN
swap $100 um* dup $80 and negate or >r
swap lits instfield @ 2* cells + 2! r> [A] # [F] ;
: #, ( -- ) ?finish lits instfield @ 2* cells + dup 2@ dup 0>
IF over 0= alu? and
IF dup 3 = IF hib 2drop 0 0 rot 2! EXIT THEN
dup 2 = IF hih 2drop 0 0 rot 2! EXIT THEN THEN
1- >r $100 um* #< r> rot 2!
ELSE 2drop drop alu? IF nop ELSE 0 # THEN THEN ;
:D
: >ip.b ( -- )
bl word count sym-lookup? dup 0= abort" No symbol!"
>body cell+ @ @ 4here 2 cells + - ;
:A
: .ip.b# ( -- ) >ip.b [A] # [F] ;
: .ip.h# ( -- ) >ip.b 2/ [A] # [F] ;
: .ip.w# ( -- ) >ip.b 2/ 2/ [A] # [F] ;
: .ip.2# ( -- ) >ip.b 2/ 2/ 2/ [A] # [F] ;
: .ip.4# ( -- ) >ip.b 2/ 2/ 2/ 1+ 2/ [A] # [F] ;
' .ip.2# alias .ip.d#
' .ip.2# alias .ip.f#
' .ip.4# alias .ip.q#
' .ip.4# alias .ip.2f#
:D
Variable procstart
: >p.b ( -- )
bl word count sym-lookup? dup 0= abort" No symbol!"
>body cell+ @ @ procstart @ - ;
:A
: .proc finish? 4here procstart ! ;
: .p ( -- n ) >p.b ;
: .p.b# ( -- ) >p.b [A] # [F] ;
: .p.h# ( -- ) >p.b 2/ [A] # [F] ;
: .p.w# ( -- ) >p.b 2/ 2/ [A] # [F] ;
: .p.2# ( -- ) >p.b 2/ 2/ 2/ [A] # [F] ;
: .p.4# ( -- ) >p.b 2/ 2/ 2/ 2/ [A] # [F] ;
' .p.2# alias .p.d#
' .p.2# alias .p.f#
' .p.4# alias .p.q#
' .p.4# alias .p.2f#
: .p.b## ( -- ) >p.b [A] ## [F] ;
: .p.h## ( -- ) >p.b 2/ [A] ## [F] ;
: .p.w## ( -- ) >p.b 2/ 2/ [A] ## [F] ;
: .p.2## ( -- ) >p.b 2/ 2/ 2/ [A] ## [F] ;
: .p.4## ( -- ) >p.b 2/ 2/ 2/ 2/ [A] ## [F] ;
' .p.2## alias .p.d##
' .p.2## alias .p.f##
' .p.4## alias .p.q##
' .p.4## alias .p.2f##
:D
\ data instructions 20mar94py
: cu ( -- n ) instfield @ 1- 1 and IF 4 ELSE 8 THEN ;
: move: ( n -- ) Create ,
DOES> @ !data cu ibuf cell+ tuck @ or swap ! ;
: moves: -rot ?DO I move: dup +LOOP drop ;
:A
%0010000000 %0000000000 %100000 moves: ldb ldh ld ld2
%1010000000 %1000000000 %100000 moves: stb sth st st2
' ld2 Alias ldf
' ld2 Alias ldq
' st2 Alias stf
' st2 Alias stq
:D
\ data instructions 22mar94py
: ua: ( n -- ) Create , DOES> @ !data ;
: uas: ( e s i -- ) -rot ?DO i ua: dup +LOOP drop ;
:A
%1000010000 %1000000000 %100 uas: R0= R1= R2= R3=
%1001000000 ua: get
%1001010000 ua: set
%1001100000 ua: getd
%1001110000 ua: setd
%1010010000 %1010000000 %100 uas: ccheck cclr cstore cflush
%1010100000 %1010010100 %100 uas: cload calloc cxlock
%1010011000 %1010010000 %100 uas: mccheck mdcheck
%1010011100 %1010011000 %001 uas: mcget mcset mchif mclof
%1010100000 %1010011100 %001 uas: mdget mdset mdhif mdlof
%1011100000 %1011000000 %100 uas: inb inh in ind outb outh out outd
%1011000011 %1011000001 %1 uas: inq ins
%1011100100 %1011100000 %1 uas: =c0 =c1 =c2 =c3
%1011101000 ua: geta
%1011111000 ua: seta
%1011101100 ua: getdrn
%1011111100 ua: setdrn
%1111101100 ua: getdmf
%1111111100 ua: setdmf
%1011100100 ua: getc
%1011110100 ua: setc
%1011100101 ua: stop
%1011110101 ua: restart
%1011100110 ua: stop1
%1011110110 ua: restart1
%1011100111 ua: halt
:D
\ data instructions 20mar94py
: |inst ( 10bit n -- )
dup 0= abort" Only after moves!"
instfield @ >r instfield !
instshift ibuf 2@ 2or ibuf 2! r> instfield ! ;
: mode: Create , DOES> @ lastmove @ |inst ;
: modes: DO I mode: 4 +LOOP ;
: regs: DO I mode: LOOP ;
:A
$10 $04 modes: +N N+ +N+
$20 $14 modes: +s0 s0+ +s0+
$10 $00 regs: R0 R1 R2 R3 N0 N1 N2 N3 L0 L1 L2 L3 F0 F1 F2 F3
$14 $10 regs: ip s0b ip+s0 s0l
:D
\ data instructions 22mar94py
: ua-only true abort" Only for update!" ;
: umode: >in @ >r name sfind r> >in ! Create
0= IF ['] ua-only THEN swap , ,
DOES> dup @ lastmove @ 1 and IF 4 ELSE 8 THEN
ibuf cell+ @ and IF drop cell+ @ execute EXIT THEN
lastmove @ |inst drop ;
:A
%0100000000 umode: +N
%0000010000 umode: +s0
%0000100000 umode: -N
%0000110000 umode: -s0
:D
\ data instructions 20mar94py
: stevnop: ( n -- ) Create ,
DOES> @ lastmove @ 4 <> abort" Only even stacks!" 4 |inst ;
: stoddop: ( n -- ) Create ,
DOES> @ lastmove @ 5 <> abort" Only odd stacks!" 5 |inst ;
: stevnops: ( end start disp -- ) -rot
DO I stevnop: dup +LOOP drop ;
: stoddops: ( end start disp -- ) -rot
DO I stoddop: dup +LOOP drop ;
:A
%1000000000 %0000000000 %0010000000 stevnops: 0: 0&2: 2: 2&0:
%1000000000 %0000000000 %0010000000 stoddops: 1: 1&3: 3: 3&1:
:D
\ data definition instructions 24apr94py
Defer normal-mode
Defer char-mode
: number-mode ( n dest char -- n' dest' )
\ ." Number: " dup emit cr
dup toupper digit?
IF nip rot base @ * + dup $10000 >=
IF normal-mode $100 THEN swap EXIT THEN
>r tuck caddr 'c! 1+ $100 swap r> normal-mode ;
: esc-mode ( dest char -- dest' )
\ ." Escape: " dup emit cr
dup 'n = IF drop #lf normal-mode EXIT THEN
dup 't = IF drop #tab normal-mode EXIT THEN
dup 'x = IF drop hex ['] number-mode IS char-mode EXIT THEN
dup '0 '8 within
IF 8 base ! ['] number-mode IS char-mode char-mode EXIT THEN
$100 + normal-mode ;
: (normal-mode) ( dest char -- dest' )
\ ." Char : " dup emit cr
dup '\ = IF drop ['] esc-mode IS char-mode EXIT THEN
over caddr 'c! 1+ ['] normal-mode IS char-mode ;
' (normal-mode) IS normal-mode
: \move ( addr len dest -- dest+n )
base @ >r ['] normal-mode IS char-mode
$100 swap 2swap bounds ?DO I c@ char-mode LOOP
over $FF and 0> IF tuck caddr 'c! 1+ ELSE nip THEN
r> base ! ;
: byte, 4there caddr 'c! 1 4allot ;
: short, $100 /mod 4there waddr 'c!
4there waddr 1+ 'c! 2 4allot ;
: int, 4there laddr '! 1 cells 4allot ;
: long, 4there laddr '! 1 cells 4allot ;
: quad, op, ;
\ : float, 4there laddr 'SF! 1 cells 4allot ;
\ : double, 4there 'F! 1 floats 4allot ;
: ascii, 4there \move 4there - 4allot ;
:A
: .align ( "n[,m]" -- ) 0 0 name >number
dup IF over c@ ', =
IF 1 /string parser 0 0 THEN THEN
2drop 1 rot lshift 4here over 1- >r - r> and
0 ?DO dup 4there caddr 'c! 1 4allot LOOP drop ;
: .( ') parse also Forth evaluate previous ;
: .byte name parser byte, ;
: .short name parser short, ;
: .int name parser int, ;
: .long name parser long, ;
: .quad name s>number dpl @ 0= abort" Not a number" quad, ;
\ : .float name >float 0= abort" Not a FP number" float, ;
\ : .double name >float 0= abort" Not a FP number" double, ;
: .ascii '" parse 2drop
source >in @ /string over swap
BEGIN '" scan over 1- c@ '\ = over 0<> and WHILE
1 /string REPEAT >r
over - dup r> IF 1+ THEN >in +! ascii, ;
: .macro finish? also asmdefs also asm4stack definitions
: ;
: .end-macro postpone ; previous previous ; immediate restrict
: .include include ;
: .times{ ( n -- input n )
dup >r 1 > IF save-input THEN r> ;
: .}times ( input n -- input n-1 / 1 / )
1- dup 0>
IF >r restore-input throw r@ 1 >
IF save-input THEN r>
THEN ;
:D
\ save assembler output 25apr94py
: (fdump ( handle link -- ) 2dup >r swap
3 cells + @ dup IF recurse ELSE 2drop THEN
r@ cell+ @ 0= IF rdrop drop EXIT THEN
\ cr ." Writing " r@ @ . ." len " r@ cell+ @ .
r@ cell+ @ 7 + -8 and r@ cell+ !
r@ 2 cells 2 pick write-file throw
r@ cell+ cell+ @ dup 7 and 2 = IF 2drop rdrop EXIT THEN
r> cell+ @ rot write-file throw ;
Create 4magic ," 4stack00"
\ end of assembler
Variable old-notfound
:A
: F' ' ;
also Forth definitions
: (code)
also asm4stack
s" F' 2@ F' 2! F' c! F' ! F' here F' allot" evaluate
IS 4allot IS 4here IS '! IS 'c! IS '2! IS '2@
What's interpreter-notfound old-notfound !
['] ?label IS interpreter-notfound ;
: label (code) 4here label: drop asm4stack depth ;
: (end-code) previous old-notfound @ IS interpreter-notfound ;
previous previous previous Forth
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>