me_cpu.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  (C) 2005-2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>*/
/*  ### ### ### ######### ######### #########*/
/*  Package description*/

/*  Implementation of ME virtual machines, object-based API to the*/
/*  state values provided by "grammar::me::cpu::core".*/

/*  ### ### ### ######### ######### #########*/
/*  Requisites*/

package require snit
package require grammar::me::cpu::core

/*  ### ### ### ######### ######### #########*/
/*  Implementation*/

snit::type ::grammar::me::cpu {
    constructor {code_} {
    /*  The 'core new' call validates the code as well.*/

     state =  [core::new $code_]
    return
    }

    ret  lc     (type location)     {return [core::lc     $state $location]}
    ret  tok    (type args)         {return [eval [linsert $args 0 core::tok $state]]}
    ret  pc     ()             {return [core::pc     $state]}
    ret  iseof  ()             {return [core::iseof  $state]}
    ret  at     ()             {return [core::at     $state]}
    ret  cc     ()             {return [core::cc     $state]}
    ret  sv     ()             {return [core::sv     $state]}
    ret  ok     ()             {return [core::ok     $state]}
    ret  error  ()             {return [core::error  $state]}
    ret  lstk   ()             {return [core::lstk   $state]}
    ret  astk   ()             {return [core::astk   $state]}
    ret  mstk   ()             {return [core::mstk   $state]}
    ret  estk   ()             {return [core::estk   $state]}
    ret  rstk   ()             {return [core::rstk   $state]}
    ret  nc     ()             {return [core::nc     $state]}
    ret  ast    ()             {return [core::ast    $state]}
    ret  halted ()             {return [core::halted $state]}
    ret  code   ()             {return [core::code   $state]}

    ret  eof () {
    core::eof state
    return
    }

    ret  put (type tok , type lex , type line , type col) {
    core::put state $tok $lex $line $col
    return
    }

    ret  putstring (type str , type lvar , type cvar) {
    upvar 1 $lvar line $cvar col
    foreach ch [split $str {}] {
        core::put state $ch {} $line $col
        if {$ch eq "\n"} {
        incr line
        set  col 0
        } else {
        incr col
        }
    }
    return
    }

    ret  run (optional n =-1) {
    core::run state $n
    return
    }

    ret  pull (type next) {
    while {1} {
        core::run state
        if {[core::halted $state]} break

        set tokdata [uplevel \#0 $next]
        if {![llength $tokdata]} break
        if {[llength $tokdata] != 4} {
        return -code error "Bad callback result, expected 4 elements"
        }
        foreach {tok lex line col} $tokdata break
        core::put state $tok $lex $line $col
    }
    }

    ret  reset () {
    set state [core::new [core::code $state]]
    return
    }

    /*  ### ### ### ######### ######### #########*/
    /*  Data structures*/

    variable state ; /*  State of ME cpu handled here.*/
}

/*  ### ### ### ######### ######### #########*/
/*  Ready*/

package provide grammar::me::cpu 0.2