level0/urforth0_w_dbginfo.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; currently, debug info is very simple, it contains only PC->LINE mapping
  20 ;;
  21 ;; header:
  22 ;;   dd itemcount  ; this may be used as "extended" later, so bit 31 is resv
  23 ;;
  24 ;; items:
  25 ;;   dd pc
  26 ;;   dd line
  27 ;;
  28 ;; itemcount bit 31 should always be 0
  29 ;;
  30 ;; the compiler doesn't store each PC, it only stores line changes
  31 ;; that is, the range for the line lasts until the next item
  32 ;; items should be sorted by PC (but the code should not fail on
  33 ;; unsorted data)
  34
  35
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37 urword_value "(DBGINFO-ENABLED?)",dbginfo_enabledq,1
  38 urword_hidden
  39
  40 urword_value "(DBG-BUF-PTR)", dbuf_addr,0
  41 urword_hidden
  42 urword_value "(DBG-BUF-SIZE)",dbuf_size,1024*64
  43 urword_hidden
  44 urword_value "(DBGINFO-ACTIVE?)",dbginfo_activeq,0
  45 urword_hidden
  46
  47
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 urword_forth "DEBUG-INFO-ON",debug_info_on
  50   UF 1
  51   urto dbginfo_enabledq
  52 urword_end
  53
  54 urword_forth "DEBUG-INFO-OFF",debug_info_off
  55   UF 0
  56   urto dbginfo_enabledq
  57 urword_end
  58
  59
  60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61 urword_forth "(DBGINFO-RESET)",debug_info_reset
  62 urword_hidden
  63 ;; ( -- )
  64   UF dbuf_size
  65   ur_if
  66     UF dbuf_addr 0poke
  67   ur_endif
  68   UF 0
  69   urto dbginfo_activeq
  70 urword_end
  71
  72
  73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74 urword_forth "(DBGINFO-GET-ADDR-SIZE)",debug_info_addr_size
  75 urword_hidden
  76 ;; ( -- addr bytes 1 )
  77 ;; ( -- 0 )
  78   UF dbginfo_activeq dbginfo_enabledq land
  79   ur_ifnot
  80     UF 0 exit
  81   ur_endif
  82   UF dbuf_size
  83   ur_ifnot
  84     UF 0 exit
  85   ur_endif
  86   UF dbuf_addr @ qdup
  87   ur_ifnot
  88     UF 0 exit
  89   ur_endif
  90   UF dup 0xffffffff equal
  91   ur_if
  92     UF drop 0 exit
  93   ur_endif
  94   ; convert to bytes
  95   UF 2 cells umul cellinc
  96   ; address
  97   UF dbuf_addr
  98   UF swap 1
  99 urword_end
 100
 101
 102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103 urword_forth "(DBGINFO-DUMP-AT)",debug_info_dump_at
 104 urword_hidden
 105 ;; ( addr -- )
 106   UF qdup
 107   ur_ifnot
 108     UF exit
 109   ur_endif
 110   UF dup @
 111   ur_ifnot
 112     UF drop exit
 113   ur_endif
 114   ; print counter
 115   UF rpush
 116   urprint "debug info containts "
 117   UF rpeek @ dot
 118   urprintnl "items"
 119   ; end
 120   UF rpeek @ 2 cells umul cellinc rpeek +
 121   ; start
 122   UF rpeek cellinc
 123   ur_do
 124     UF i dothex8
 125     urprint ": pc=0x"
 126     UF i @ dothex8
 127     urprint " at "
 128     UF i cellinc @ dot
 129     UF cr
 130   UF 2 cells
 131   ur_ploop
 132   UF rdrop
 133 urword_end
 134
 135
 136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 137 urword_forth "(DBGINFO-DUMP)",debug_info_dump
 138 urword_hidden
 139 ;; ( -- )
 140   UF dbuf_size
 141   ur_ifnot
 142     urprintnl "debug info disabled"
 143     UF 2drop exit
 144   ur_endif
 145   UF dbuf_addr @ qdup
 146   ur_ifnot
 147     urprintnl "no debug info"
 148     UF exit
 149   ur_endif
 150   UF 0xffffffff equal
 151   ur_if
 152     urprintnl "debug info overflowed"
 153     UF exit
 154   ur_endif
 155   UF dbuf_addr debug_info_dump_at
 156 urword_end
 157
 158
 159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 160 urword_forth "(DBGINFO-ADD-PC)",debug_info_add_pc
 161 urword_hidden
 162 ;; ( pc line -- )
 163   ; never put zero line
 164   UF qdup
 165   ur_ifnot
 166     UF drop exit
 167   ur_endif
 168   UF dbuf_size
 169   ur_ifnot
 170     UF 2drop exit
 171   ur_endif
 172   ; just inited?
 173   UF dbuf_addr @ qdup
 174   ur_ifnot
 175     ; yes, store the item
 176     ; assume that we always have room for at least one
 177     UF dbuf_addr 1poke
 178     UF swap dbuf_addr cellinc !
 179     UF dbuf_addr 2 addcells !
 180     UF exit
 181   ur_endif
 182   ; special? -1 items means "out of room"
 183   UF dup 0xffffffff equal
 184   ur_if
 185     UF drop 2drop exit
 186   ur_endif
 187   ; calculate address of the last item
 188   UF 1dec 2 cells umul cellinc dbuf_addr +
 189   ; check if the line is the same
 190   ;TODO: check for sorted PC here?
 191   UF 2dup cellinc @ equal
 192   ur_if
 193     ; no need to store this item
 194     UF drop 2drop exit
 195   ur_endif
 196   ; advance address
 197   UF 4 addcells
 198   ; check if we have enough room
 199   UF dup dbuf_size dbuf_addr + ugreat
 200   ur_if
 201     ; out of buffer, abort debug info generation
 202     UF drop 2drop 0xffffffff dbuf_addr ! exit
 203   ur_endif
 204   UF 2 subcells
 205   ; ok, we have enough room, store new item
 206     if 0
 207     UF rpush base @ rpush
 208     UF 2dup
 209     urprint "adding pc 0x"
 210     UF swap dothex8
 211     urprint " at line "
 212     UF dot cr
 213     UF rpop base ! rpop
 214     end if
 215   UF rot over !  cellinc !
 216   ; and increment the counter
 217   UF 1 dbuf_addr addpoke
 218 urword_end
 219
 220
 221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 222 urword_forth "(DBGINFO-ADD-HERE)",dbginfo_add_here
 223 urword_hidden
 224   ; put debug info
 225   UF dbginfo_activeq dbginfo_enabledq land
 226   ur_if
 227     UF here tiblineno @ debug_info_add_pc
 228   ur_endif
 229 urword_end