/red-system/runtime/debug.reds
Unknown | 143 lines | 128 code | 15 blank | 0 comment | 0 complexity | ce041fe3438f90ae89757f660435acf4 MD5 | raw file
1Red/System [ 2 Title: "Red/System runtime debugging functions" 3 Author: "Nenad Rakocevic" 4 File: %debug.reds 5 Rights: "Copyright (C) 2011 Nenad Rakocevic. All rights reserved." 6 License: { 7 Distributed under the Boost Software License, Version 1.0. 8 See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt 9 } 10] 11 12 13__line-record!: alias struct! [ ;-- debug lines records associating code addresses and source lines 14 address [byte-ptr!] ;-- native code pointer 15 line [integer!] ;-- source line number 16 file [integer!] ;-- source file name c-string offset (from first record) 17] 18 19__debug-lines: declare __line-record! ;-- pointer to first debug-lines record (set at link-time) 20 21;------------------------------------------- 22;-- Calculate line number for a runtime error and print it (internal function). 23;------------------------------------------- 24__print-debug-line: func [ 25 address [byte-ptr!] ;-- memory address where the runtime error happened 26 /local base records 27][ 28 records: __debug-lines 29 base: as byte-ptr! records 30 31 while [records/address < address][ ;-- search for the closest record 32 records: records + 1 33 ] 34 if records/address > address [ ;-- if not an exact match, use the closest lower record 35 records: records - 1 36 ] 37 print [ 38 lf "*** in file: " as-c-string base + records/file 39 lf "*** at line: " records/line 40 lf 41 ] 42] 43 44;------------------------------------------- 45;-- Print an integer as hex number on screen, limited to n characters 46;------------------------------------------- 47prin-hex-chars: func [ 48 i [integer!] ;-- input integer to print 49 n [integer!] ;-- max number of characters to print (right-aligned) 50 return: [integer!] ;-- return the input integer (pass-thru) 51 /local s c d ret 52][ 53 s: "00000000" 54 if zero? i [ 55 s: "00000000" 56 print s + (8 - n) 57 return i 58 ] 59 c: 8 60 ret: i 61 until [ 62 d: i // 16 63 if d > 9 [d: d + 7] ;-- 7 = (#"A" - 1) - #"9" 64 s/c: #"0" + d 65 i: i >>> 4 66 c: c - 1 67 zero? c ;-- iterate on all 8 bytes to overwrite previous values 68 ] 69 prin s + (8 - n) 70 ret 71] 72 73;------------------------------------------- 74;-- Dump memory on screen in hex format 75;------------------------------------------- 76dump-memory: func [ 77 address [byte-ptr!] ;-- memory address where the dump starts 78 unit [integer!] ;-- size of memory chunks to print in hex format (1 or 4 bytes) 79 return: [byte-ptr!] ;-- return the pointer (pass-thru) 80 /local offset ascii i byte int-ptr data-ptr 81][ 82 assert any [unit = 1 unit = 4] 83 84 print ["^/Hex dump from: " address "h^/" lf] 85 86 offset: 0 87 ascii: " " 88 89 data-ptr: address 90 until [ 91 print [address ": "] 92 i: 0 93 until [ 94 i: i + 1 95 96 if unit = 1 [ 97 prin-hex-chars as-integer address/value 2 98 address: address + 1 99 print either i = 8 [" "][" "] 100 ] 101 if all [unit = 4 zero? (i // 4)][ 102 int-ptr: as int-ptr! address 103 prin-hex int-ptr/value 104 address: address + 4 105 print either i = 8 [" "][" "] 106 ] 107 108 byte: data-ptr/value 109 ascii/i: either byte < as-byte 32 [ 110 either byte = null-byte [#"."][#"^(FE)"] 111 ][ 112 byte 113 ] 114 115 data-ptr: data-ptr + 1 116 i = 16 117 ] 118 print [space ascii lf] 119 offset: offset + 16 120 offset = 128 121 ] 122 address 123] 124 125;------------------------------------------- 126;-- Dump memory on screen in hex format as array of bytes (handy wrapper on dump-hex) 127;------------------------------------------- 128dump-hex: func [ 129 address [byte-ptr!] ;-- memory address where the dump starts 130 return: [byte-ptr!] ;-- return the pointer (pass-thru) 131][ 132 dump-memory address 1 133] 134 135;------------------------------------------- 136;-- Dump memory on screen in hex format as array of 32-bit integers (handy wrapper on dump-hex) 137;------------------------------------------- 138dump-hex4: func [ 139 address [byte-ptr!] ;-- memory address where the dump starts 140 return: [byte-ptr!] ;-- return the pointer (pass-thru) 141][ 142 dump-memory address 4 143]