diff --git a/boot.jim b/boot.jim index fc63328..4a4ad68 100755 Binary files a/boot.jim and b/boot.jim differ diff --git a/debug.jim b/debug.jim new file mode 100755 index 0000000..40e8fe1 Binary files /dev/null and b/debug.jim differ diff --git a/debug.jor b/debug.jor new file mode 100755 index 0000000..52584b8 --- /dev/null +++ b/debug.jor @@ -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 execute 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 r@ breakpoint# reset-breakpoint + while dup @ . cell + repeat 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 -- ) over task-ip ! dup task-stack over task-sp ! diff --git a/end.jim b/end.jim index 6074149..a7f3f09 100755 Binary files a/end.jim and b/end.jim differ diff --git a/entity.jim b/entity.jim index 10fd98f..83ddae2 100755 Binary files a/entity.jim and b/entity.jim differ diff --git a/footer.jim b/footer.jim index ac3359b..696c590 100755 Binary files a/footer.jim and b/footer.jim differ diff --git a/game.jim b/game.jim index 3e51d88..5e3d286 100755 Binary files a/game.jim and b/game.jim differ diff --git a/gameboot.jor b/gameboot.jor index 20e5c2d..c2d989f 100755 --- a/gameboot.jor +++ b/gameboot.jor @@ -28,19 +28,15 @@ s" map.jor" loadfile s" state.jor" loadfile s" jiles.jor" loadfile s" job.jor" loadfile +s" level.jor" loadfile s" game.jor" loadfile +s" debug.jor" loadfile ; execute -intern lev00001.jor -intern lev00002.jor -intern lev00003.jor -intern lev00004.jor -intern lev00005.jor -intern end.jor - -:noname loadfile ; checkpoint _loadlevel +' load-new-level checkpoint _loadlevel ' _loadlevel ' loadlevel redefine -lev00005.jor loadlevel +reset-level +6 loadlevel draw unfuck load-footer diff --git a/input.jim b/input.jim index 4f97754..88d958c 100755 Binary files a/input.jim and b/input.jim differ diff --git a/jiles.jim b/jiles.jim index f4dfd60..ead598b 100755 Binary files a/jiles.jim and b/jiles.jim differ diff --git a/job.jim b/job.jim index 25101be..7d46002 100755 Binary files a/job.jim and b/job.jim differ diff --git a/jorth.c b/jorth.c index 4f551bf..41ca63e 100755 --- a/jorth.c +++ b/jorth.c @@ -1077,6 +1077,18 @@ void f_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) { f_calc_imagemagic(exe); @@ -1208,6 +1220,7 @@ void f_init(char *exe) { CDEF("rstacksize", f_rstacksize); CDEF("task-user-size", f_taskusersize); CDEF("rand", f_rand); + CDEF("emulate", f_emulate); PCONST("$DOCREATE", f_docreate); PCONST("$DOVAR", f_dovar); PCONST("$DODEFERRED", f_dodeferred); diff --git a/lev00001.jim b/lev00001.jim new file mode 100755 index 0000000..cba1b68 Binary files /dev/null and b/lev00001.jim differ diff --git a/lev00001.jor b/lev00001.jor index 25f077b..1c3bdc4 100755 --- a/lev00001.jor +++ b/lev00001.jor @@ -24,7 +24,7 @@ defer last-term ' c1 1 4 computer c2 ' c2 ' last-term redefine -lev00002.jor 10 0 exitdoor dexit +2 10 0 exitdoor dexit ' dexit 9 0 scanner sexit d1 :noname @@ -61,7 +61,6 @@ sexit :noname :noname O - s" lev00001.map" load-map 0 player.state HASNEUT f! 14 9 tile>world Jaye entity.pos! c1 entity>pos Neut entity.pos! diff --git a/lev00002.jor b/lev00002.jor index 6ebc48a..3952e18 100755 --- a/lev00002.jor +++ b/lev00002.jor @@ -13,7 +13,7 @@ objects: O 2 6 door d9 4 2 door d10 -lev00003.jor 7 0 exitdoor dx +3 7 0 exitdoor dx ' dx 6 0 scanner sx defer c10 ' c10 5 1 computer cx @@ -50,7 +50,6 @@ c2 :noname :noname O - s" lev00002.map" load-map 11 11 tile>world Jaye entity.pos! 10 12 tile>world Neut entity.pos! diff --git a/lev00003.jim b/lev00003.jim new file mode 100755 index 0000000..755319d Binary files /dev/null and b/lev00003.jim differ diff --git a/lev00003.jor b/lev00003.jor index 7c1740e..835dceb 100755 --- a/lev00003.jor +++ b/lev00003.jor @@ -17,7 +17,7 @@ defer c1 ' c1 8 3 computer c3 ' c3 12 11 computer c2 ' c2 5 7 computer _c1 ' _c1 ' c1 redefine -lev00004.jor 0 4 exitdoor dx +4 0 4 exitdoor dx ' dx 0 5 scanner sx 5 2 defrexx Rexx @@ -120,7 +120,6 @@ var gord-up gord say" Let's go." then |; listener! - s" lev00003.map" load-map 7 11 tile>world Jaye entity.pos! 6 12 tile>world Neut entity.pos! 6 7 tile>world Gord entity.pos! diff --git a/lev00004.jim b/lev00004.jim new file mode 100755 index 0000000..ac0a4db Binary files /dev/null and b/lev00004.jim differ diff --git a/lev00004.jor b/lev00004.jor index fb28733..40be8d1 100755 --- a/lev00004.jor +++ b/lev00004.jor @@ -5,7 +5,7 @@ objects: O 15 6 door d1 11 6 door d2 10 4 door d3 -lev00005.jor 0 4 exitdoor dx +5 0 4 exitdoor dx 15 11 defrexx Rexx @@ -36,7 +36,6 @@ var first-gord-sit then |; ' on-gord-sit redefine - s" lev00004.map" load-map 18 4 tile>world Jaye entity.pos! 19 5 tile>world Neut entity.pos! with-gord diff --git a/lev00005.jim b/lev00005.jim index f1eb603..4fbccdc 100755 Binary files a/lev00005.jim and b/lev00005.jim differ diff --git a/lev00005.jor b/lev00005.jor index 3bc7589..04d4228 100755 --- a/lev00005.jor +++ b/lev00005.jor @@ -11,7 +11,7 @@ lazy 60 over 19 9 timedswitch ts 10 9 door d2 5 6 door d3 >lazy! 10 2 door d4 -end.jor 5 12 exitdoor dx +LEV_END 5 12 exitdoor dx lazy dup 11 3 computer c1 ' c1 7 11 computer c2 >lazy! @@ -104,7 +104,6 @@ d2 :noname ' touch ' touch-override redefine - s" lev00005.map" load-map 18 4 tile>world Jaye entity.pos! 19 5 tile>world Neut entity.pos! with-gord diff --git a/lev00006.jim b/lev00006.jim new file mode 100755 index 0000000..edb7f3c Binary files /dev/null and b/lev00006.jim differ diff --git a/lev00006.jor b/lev00006.jor new file mode 100755 index 0000000..13a4e69 --- /dev/null +++ b/lev00006.jor @@ -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 diff --git a/lev00006.map b/lev00006.map new file mode 100755 index 0000000..9dc6380 Binary files /dev/null and b/lev00006.map differ diff --git a/lev16597.jim b/lev16597.jim new file mode 100755 index 0000000..b4d632f Binary files /dev/null and b/lev16597.jim differ diff --git a/lev16597.jor b/lev16597.jor new file mode 100755 index 0000000..e69de29 diff --git a/lev16603.jim b/lev16603.jim new file mode 100755 index 0000000..60a0e98 Binary files /dev/null and b/lev16603.jim differ diff --git a/lev16603.jor b/lev16603.jor new file mode 100755 index 0000000..e69de29 diff --git a/lev16625.jor b/lev16625.jor new file mode 100755 index 0000000..e69de29 diff --git a/lev16631.jor b/lev16631.jor new file mode 100755 index 0000000..e69de29 diff --git a/level.jim b/level.jim new file mode 100755 index 0000000..7b4f45e Binary files /dev/null and b/level.jim differ diff --git a/level.jor b/level.jor new file mode 100755 index 0000000..8e4a501 --- /dev/null +++ b/level.jor @@ -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 ; diff --git a/map.jim b/map.jim index a379f82..3544aec 100755 Binary files a/map.jim and b/map.jim differ diff --git a/map.jor b/map.jor index f757752..fe7f578 100755 --- a/map.jor +++ b/map.jor @@ -27,13 +27,14 @@ array tileflags ( 14:chair-brok ) RUBBLE b, ( 15:bookcase ) 0 b, ( 16:bookcase-broke ) RUBBLE b, -( 17:scattered books ) WALKABLE b, +( 17:scattered books ) WALKABLE RUBBLE | b, ( 18:plant ) 0 b, ( 19:tipped plant ) RUBBLE b, ( 20:scanner-off ) NEUTABLE b, ( 21:scanner-on ) NEUTABLE b, ( 22:cracked-wall ) 0 b, ( 23:rexx-pod ) NEUTABLE b, +( 24:keypad ) NEUTABLE b, here tileflags - 1 - const MAXTILE diff --git a/neuttowr.exe b/neuttowr.exe index 8d6f8ea..206f56c 100755 Binary files a/neuttowr.exe and b/neuttowr.exe differ diff --git a/neuttowr.prj b/neuttowr.prj index 4df0f32..be3d990 100755 Binary files a/neuttowr.prj and b/neuttowr.prj differ diff --git a/ntiles.gfx b/ntiles.gfx index 9bc9ffe..a65f9e2 100755 Binary files a/ntiles.gfx and b/ntiles.gfx differ diff --git a/state.jim b/state.jim index 01b387b..ff58fa7 100755 Binary files a/state.jim and b/state.jim differ diff --git a/testbed.c b/testbed.c index e16f6c9..da126fb 100755 --- a/testbed.c +++ b/testbed.c @@ -764,7 +764,6 @@ int main(int argc, char *argv[]) { while (!keyIsDown(K_ESC)) { kbd_debounce(); f_poll(); - f_taskloop(); f_execcp(tick); f_taskloop(); f_execcp(draw); diff --git a/tiles.gfx b/tiles.gfx index c8076c4..12b55ac 100755 Binary files a/tiles.gfx and b/tiles.gfx differ diff --git a/timer.jim b/timer.jim index 0fa4cca..dbe4169 100755 Binary files a/timer.jim and b/timer.jim differ