step-through debugger! level 6! level loading by number!

This commit is contained in:
Jeremy Penner 2020-03-24 23:46:09 -04:00
parent 1bb88c35f0
commit 64d21bc875
43 changed files with 182 additions and 29 deletions

BIN
boot.jim

Binary file not shown.

BIN
debug.jim Executable file

Binary file not shown.

98
debug.jor Executable file
View file

@ -0,0 +1,98 @@
( xp -- execution pointer - pointer to word definition
ip -- instruction pointer - pointer to pointer to word def
fp -- C function pointer used to drive the VM )
var brk-xp
var dbg-ip
var dbg-task
defer dbg-cmd
: dbg-first-ip ( xp -- [ip|0] )
dup cell + swap @ ( worddata fp )
dup $DOCOLON = if drop else
dup $DOCREATE = if drop @ else
$DODEFERRED = if @ dbg-first-ip else
drop 0 then then then ;
: tail :| rdrop dbg-first-ip >r |; , [ ' [ , ] ; immediate
: get-dbg-xp ( ip -- xp ) brk-xp @ not if @ else drop brk-xp @ then ;
: consume-dbg-xp ( ip -- xp ) get-dbg-xp 0 brk-xp ! ;
: DBG-WAIT ( ip -- ip )
running dbg-task !
' DBG-WAIT ' dbg-cmd redefine
dup dbg-ip !
suspend
' dbg-cmd tail
: .dbg ( ip -- ip )
cr dup .wordin s" ip: " type dup . dup get-dbg-xp ` type cr
>r .s <r cr ;
: debugger <r .dbg ' DBG-WAIT tail userword
: debug ( xp -- ) dbg-first-ip .dbg ' DBG-WAIT tail userword
: DBG-STEP-IN ( ip -- ip ) dup consume-dbg-xp swap emulate .dbg ' DBG-WAIT tail
: DBG-STEP-OVER ( ip -- ip )
dup consume-dbg-xp swap over dbg-first-ip not if ( xp ip )
emulate ( is primitive - can't step over )
else
>r execute <r cell +
then .dbg ' DBG-WAIT tail
: DBG-RUN-TO-END ( ip -- ) [ ' debugger dbg-first-ip lit ] >r >r ;
: DBG-CONT ( ip -- ) >r ;
: s ' DBG-STEP-IN ' dbg-cmd redefine ; userword
: n ' DBG-STEP-OVER ' dbg-cmd redefine ; userword
: c ' DBG-CONT ' dbg-cmd redefine ; userword
: u ' DBG-RUN-TO-END ' dbg-cmd redefine ; userword
: bt dbg-task @ task.bt ; userword
: l dbg-ip @ decompile-from ; userword
: bp.do 2 cells - ;
: bp.ip ; immediate
: bp.xp cell + ;
( byte golfing is annoyingly satisfying - we don't need or want $DOCOLON
at the start nor ret at the end, so instead of using an inline function
or a :noname, we just turn on the compiler with "]" and go. )
here ] bp.xp @ brk-xp ! <r cell - .dbg ' DBG-WAIT tail
: bp, $DOCREATE , [ lit ] , 0 , 0 , ;
array breakpoints bp, bp, bp, bp, bp,
5 const MAX-BREAKPOINTS
: breakpoint# ( n -- p ) 4 * 2 + cells breakpoints + ;
: clear-breakpoint ( bp -- )
dup bp.ip @ if
dup bp.xp @ over bp.ip @ !
0 over bp.ip ! 0 swap bp.xp !
else drop then ;
: set-breakpoint ( ip bp -- )
over if
2dup bp.ip !
over @ over bp.xp !
bp.do swap !
else drop drop then ;
: reset-breakpoint ( ip bp -- ) dup clear-breakpoint set-breakpoint ;
: free-breakpoint 0 MAX-BREAKPOINTS 0 for
i 1 - breakpoint# bp.ip @ not if
drop i 1 -
then next ;
: set-next-breakpoint ( ip -- )
free-breakpoint >r r@ breakpoint# reset-breakpoint
<r s" bp " type . s" set" type cr ;
: b word lookup drop dbg-first-ip dup if set-next-breakpoint
else s" word not found" type cr drop then ; userword
: unb breakpoint# clear-breakpoint ; userword
: .bp 0 MAX-BREAKPOINTS for
i .
i breakpoint# bp.ip @ dup .
` type
i breakpoint# bp.xp @ ` type
cr
next ; userword

BIN
defs.jim

Binary file not shown.

View file

@ -97,15 +97,13 @@
begin r@ while <r <r swap ! repeat rdrop ; begin r@ while <r <r swap ! repeat rdrop ;
: preserve ( cp var -- ) 0 swap preserves ; : preserve ( cp var -- ) 0 swap preserves ;
: decompile-from ( ip -- )
begin dup @ ' ret != while
dup @ dup ` dup if type drop else drop . then bl
cell +
repeat drop ;
: decompile : decompile word lookup if cell + decompile-from else drop then ; userword
word lookup if 1 begin ( cp i )
2dup cells + @ ( cp i @cp+i )
dup ' ret != ( cp i @cp+i bool )
while
dup ` dup if type drop else drop . then bl ( cp i )
1 + ( cp i+1 )
repeat drop drop then drop ; userword
: words : words
latest links each latest links each
@ -139,6 +137,11 @@
begin 2dup > while dup @ . cell + repeat begin 2dup > while dup @ . cell + repeat
cr drop drop more ; userword cr drop drop more ; userword
: task.bt ( task -- )
dup task-rsp @ swap task-rstack ( rstackLim rstack )
begin 2dup > while dup @ dup . .wordin cr cell + repeat
drop drop ; userword
: doactivate ( task ip -- ) : doactivate ( task ip -- )
over task-ip ! over task-ip !
dup task-stack over task-sp ! dup task-stack over task-sp !

BIN
end.jim

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
game.jim

Binary file not shown.

View file

@ -28,19 +28,15 @@ s" map.jor" loadfile
s" state.jor" loadfile s" state.jor" loadfile
s" jiles.jor" loadfile s" jiles.jor" loadfile
s" job.jor" loadfile s" job.jor" loadfile
s" level.jor" loadfile
s" game.jor" loadfile s" game.jor" loadfile
s" debug.jor" loadfile
; execute ; execute
intern lev00001.jor ' load-new-level checkpoint _loadlevel
intern lev00002.jor
intern lev00003.jor
intern lev00004.jor
intern lev00005.jor
intern end.jor
:noname loadfile ; checkpoint _loadlevel
' _loadlevel ' loadlevel redefine ' _loadlevel ' loadlevel redefine
lev00005.jor loadlevel reset-level
6 loadlevel
draw unfuck load-footer draw unfuck load-footer

BIN
input.jim

Binary file not shown.

BIN
jiles.jim

Binary file not shown.

BIN
job.jim

Binary file not shown.

13
jorth.c
View file

@ -1077,6 +1077,18 @@ void f_rand() {
PUSHI(rand()); PUSHI(rand());
} }
// debugger support - emulate running the given word as if it had been
// executed from inside the part of the definition pointed to by ip
void f_emulate() { // cp ip -- ip
cell oldIP = IP;
IP = TOP();
DROP(1);
IP.p++;
f_execute();
PUSHP(IP.p);
IP = oldIP;
}
void f_init(char *exe) { void f_init(char *exe) {
f_calc_imagemagic(exe); f_calc_imagemagic(exe);
@ -1208,6 +1220,7 @@ void f_init(char *exe) {
CDEF("rstacksize", f_rstacksize); CDEF("rstacksize", f_rstacksize);
CDEF("task-user-size", f_taskusersize); CDEF("task-user-size", f_taskusersize);
CDEF("rand", f_rand); CDEF("rand", f_rand);
CDEF("emulate", f_emulate);
PCONST("$DOCREATE", f_docreate); PCONST("$DOCREATE", f_docreate);
PCONST("$DOVAR", f_dovar); PCONST("$DOVAR", f_dovar);
PCONST("$DODEFERRED", f_dodeferred); PCONST("$DODEFERRED", f_dodeferred);

BIN
lev00001.jim Executable file

Binary file not shown.

View file

@ -24,7 +24,7 @@ defer last-term
' c1 1 4 computer c2 ' c1 1 4 computer c2
' c2 ' last-term redefine ' c2 ' last-term redefine
lev00002.jor 10 0 exitdoor dexit 2 10 0 exitdoor dexit
' dexit 9 0 scanner sexit ' dexit 9 0 scanner sexit
d1 :noname d1 :noname
@ -61,7 +61,6 @@ sexit :noname
:noname O :noname O
s" lev00001.map" load-map
0 player.state HASNEUT f! 0 player.state HASNEUT f!
14 9 tile>world Jaye entity.pos! 14 9 tile>world Jaye entity.pos!
c1 entity>pos Neut entity.pos! c1 entity>pos Neut entity.pos!

View file

@ -13,7 +13,7 @@ objects: O
2 6 door d9 2 6 door d9
4 2 door d10 4 2 door d10
lev00003.jor 7 0 exitdoor dx 3 7 0 exitdoor dx
' dx 6 0 scanner sx ' dx 6 0 scanner sx
defer c10 ' c10 5 1 computer cx defer c10 ' c10 5 1 computer cx
@ -50,7 +50,6 @@ c2 :noname
:noname O :noname O
s" lev00002.map" load-map
11 11 tile>world Jaye entity.pos! 11 11 tile>world Jaye entity.pos!
10 12 tile>world Neut entity.pos! 10 12 tile>world Neut entity.pos!

BIN
lev00003.jim Executable file

Binary file not shown.

View file

@ -17,7 +17,7 @@ defer c1 ' c1 8 3 computer c3
' c3 12 11 computer c2 ' c3 12 11 computer c2
' c2 5 7 computer _c1 ' _c1 ' c1 redefine ' c2 5 7 computer _c1 ' _c1 ' c1 redefine
lev00004.jor 0 4 exitdoor dx 4 0 4 exitdoor dx
' dx 0 5 scanner sx ' dx 0 5 scanner sx
5 2 defrexx Rexx 5 2 defrexx Rexx
@ -120,7 +120,6 @@ var gord-up
gord say" Let's go." gord say" Let's go."
then |; listener! then |; listener!
s" lev00003.map" load-map
7 11 tile>world Jaye entity.pos! 7 11 tile>world Jaye entity.pos!
6 12 tile>world Neut entity.pos! 6 12 tile>world Neut entity.pos!
6 7 tile>world Gord entity.pos! 6 7 tile>world Gord entity.pos!

BIN
lev00004.jim Executable file

Binary file not shown.

View file

@ -5,7 +5,7 @@ objects: O
15 6 door d1 15 6 door d1
11 6 door d2 11 6 door d2
10 4 door d3 10 4 door d3
lev00005.jor 0 4 exitdoor dx 5 0 4 exitdoor dx
15 11 defrexx Rexx 15 11 defrexx Rexx
@ -36,7 +36,6 @@ var first-gord-sit
then then
|; ' on-gord-sit redefine |; ' on-gord-sit redefine
s" lev00004.map" load-map
18 4 tile>world Jaye entity.pos! 18 4 tile>world Jaye entity.pos!
19 5 tile>world Neut entity.pos! 19 5 tile>world Neut entity.pos!
with-gord with-gord

Binary file not shown.

View file

@ -11,7 +11,7 @@ lazy 60 over 19 9 timedswitch ts
10 9 door d2 10 9 door d2
5 6 door d3 >lazy! 5 6 door d3 >lazy!
10 2 door d4 10 2 door d4
end.jor 5 12 exitdoor dx LEV_END 5 12 exitdoor dx
lazy dup 11 3 computer c1 lazy dup 11 3 computer c1
' c1 7 11 computer c2 >lazy! ' c1 7 11 computer c2 >lazy!
@ -104,7 +104,6 @@ d2 :noname
' touch ' touch-override redefine ' touch ' touch-override redefine
s" lev00005.map" load-map
18 4 tile>world Jaye entity.pos! 18 4 tile>world Jaye entity.pos!
19 5 tile>world Neut entity.pos! 19 5 tile>world Neut entity.pos!
with-gord with-gord

BIN
lev00006.jim Executable file

Binary file not shown.

8
lev00006.jor Executable file
View file

@ -0,0 +1,8 @@
( L E V E L 0 0 0 0 6 )
:noname
5 1 tile>world Jaye entity.pos!
4 0 tile>world Neut entity.pos!
with-gord
; ' onload redefine

BIN
lev00006.map Executable file

Binary file not shown.

BIN
lev16597.jim Executable file

Binary file not shown.

0
lev16597.jor Executable file
View file

BIN
lev16603.jim Executable file

Binary file not shown.

0
lev16603.jor Executable file
View file

0
lev16625.jor Executable file
View file

0
lev16631.jor Executable file
View file

BIN
level.jim Executable file

Binary file not shown.

40
level.jor Executable file
View file

@ -0,0 +1,40 @@
array levelfile 13 allot
var ilevelfile
: emit-levelfile ( c -- )
dup sp != if
ilevelfile @ levelfile + b!
1 ilevelfile +!
0 ilevelfile @ levelfile + b!
else drop then ;
: 0padplace ( n place -- ) < if [ key 0 lit ] emit then ;
: 0pad ( n -- )
dup 10 0padplace
dup 100 0padplace
dup 1000 0padplace
dup 10000 0padplace
. ;
: genlevelfn ( n ext -- s )
0 ilevelfile !
task-emit @ >rot ' emit-levelfile task-emit !
s" lev" type swap 0pad type
task-emit ! levelfile ;
: levelsrc ( n -- ) s" .jor" genlevelfn ;
: levelmap ( n -- ) s" .map" genlevelfn ;
intern end.jor
-1 const LEV_END
var current-level
: load-new-level ( n -- )
dup current-level !
dup 0 > if dup levelmap load-map then
dup LEV_END =
if drop end.jor
else levelsrc
then loadfile ;
: save-level ( -- ) current-level @ levelmap save-map ;

BIN
map.jim

Binary file not shown.

View file

@ -27,13 +27,14 @@ array tileflags
( 14:chair-brok ) RUBBLE b, ( 14:chair-brok ) RUBBLE b,
( 15:bookcase ) 0 b, ( 15:bookcase ) 0 b,
( 16:bookcase-broke ) RUBBLE b, ( 16:bookcase-broke ) RUBBLE b,
( 17:scattered books ) WALKABLE b, ( 17:scattered books ) WALKABLE RUBBLE | b,
( 18:plant ) 0 b, ( 18:plant ) 0 b,
( 19:tipped plant ) RUBBLE b, ( 19:tipped plant ) RUBBLE b,
( 20:scanner-off ) NEUTABLE b, ( 20:scanner-off ) NEUTABLE b,
( 21:scanner-on ) NEUTABLE b, ( 21:scanner-on ) NEUTABLE b,
( 22:cracked-wall ) 0 b, ( 22:cracked-wall ) 0 b,
( 23:rexx-pod ) NEUTABLE b, ( 23:rexx-pod ) NEUTABLE b,
( 24:keypad ) NEUTABLE b,
here tileflags - 1 - const MAXTILE here tileflags - 1 - const MAXTILE

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
state.jim

Binary file not shown.

View file

@ -764,7 +764,6 @@ int main(int argc, char *argv[]) {
while (!keyIsDown(K_ESC)) { while (!keyIsDown(K_ESC)) {
kbd_debounce(); kbd_debounce();
f_poll(); f_poll();
f_taskloop();
f_execcp(tick); f_execcp(tick);
f_taskloop(); f_taskloop();
f_execcp(draw); f_execcp(draw);

BIN
tiles.gfx

Binary file not shown.

BIN
timer.jim

Binary file not shown.