Commit 3d3905a5 authored by pazsan's avatar pazsan

Added a interpreter trace (traceall)

Worked at getting EC Gforth working again.
parent 9d84f9d8
......@@ -26,8 +26,8 @@ Defer 4allot
: 4there 4here ;
: op, 4there '2! 2 cells 4allot ;
: op! '2! ;
: op, 4there op! 2 cells 4allot ;
: op@ '2@ ;
: caddr ; immediate
: waddr ; immediate
......@@ -694,13 +694,13 @@ Variable old-notfound
also Forth definitions
: (code)
also asm4stack also
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 previous old-notfound @ IS interpreter-notfound ;
: (end-code) previous old-notfound @ IS interpreter-notfound ;
previous previous previous Forth
......@@ -21,7 +21,7 @@
4 Constant cell
2 Constant cell<<
5 Constant cell>bit
8 Constant bits/byte
8 Constant bits/char
8 Constant float
8 Constant /maxalign
true Constant bigendian
......
\ 4stack primitives
Label start ;;
nop ;; first opcode must be a nop!
$80000000 ## ;;
#, ;;
sr! jmpa $818 >IP ;;
Label start
nop ;; first opcode must be a nop!
$80000000 ## ;;
#, ;;
sr! jmpa $818 >IP ;;
$800 .org
ip0: .int 0
......@@ -48,7 +48,11 @@ docon: ;;
drop nop nop nop ;;
end-code
-2 Alias: :docol
-3 Alias: :docon
-4 Alias: :dovar
-8 Alias: :dodoes
-9 Alias: :doesjump
Code execute ( xt -- )
ip! nop nop nop ;;
......@@ -120,7 +124,7 @@ end-code
\ obligatory IO
Code key?
Code (key?)
nop nop nop nop inb R3 3 # ;;
nop ip! nop nop 0 # ld 1: R1 N+ ;;
0<> nop nop nop ;;
......
......@@ -11,7 +11,7 @@ Variable imagesize
BEGIN
8 +
magic 8 r@ read-file throw 8 = WHILE
magic 8 s" Gforth14" compare 0= UNTIL
magic 8 s" Gforth2" compare 0= UNTIL
ELSE true abort" Magic not found!" THEN rdrop ;
Create bits $80 c, $40 c, $20 c, $10 c, $08 c, $04 c, $02 c, $01 c,
......
......@@ -11,7 +11,7 @@ Variable imagesize
BEGIN
8 +
magic 8 r@ read-file throw 8 = WHILE
magic 8 s" Gforth14" compare 0= UNTIL
magic 8 s" Gforth2" compare 0= UNTIL
ELSE true abort" Magic not found!" THEN rdrop ;
Create bits $80 c, $40 c, $20 c, $10 c, $08 c, $04 c, $02 c, $01 c,
......
......@@ -8,33 +8,35 @@
2 Constant cell
1 Constant cell<<
4 Constant cell>bit
8 Constant bits/byte
8 Constant bits/char
8 Constant float
2 Constant /maxalign
false Constant bigendian
false Constant bigendian
( true=big, false=little )
: prims-include ." Include primitives" cr s" arch/8086/prim.fs" included ;
: asm-include ." Include assembler" cr s" arch/8086/asm.fs" included ;
: >boot s" ' boot >body into-forth 1+ !" evaluate ;
false Constant NIL
>ENVIRON
false SetValue relocate
true SetValue ec
false SetValue file
false SetValue OS
false SetValue prims
false SetValue floating
false SetValue glocals
false SetValue dcomps
false SetValue hash
false SetValue xconds
false SetValue header
true SetValue interpreter
true SetValue crlf
true SetValue ITC
\ true SetValue has-rom
false Constant relocate
true Constant ec
false Constant file
false Constant OS
false Constant prims
false Constant floating
false Constant glocals
false Constant dcomps
false Constant hash
false Constant xconds
false Constant header
true Constant interpreter
true Constant crlf
true Constant ITC
\ true Constant has-rom
cell 2 = [IF] 32 [ELSE] 256 [THEN] KB Constant kernel-size
......
#! /bin/sh
tail -c +257 <$1- >gf8086.com
cp $1- gf8086.com
cp $1- $1
\ No newline at end of file
......@@ -410,7 +410,7 @@ end-macros
\ additon io routines
Code key? ( -- f ) \ check for read sio character
Code (key?) ( -- f ) \ check for read sio character
tos push, lastkey # tos mov,
1 tos d) ah mov, ah ah or,
0= IF, $ff # dl mov, 6 # ah mov, $21 int,
......@@ -436,3 +436,4 @@ end-macros
0 # al mov, $4c # ah mov, $21 int,
End-Code
-9 Alias: :doesjump
......@@ -21,7 +21,7 @@
4 Constant cell
2 Constant cell<<
5 Constant cell>bit
8 Constant bits/byte
8 Constant bits/char
8 Constant float
4 Constant /maxalign
true Constant bigendian
......
......@@ -1222,7 +1222,7 @@ T has? relocate H
: c@ ( taddr -- char ) >image Sc@ ;
: c! ( char taddr -- ) >image Sc! ;
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ;
: 2! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ;
\ Target compilation primitives 06oct92py
\ included A! 16may93jaw
......
......@@ -18,6 +18,10 @@
\ along with this program; if not, write to the Free Software
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
\ !! use a separate exception stack? anton
\ user-definable rollback actions
Defer 'catch
Defer 'throw
......@@ -32,8 +36,8 @@ Defer store-backtrace
: (try) ( -- )
\ inline argument: address of the handler
r>
'catch
dup dup @ + >r \ recovery address
rp@ 'catch >r
sp@ >r
fp@ >r
lp@ >r
......@@ -52,6 +56,7 @@ Defer store-backtrace
rdrop \ lp
rdrop \ fp
rdrop \ sp
r> rp!
rdrop \ recovery address
>r ;
......@@ -85,7 +90,7 @@ is catch
r> lp!
r> fp!
r> swap >r sp! drop r>
'throw
rdrop 'throw
THEN ;
is throw
......@@ -189,10 +189,6 @@ Constant dictionary-end
um/mod r> ;
\ catch throw 23feb93py
\ bounce 08jun93jaw
\ !! allow the user to add rollback actions anton
\ !! use a separate exception stack? anton
has? glocals [IF]
: lp@ ( -- addr ) \ gforth lp-fetch
......@@ -207,8 +203,10 @@ is catch
defer throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
:noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error )
?dup if
[ here forthstart 9 cells + ! ]
cr .error cr 1 (bye)
[ has? ec 0= [IF] here forthstart 9 cells + ! [THEN] ]
cr .error cr
[ has? file [IF] ] script? IF 1 (bye) ELSE quit THEN
[ [ELSE] ] quit [ [THEN] ]
then ;
is throw
......
......@@ -27,8 +27,8 @@
Create mach-file here over 1+ allot place
require ./../errors.fs
require ./../search.fs
require ./../errors.fs
require ./../extend.fs
\ include etags.fs
......@@ -67,7 +67,7 @@ has? prims [IF]
[ELSE]
prims-include
undef-words
include ./prim.fs
include prim.fs
all-words UNLOCK LOCK
[THEN]
doc-on
......
\ replacement for name
: trace-name .s ." | " source >in @ /string type cr (name) ;
: traceall ['] trace-name IS name ;
: notrace [ what's name ] Literal IS name ;
\ No newline at end of file
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment