path: root/tcllib/modules/page/gen_peg_mecpu.tcl

# -*- tcl -*-
#
# Copyright (c) 2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
# Parser Generator / Backend - Generate a grammar::me::cpu based parser.

# This package assumes to be used from within a PAGE plugin. It uses
# the API commands listed below. These are identical across the major
# types of PAGE plugins, allowing this package to be used in reader,
# transform, and writer plugins. It cannot be used in a configuration
# plugin, and this makes no sense either.
#
# To ensure that our assumption is ok we require the relevant pseudo
# package setup by the PAGE plugin management code.
#
# -----------------+--
# page_info        | Reporting to the user.
# page_warning     |
# page_error       |
# -----------------+--
# page_log_error   | Reporting of internals.
# page_log_warning |
# page_log_info    |
# -----------------+--

# ### ### ### ######### ######### #########

## The input is a grammar, not as tree, but as a list of instructions
## (symbolic form). This backend converts that into machinecode for
## grammar::m::cpu::core and inserts the result into a template file.

## The translation from grammar tree to assembler code was done in a
## preceding transformation.

# ### ### ### ######### ######### #########
## Requisites

# @mdgen NODEP: page::plugin

package require page::plugin ; # S.a. pseudo-package.

package require grammar::me::cpu::core
package require textutil

#package require page::analysis::peg::emodes
#package require page::util::quote
#package require page::util::peg

namespace eval ::page::gen::peg::mecpu {}

# ### ### ### ######### ######### #########
## API

proc ::page::gen::peg::mecpu::package {text} {
    variable package $text
    return
}

proc ::page::gen::peg::mecpu::copyright {text} {
    variable copyright $text
    return
}

proc ::page::gen::peg::mecpu::template {path} {
    variable template $path
    return
}

proc ::page::gen::peg::mecpu::cmarker {list} {
    variable cmarker $list
    return
}

proc ::page::gen::peg::mecpu {asmcode chan} {

    # asmcode     = list (name code)
    # code        = list (instruction)
    # instruction = list (label name arg...)

    variable mecpu::package
    variable mecpu::copyright
    variable mecpu::cmarker
    variable mecpu::template
    variable mecpu::template_file

    # Import the config options, provide fallback to defaults for the
    # unspecified parts.

    set gname [lindex $asmcode 0]
    set gcode [lindex $asmcode 1]

    if {$package eq ""} {set package $gname}

    page_info "  Grammar:   $gname"
    page_info "  Package:   $package"

    if {$copyright ne ""} {
	page_info "  Copyright: $copyright"
	set copyright "\#\# (C) $copyright\n"
    }

    if {$template eq ""} {
	set template $template_file
    }

    page_info "  Template:  $template"

    # Translate the incoming assembler to machine code.

    set mcode [grammar::me::cpu::core::asm $gcode]

    # We know that the machine code has three parts (instructions,
    # string pool, token map). We take the data apart to allow separate
    # insertion if the template so chooses (like for readability).

    foreach {minsn mpool mtmap} $mcode break

    set fminsn {} ; set i 0 ; set j 19
    while {$i < [llength $minsn]} {
	append fminsn "         [lrange $minsn $i $j]\n"
	incr i 20 ; incr j 20
    }

    set fmpool {} ; set i 0 ; set j 4
    while {$i < [llength $mpool]} {
	append fmpool "         [lrange $mpool $i $j]\n"
	incr i 5 ; incr j 5
    }

    # ------------------------------------
    # We also generate a readable representation of the assembler
    # instructions for insertion into a comment area.

    set asmp [mecpu::2readable $gcode $minsn]

    # ------------------------------------

    # And write the modified template
    puts $chan [string map [list  \
		@NAME@ $gname     \
	        @PKG@  $package   \
	        @COPY@ $copyright \
		@CODE@ $mcode     \
		@INSN@ $minsn     \
		@FNSN@ $fminsn    \
		@POOL@ $mpool     \
		@FPOL@ $fmpool    \
		@TMAP@ $mtmap     \
		@ASMP@ $asmp      \
	       ] [mecpu::Template]]
    return
}

proc ::page::gen::peg::mecpu::Template {} {
    variable template
    return [string trimright [read [set ch [open $template r]]][close $ch]]
}

