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