/pliant/language/debug/record.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring1.pli"
18
19
20	# moved to /pliant/language/optimizer/gcc_base.pli
21	if false
22
23	type DebuggerInstructionRecord
24	field Int code_offset
25	field ListingPositions position
26	field Int profiler_counter <- 0
27
28	type DebuggerVariableRecord
29	field Int stack_offset
30	field Str name
31	field Link:Type type
32
33
34	public
35	type DebuggerInstructionRecords
36	field Int count <- 0
37
38	function destroy rs
39	arg_w DebuggerInstructionRecords rs
40	for (var Int i) 0 rs:count-1
41	DebuggerInstructionRecord destroy_instance ((addressof:rs translate Int 1) translate DebuggerInstructionRecord i)
42
43
44	function generate_debugging_info gc
45	arg_rw GeneratorContext gc
46	if pliant_debugging_level_variable=0 or (gc:locals first "gcc compiled function")<>null
47	return
48	var Pointer:Function fun :> gc function
49	var Link:List deb
50	if fun:externals<>null and addressof:(entry_type fun:externals)=addressof:List
51	deb :> fun:externals map List
52	else
53	deb :> new List
54	if fun:externals<>null
55	deb append fun:externals
56	fun externals := addressof deb
57	if true
58	var Str last_position := "" ; var Int count := 0
59	var Pointer:Instruction i :> gc first_instruction
60	while addressof:i<>null
61	if i:position<>last_position
62	count := count+1
63	last_position := i position
64	i :> i next_instruction
65	if count>0
66	(addressof:DebuggerInstructionRecords map Type) size := Int:size+count*DebuggerInstructionRecord:size
67	var Link:DebuggerInstructionRecords rs :> new DebuggerInstructionRecords
68	rs count := count
69	deb append addressof:rs
70	var Str last_position := "" ; var Int index := 0
71	var Pointer:Instruction i :> gc first_instruction
72	while addressof:i<>null
73	if i:position<>last_position
74	var Pointer:DebuggerInstructionRecord fi :> ((addressof:rs translate Int 1) translate DebuggerInstructionRecord index) map DebuggerInstructionRecord
75	DebuggerInstructionRecord build_instance addressof:fi
76	fi code_offset := i order
77	fi position := i position
78	last_position := i position ; index := index+1
79	i :> i next_instruction
80	else
81	var Str last_position := ""
82	var Pointer:Instruction i :> gc first_instruction
83	while addressof:i<>null
84	if i:position<>last_position
85	var Link:DebuggerInstructionRecord fi :> new DebuggerInstructionRecord
86	fi code_offset := i order
87	fi position := i position
88	deb append addressof:fi
89	last_position := i position
90	i :> i next_instruction
91	if pliant_debugging_level_variable>=2
92	var Int pushsize := (gc:locals first "pliant push size") map Int
93	var Int localsize := (gc:locals first "pliant locals size") map Int
94	var Dictionary names
95	var Pointer:Arrow c :> gc:arguments first
96	while c<>null
97	var Pointer:Argument a :> c map Argument
98	if a:name:len<>0 and a:where=3
99	var Str fullname := a:name+" "+('convert to string' a:offset)
100	if (names first fullname)=null
101	var Link:DebuggerVariableRecord fv :> new DebuggerVariableRecord
102	fv stack_offset := a:offset-pushsize-localsize
103	fv name := a name
104	if a:pointer:where=2 and a:pointer:register=4
105	fv type :> a type
106	else
107	fv type :> pointerto a:type
108	deb append addressof:fv
109	names insert fullname true addressof:a
110	c :> gc:arguments next c
111
112
113	# sets the optimizer that will generate debugging informations
114
115	the_module:"/pliant/language/optimizer/basic.pli" define "pliant optimizer conclude" addressof:(the_function generate_debugging_info GeneratorContext)