proc ::page::gen::peg::mecpu::2readable {asmcode mecode} {
    return [2print $asmcode $mecode max [widths $asmcode max]]
}

proc ::page::gen::peg::mecpu::widths {asmcode mv} {
    upvar 1 $mv max

    # First iteration, column widths (instructions, and arguments).
    # Ignore comments, they go across all columns.
    # Also ignore labels (lrange 1 ..).

    set mc 0
    foreach insn $asmcode {
	set i [lindex $insn 1]
	if {$i eq ".C"} continue
	set col 0

	foreach x [lrange $insn 1 end] {
	    set xlen [string length $x]
	    if {![info exists max($col)] || ($xlen > $max($col))} {set max($col) $xlen}
	    incr col

	    # Shift the strings of various commands into the third
	    # column, if they are not already there.

	    if {$i eq "ier_nonterminal"}        {incr col ; set i ""}
	    if {$i eq "isv_nonterminal_leaf"}   {incr col ; set i ""}
	    if {$i eq "isv_nonterminal_range"}  {incr col ; set i ""}
	    if {$i eq "isv_nonterminal_reduce"} {incr col ; set i ""}
	    if {$i eq "inc_save"}               {incr col ; set i ""}
	    if {$i eq "ict_advance"}            {incr col ; set i ""}
	}
	if {$col > $mc} {set mc $col}
    }

    set max($mc) 0
    return $mc
}

proc ::page::gen::peg::mecpu::2print {asmcode mecode mv mc} {
    variable cmarker
    upvar 1 $mv max

    set lines {}
    set pc    0

    foreach insn $asmcode {
	foreach {label name} $insn break
	if {$name  eq ".C"} {lappend lines "" "--  [join [lrange $insn 2 end] " "]" ""}
	if {$label ne ""}   {lappend lines "       ${label}:" }
	if {$name  eq ".C"} continue

	set line  " [format %05d $pc]      "

	set  pcs $pc
	incr pc [llength $insn] ; incr pc -1
	set  pce $pc ; incr pce -1
	set  imecode [lrange $mecode $pcs $pce]

	if {
	    ($name eq "ier_nonterminal") ||
	    ($name eq "isv_nonterminal_leaf") ||
	    ($name eq "isv_nonterminal_range") ||
	    ($name eq "isv_nonterminal_reduce") ||
	    ($name eq "inc_save") ||
	    ($name eq "ict_advance")
	} {
	    # Shift first argument into 2nd column, and quote it as well.
	    set insn [lreplace $insn 2 2 "" '[lindex $insn 2]']
	} elseif {
	    ($name eq "inc_restore") ||
	    ($name eq "ict_match_token") ||
	    ($name eq "ict_match_tokclass")
	} {
	    # Command with quoted arguments, no shifting.
	    set insn [lreplace $insn 3 3 '[lindex $insn 3]']
	} elseif {
	    ($name eq "ict_match_tokrange")
	} {
	    # Command with quoted arguments, no shifting.
	    set insn [lreplace $insn 4 4 '[lindex $insn 4]']
	}

	while {[llength $insn] <= $mc} {lappend insn ""}
	lappend insn "-- $imecode"

	set col 0
	foreach x [lrange $insn 1 end] {
	    set xlen [string length $x]
	    append line " "
	    append line $x
	    append line [string repeat " " [expr {$max($col) - $xlen}]]
	    incr col
	}

	lappend lines $line
    }

    # Wrap the lines into a comment.

    if {$cmarker eq ""} {set cmarker "\#"}

    if {[llength $cmarker] > 1} {
	# Comments are explictly closed as well.

	foreach {cs ce} $cmarker break
	return "$cs [join $lines " $ce\n$cs "] $ce"
    } else {
	# Comments are not explicitly closed. Implicit by end-of-line

	return "$cmarker [join $lines "\n$cmarker "]"
    }
}

# ### ### ### ######### ######### #########
## Internal. Strings.

namespace eval ::page::gen::peg::mecpu {

    variable here          [file dirname [info script]]
    variable template_file [file join $here gen_peg_mecpu.template]

    variable package   ""
    variable copyright ""
    variable template  ""
    variable cmarker   ""
}

# ### ### ### ######### ######### #########
## Ready

package provide page::gen::peg::mecpu 0.1