1# -*- tcl -*-
2#
3# Copyright (c) 2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
4# Parser Generator / Backend - Generate a grammar::me::cpu based parser.
5
6# This package assumes to be used from within a PAGE plugin. It uses
7# the API commands listed below. These are identical across the major
8# types of PAGE plugins, allowing this package to be used in reader,
9# transform, and writer plugins. It cannot be used in a configuration
10# plugin, and this makes no sense either.
11#
12# To ensure that our assumption is ok we require the relevant pseudo
13# package setup by the PAGE plugin management code.
14#
15# -----------------+--
16# page_info        | Reporting to the user.
17# page_warning     |
18# page_error       |
19# -----------------+--
20# page_log_error   | Reporting of internals.
21# page_log_warning |
22# page_log_info    |
23# -----------------+--
24
25# ### ### ### ######### ######### #########
26
27## The input is a grammar, not as tree, but as a list of instructions
28## (symbolic form). This backend converts that into machinecode for
29## grammar::m::cpu::core and inserts the result into a template file.
30
31## The translation from grammar tree to assembler code was done in a
32## preceding transformation.
33
34# ### ### ### ######### ######### #########
35## Requisites
36
37# @mdgen NODEP: page::plugin
38
39package require page::plugin ; # S.a. pseudo-package.
40
41package require grammar::me::cpu::core
42package require textutil
43
44#package require page::analysis::peg::emodes
45#package require page::util::quote
46#package require page::util::peg
47
48namespace eval ::page::gen::peg::mecpu {}
49
50# ### ### ### ######### ######### #########
51## API
52
53proc ::page::gen::peg::mecpu::package {text} {
54    variable package $text
55    return
56}
57
58proc ::page::gen::peg::mecpu::copyright {text} {
59    variable copyright $text
60    return
61}
62
63proc ::page::gen::peg::mecpu::template {path} {
64    variable template $path
65    return
66}
67
68proc ::page::gen::peg::mecpu::cmarker {list} {
69    variable cmarker $list
70    return
71}
72
73proc ::page::gen::peg::mecpu {asmcode chan} {
74
75    # asmcode     = list (name code)
76    # code        = list (instruction)
77    # instruction = list (label name arg...)
78
79    variable mecpu::package
80    variable mecpu::copyright
81    variable mecpu::cmarker
82    variable mecpu::template
83    variable mecpu::template_file
84
85    # Import the config options, provide fallback to defaults for the
86    # unspecified parts.
87
88    set gname [lindex $asmcode 0]
89    set gcode [lindex $asmcode 1]
90
91    if {$package eq ""} {set package $gname}
92
93    page_info "  Grammar:   $gname"
94    page_info "  Package:   $package"
95
96    if {$copyright ne ""} {
97	page_info "  Copyright: $copyright"
98	set copyright "\#\# (C) $copyright\n"
99    }
100
101    if {$template eq ""} {
102	set template $template_file
103    }
104
105    page_info "  Template:  $template"
106
107    # Translate the incoming assembler to machine code.
108
109    set mcode [grammar::me::cpu::core::asm $gcode]
110
111    # We know that the machine code has three parts (instructions,
112    # string pool, token map). We take the data apart to allow separate
113    # insertion if the template so chooses (like for readability).
114
115    foreach {minsn mpool mtmap} $mcode break
116
117    set fminsn {} ; set i 0 ; set j 19
118    while {$i < [llength $minsn]} {
119	append fminsn "         [lrange $minsn $i $j]\n"
120	incr i 20 ; incr j 20
121    }
122
123    set fmpool {} ; set i 0 ; set j 4
124    while {$i < [llength $mpool]} {
125	append fmpool "         [lrange $mpool $i $j]\n"
126	incr i 5 ; incr j 5
127    }
128
129    # ------------------------------------
130    # We also generate a readable representation of the assembler
131    # instructions for insertion into a comment area.
132
133    set asmp [mecpu::2readable $gcode $minsn]
134
135    # ------------------------------------
136
137    # And write the modified template
138    puts $chan [string map [list  \
139		@NAME@ $gname     \
140	        @PKG@  $package   \
141	        @COPY@ $copyright \
142		@CODE@ $mcode     \
143		@INSN@ $minsn     \
144		@FNSN@ $fminsn    \
145		@POOL@ $mpool     \
146		@FPOL@ $fmpool    \
147		@TMAP@ $mtmap     \
148		@ASMP@ $asmp      \
149	       ] [mecpu::Template]]
150    return
151}
152
153proc ::page::gen::peg::mecpu::Template {} {
154    variable template
155    return [string trimright [read [set ch [open $template r]]][close $ch]]
156}
157
158proc ::page::gen::peg::mecpu::2readable {asmcode mecode} {
159    return [2print $asmcode $mecode max [widths $asmcode max]]
160}
161
162proc ::page::gen::peg::mecpu::widths {asmcode mv} {
163    upvar 1 $mv max
164
165    # First iteration, column widths (instructions, and arguments).
166    # Ignore comments, they go across all columns.
167    # Also ignore labels (lrange 1 ..).
168
169    set mc 0
170    foreach insn $asmcode {
171	set i [lindex $insn 1]
172	if {$i eq ".C"} continue
173	set col 0
174
175	foreach x [lrange $insn 1 end] {
176	    set xlen [string length $x]
177	    if {![info exists max($col)] || ($xlen > $max($col))} {set max($col) $xlen}
178	    incr col
179
180	    # Shift the strings of various commands into the third
181	    # column, if they are not already there.
182
183	    if {$i eq "ier_nonterminal"}        {incr col ; set i ""}
184	    if {$i eq "isv_nonterminal_leaf"}   {incr col ; set i ""}
185	    if {$i eq "isv_nonterminal_range"}  {incr col ; set i ""}
186	    if {$i eq "isv_nonterminal_reduce"} {incr col ; set i ""}
187	    if {$i eq "inc_save"}               {incr col ; set i ""}
188	    if {$i eq "ict_advance"}            {incr col ; set i ""}
189	}
190	if {$col > $mc} {set mc $col}
191    }
192
193    set max($mc) 0
194    return $mc
195}
196
197proc ::page::gen::peg::mecpu::2print {asmcode mecode mv mc} {
198    variable cmarker
199    upvar 1 $mv max
200
201    set lines {}
202    set pc    0
203
204    foreach insn $asmcode {
205	foreach {label name} $insn break
206	if {$name  eq ".C"} {lappend lines "" "--  [join [lrange $insn 2 end] " "]" ""}
207	if {$label ne ""}   {lappend lines "       ${label}:" }
208	if {$name  eq ".C"} continue
209
210	set line  " [format %05d $pc]      "
211
212	set  pcs $pc
213	incr pc [llength $insn] ; incr pc -1
214	set  pce $pc ; incr pce -1
215	set  imecode [lrange $mecode $pcs $pce]
216
217	if {
218	    ($name eq "ier_nonterminal") ||
219	    ($name eq "isv_nonterminal_leaf") ||
220	    ($name eq "isv_nonterminal_range") ||
221	    ($name eq "isv_nonterminal_reduce") ||
222	    ($name eq "inc_save") ||
223	    ($name eq "ict_advance")
224	} {
225	    # Shift first argument into 2nd column, and quote it as well.
226	    set insn [lreplace $insn 2 2 "" '[lindex $insn 2]']
227	} elseif {
228	    ($name eq "inc_restore") ||
229	    ($name eq "ict_match_token") ||
230	    ($name eq "ict_match_tokclass")
231	} {
232	    # Command with quoted arguments, no shifting.
233	    set insn [lreplace $insn 3 3 '[lindex $insn 3]']
234	} elseif {
235	    ($name eq "ict_match_tokrange")
236	} {
237	    # Command with quoted arguments, no shifting.
238	    set insn [lreplace $insn 4 4 '[lindex $insn 4]']
239	}
240
241	while {[llength $insn] <= $mc} {lappend insn ""}
242	lappend insn "-- $imecode"
243
244	set col 0
245	foreach x [lrange $insn 1 end] {
246	    set xlen [string length $x]
247	    append line " "
248	    append line $x
249	    append line [string repeat " " [expr {$max($col) - $xlen}]]
250	    incr col
251	}
252
253	lappend lines $line
254    }
255
256    # Wrap the lines into a comment.
257
258    if {$cmarker eq ""} {set cmarker "\#"}
259
260    if {[llength $cmarker] > 1} {
261	# Comments are explictly closed as well.
262
263	foreach {cs ce} $cmarker break
264	return "$cs [join $lines " $ce\n$cs "] $ce"
265    } else {
266	# Comments are not explicitly closed. Implicit by end-of-line
267
268	return "$cmarker [join $lines "\n$cmarker "]"
269    }
270}
271
272# ### ### ### ######### ######### #########
273## Internal. Strings.
274
275namespace eval ::page::gen::peg::mecpu {
276
277    variable here          [file dirname [info script]]
278    variable template_file [file join $here gen_peg_mecpu.template]
279
280    variable package   ""
281    variable copyright ""
282    variable template  ""
283    variable cmarker   ""
284}
285
286# ### ### ### ######### ######### #########
287## Ready
288
289package provide page::gen::peg::mecpu 0.1
290