level1/19_dbg_info.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 ;; temp debug buffer just stores dword line and dword PC
   8
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10 ;; final info buffer:
  11 ;;
  12 ;; header:
  13 ;;   dw itemcount        ; files with more that 64kb lines? 'cmon!
  14 ;;   dw firstline        ; files with more that 64kb lines? 'cmon!
  15 ;;   dd filename-c1strz  ; this points to special hidden buffer word, or 0
  16 ;;
  17 ;; items:
  18 ;;   db pcoffs   ; offset from the previous PC (first: from the CFA)
  19 ;;   db lineofs  ; offset from the previous line
  20 ;;
  21 ;; if lineofs is 255, next word is 16-bit line offset
  22 ;; if pcofs is 255, next word is 16-bit line offset
  23 ;;
  24 ;; the compiler doesn't store each PC, it only stores line changes
  25 ;; that is, the range for the line lasts until the next item
  26 ;; items should be sorted by PC (but the code should not fail on
  27 ;; unsorted data)
  28 $if URFORTH_DEBUG_INFO
  29
  30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 $constant "(DBGBUF-MAXSIZE)" 1024*64
  32 (hidden)
  33
  34 $value "(DBGINFO-ENABLED?)" 1
  35 (hidden)
  36 $value "(DBGINFO-ACTIVE?)" 0
  37 (hidden)
  38
  39 $value "(DBGBUF-BASE-ADDR)" 0
  40 (hidden)
  41 $value "(DBGBUF-END-ADDR)" 0
  42 (hidden)
  43
  44 $variable "(DBGBUF-CURR-ADDR)" 0
  45 (hidden)
  46
  47
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 ;; list of known source files
  50 ;; structure:
  51 ;;   dd nextptr     ;; or 0
  52 ;;   dd dpptr       ;; in code area
  53
  54 $variable "(dbg-file-list-head)" 0
  55 (hidden)
  56
  57 ;; does no checks
  58 ;; also, list of know files is not stored in SAVEd binary
  59 : (dbg-add-file)  ( addr count -- straddr )
  60   2 cells brk-alloc
  61   (dbg-file-list-head) @ over !
  62   dup (dbg-file-list-head) ! cell+
  63   here swap !
  64   ;; copy string
  65   dup 1+ n-allot dup >r
  66   2dup c! 1+ swap 0 max cmove
  67   r>
  68 ; (hidden)
  69
  70 ;; this can return 0
  71 : (dbg-find-or-add-file)  ( addr count -- straddr )
  72   dp-temp @ if 0 exit endif  ;; no file info for temp definitions
  73   str-extract-name ?dup if
  74     (dbg-file-list-head)
  75     begin @ ?dup while >r
  76       2dup r@ cell+ @ bcount s= if
  77         2drop r> cell+ @ exit
  78       endif
  79     r> repeat
  80     ;; add new
  81     (dbg-add-file)
  82   else drop 0 endif
  83 ; (hidden)
  84
  85
  86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87 : debug-info-off  ( -- )
  88   false to (dbginfo-enabled?)
  89   false to (dbginfo-active?)
  90   (dbgbuf-base-addr) ?dup if 0! endif
  91 ;
  92
  93 : debug-info-on  ( -- )
  94   (dbgbuf-base-addr) if true to (dbginfo-enabled?) else debug-info-off endif
  95 ;
  96
  97
  98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99 : (DBGINFO-RESET)  ( -- )
 100   (dbgbuf-base-addr) (dbgbuf-curr-addr) !
 101   false to (dbginfo-active?)
 102   ;; set first line to 0 (to ease checks in "add-pc")
 103   (dbgbuf-base-addr) ?dup if 0! endif
 104 ; (hidden)
 105
 106 : (dbginfo-reset-activate)  ( -- )  (dbginfo-reset) true to (dbginfo-active?) ; (hidden)
 107
 108
 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 110 : (DBGINFO-ADD-PC)  ( pc line -- )
 111   ;; never put zero line
 112   ?dup ifnot drop exit endif
 113   ;; special? -1 items means "out of room"
 114   (dbgbuf-curr-addr) @ ?dup ifnot 2drop exit endif
 115   ( pc line dbgbufaddr )
 116   ;; check if the line is the same (if we have no lines, there will be zero)
 117   2dup @ = if drop 2drop exit endif
 118   ;; check if we have enough room
 119   dup 3 +cells (dbgbuf-end-addr) u> if
 120     ;; out of buffer, abort debug info generation
 121     drop 2drop (dbgbuf-curr-addr) 0!
 122     exit
 123   endif
 124   ;; put line and pc
 125   ( pc line dbgbufaddr )
 126   tuck ! cell+  ;; line
 127   tuck ! cell+  ;; pc
 128   ;; put current line number to the next item (for equality check above)
 129   dup 2 -cells @ over !
 130   (dbgbuf-curr-addr) !
 131 ; (hidden)
 132
 133
 134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 135 : (DBGINFO-ADD-HERE)  ( -- )
 136   ;; put debug info
 137   dp-temp @ ifnot  ;; no debug info for temporary words
 138     (dbginfo-active?) (dbginfo-enabled?) logand if
 139       here tib-curr-line (dbginfo-add-pc)
 140     endif
 141   endif
 142 ;
 143
 144
 145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146 ;; create compressed debug info, set dfa
 147
 148 ;; let's use globals here, because why not?
 149 $value "(dbginfo-cpbuf-start)" 0
 150 $value "(dbginfo-cpbuf-curpos)" 0
 151 $value "(dbginfo-cpbuf-currline)" 0
 152 $value "(dbginfo-cpbuf-currpc)" 0
 153
 154 : (dbginfo-build-byte)  ( b -- )
 155   (dbginfo-cpbuf-curpos) c!
 156   (dbginfo-cpbuf-curpos) 1+ to (dbginfo-cpbuf-curpos)
 157 ;
 158
 159 : (dbginfo-build-word)  ( w -- )
 160   dup 0xff and (dbginfo-build-byte)
 161   8 rshift (dbginfo-build-byte)
 162 ;
 163
 164 : (dbginfo-build-dword)  ( dw -- )
 165   dup 0xffff and (dbginfo-build-word)
 166   16 rshift (dbginfo-build-word)
 167 ;
 168
 169
 170 ;; prerequisite: debug info must exist, and must not be empty
 171 : (dbginfo-build-compressed)  ( destbuf -- destbuf size )
 172   ;; build file name (do it here, because it may allocate at here)
 173   (tib-curr-fname) count (dbg-find-or-add-file) >r
 174   ;; init vars
 175   dup to (dbginfo-cpbuf-start)
 176   to (dbginfo-cpbuf-curpos)
 177   ;; get starting line
 178   (dbgbuf-base-addr) @ to (dbginfo-cpbuf-currline)
 179   ;; get starting PC
 180   latest-cfa to (dbginfo-cpbuf-currpc)
 181   ;; create header
 182   ;; item count (we know that in advance)
 183   (dbgbuf-curr-addr) @ (dbgbuf-base-addr) - 3 rshift (dbginfo-build-word)
 184   ;; first line
 185   (dbginfo-cpbuf-currline) (dbginfo-build-word)
 186   ;; file name
 187   r> (dbginfo-build-dword)
 188   (dbgbuf-curr-addr) @ (dbgbuf-base-addr) do
 189     ;;   db pcoffs   ; offset from the previous PC (first: from the CFA)
 190     ;;   db lineofs  ; offset from the previous line
 191     ;;
 192     ;; if lineofs is 255, next word is 16-bit line offset
 193     ;; if pcofs is 255, next word is 16-bit line offset
 194     ;; PC
 195     i cell+ @ (dbginfo-cpbuf-currpc) - dup 255 < if
 196       ;; 8-bit offset
 197       (dbginfo-build-byte)
 198     else
 199       ;; 16-bit offset
 200       255 (dbginfo-build-byte)
 201       (dbginfo-build-word)
 202     endif
 203     ;; update current PC
 204     i cell+ @ to (dbginfo-cpbuf-currpc)
 205     ;; line number
 206     i @ (dbginfo-cpbuf-currline) - dup 255 < if
 207       ;; 8-bit offset
 208       (dbginfo-build-byte)
 209     else
 210       ;; 16-bit offset
 211       255 (dbginfo-build-byte)
 212       (dbginfo-build-word)
 213     endif
 214     ;; update current line
 215     i @ to (dbginfo-cpbuf-currline)
 216   2 cells +loop
 217   ;; return addr and size
 218   (dbginfo-cpbuf-start) (dbginfo-cpbuf-curpos) over -
 219 ;
 220
 221 : (dbginfo-finalize-and-copy)  ( -- )
 222   (dbginfo-active?) (dbginfo-enabled?) logand if
 223     (dbgbuf-base-addr) ?dup if
 224       @ if
 225         ;; save current PC
 226         (dbgbuf-curr-addr) @ 0! (dbginfo-add-here)
 227         ;; compressed should never be bigger than the original
 228         (dbgbuf-curr-addr) @ (dbgbuf-base-addr) - 4 +cells simple-malloc throw dup >r
 229         (dbginfo-build-compressed)
 230         ;; save here to debug info field
 231         here latest-nfa nfa->dfa !
 232         dup n-allot  ( addr bytes rva-newaddr )
 233         swap 0 max cmove
 234         r> simple-free throw
 235       endif
 236     endif
 237   endif
 238   ;; always deactivate
 239   (dbginfo-reset)
 240 ;
 241
 242
 243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 244 ..: (startup-init)  ( -- )
 245   (dbgbuf-maxsize) ?dup if
 246     brk-alloc
 247     dup to (dbgbuf-base-addr) (dbgbuf-maxsize) + 1- to (dbgbuf-end-addr)
 248     (dbg-file-list-head) 0!
 249   else
 250     0 to (dbgbuf-base-addr)
 251     0 to (dbgbuf-end-addr)
 252     false to (dbginfo-enabled?)
 253     false to (dbginfo-active?)
 254   endif
 255   (dbgbuf-base-addr) ?dup if 0! endif
 256 ;..
 257
 258 $else
 259
 260 \ this may be used by the external tools (assembler, for example)
 261 : (dbginfo-reset) ; (hidden) immediate-noop
 262 : (dbginfo-reset-activate) ; (hidden) immediate-noop
 263
 264 $endif