47dcf5fc27 2019-05-01 1: #! /usr/bin/env tclsh
47dcf5fc27 2019-05-01 2:
47dcf5fc27 2019-05-01 3: set sourceDirectory [file dirname [file normalize [info script]]]
f09ab16ca1 2019-05-08 4:
47dcf5fc27 2019-05-01 5: lappend auto_path [file join $sourceDirectory lib]
f09ab16ca1 2019-05-08 6:
2b7fa3a8fa 2019-09-20 7: set template [file join $sourceDirectory lib xvfs xvfs.c.rvt]
47dcf5fc27 2019-05-01 8:
47dcf5fc27 2019-05-01 9: package require minirivet
47dcf5fc27 2019-05-01 10:
f09ab16ca1 2019-05-08 11: set mode "run"
f09ab16ca1 2019-05-08 12: if {[lindex $argv 0] == "--dump-tcl"} {
f09ab16ca1 2019-05-08 13: set mode "dump-tcl"
0bdbe4333e 2019-09-20 14: }
0bdbe4333e 2019-09-20 15:
0bdbe4333e 2019-09-20 16: foreach {arg val} $argv {
0bdbe4333e 2019-09-20 17: switch -exact -- $arg {
0bdbe4333e 2019-09-20 18: "--output" {
0bdbe4333e 2019-09-20 19: set outputFile $val
0bdbe4333e 2019-09-20 20: }
0bdbe4333e 2019-09-20 21: }
d80c88cee0 2019-09-16 22: }
d80c88cee0 2019-09-16 23:
d80c88cee0 2019-09-16 24: proc remove_debug {input} {
d80c88cee0 2019-09-16 25: set output [list]
d80c88cee0 2019-09-16 26:
d80c88cee0 2019-09-16 27: set lastLine -
d80c88cee0 2019-09-16 28: foreach line [split $input "\n"] {
d80c88cee0 2019-09-16 29: if {[string match -nocase "*XVFS_DEBUG*" $line]} {
d80c88cee0 2019-09-16 30: continue
d80c88cee0 2019-09-16 31: }
d80c88cee0 2019-09-16 32:
d80c88cee0 2019-09-16 33: if {$lastLine eq "" && $line eq ""} {
d80c88cee0 2019-09-16 34: continue
d80c88cee0 2019-09-16 35: }
d80c88cee0 2019-09-16 36:
d80c88cee0 2019-09-16 37: set lastLine $line
d80c88cee0 2019-09-16 38: lappend output $line
d80c88cee0 2019-09-16 39: }
d80c88cee0 2019-09-16 40:
d80c88cee0 2019-09-16 41: return [join $output "\n"]
d80c88cee0 2019-09-16 42: }
d80c88cee0 2019-09-16 43:
f09ab16ca1 2019-05-08 44: switch -- $mode {
f09ab16ca1 2019-05-08 45: "run" {
0bdbe4333e 2019-09-20 46: if {[info exists outputFile]} {
0bdbe4333e 2019-09-20 47: set fd [open $outputFile w]
0bdbe4333e 2019-09-20 48: ::minirivet::setOutputChannel $fd
0bdbe4333e 2019-09-20 49: }
0bdbe4333e 2019-09-20 50:
2b7fa3a8fa 2019-09-20 51: package require xvfs
2b7fa3a8fa 2019-09-20 52: set ::xvfs::argv $argv
2b7fa3a8fa 2019-09-20 53: ::xvfs::run
0bdbe4333e 2019-09-20 54:
0bdbe4333e 2019-09-20 55: if {[info exists fd]} {
0bdbe4333e 2019-09-20 56: close $fd
0bdbe4333e 2019-09-20 57: }
f09ab16ca1 2019-05-08 58: }
f09ab16ca1 2019-05-08 59: "dump-tcl" {
f09ab16ca1 2019-05-08 60: set xvfs_tcl [file join $sourceDirectory lib xvfs xvfs.tcl]
7664854ef9 2019-05-08 61: set xvfs_core_h [file join $sourceDirectory xvfs-core.h]
7664854ef9 2019-05-08 62: set xvfs_core_c [file join $sourceDirectory xvfs-core.c]
7664854ef9 2019-05-08 63:
b8cca3a6b4 2019-05-08 64: set cleanup {
b8cca3a6b4 2019-05-08 65: "#include <xvfs-core.h>" ""
b8cca3a6b4 2019-05-08 66: "#include <xvfs-core.c>" ""
b8cca3a6b4 2019-05-08 67: }
7664854ef9 2019-05-08 68:
7664854ef9 2019-05-08 69: set core_header_data ""
7664854ef9 2019-05-08 70: append core_header_data [string map $cleanup [read [open $xvfs_core_h]]] "\n"
7664854ef9 2019-05-08 71: append core_header_data [string map $cleanup [read [open $xvfs_core_c]]] "\n"
7664854ef9 2019-05-08 72:
d80c88cee0 2019-09-16 73: if {[lsearch -exact $argv "--remove-debug"] != -1} {
d80c88cee0 2019-09-16 74: set core_header_data [remove_debug $core_header_data]
d80c88cee0 2019-09-16 75: }
d80c88cee0 2019-09-16 76:
f09ab16ca1 2019-05-08 77: puts "#! /usr/bin/env tclsh"
d80c88cee0 2019-09-16 78: puts ""
0bdbe4333e 2019-09-20 79: puts [list namespace eval ::minirivet {}]
0bdbe4333e 2019-09-20 80: puts [list set ::minirivet::_outputChannel stdout]
0bdbe4333e 2019-09-20 81: puts [list proc ::minirivet::_emitOutput [info args ::minirivet::_emitOutput] [info body ::minirivet::_emitOutput]]
2b7fa3a8fa 2019-09-20 82: puts ""
f09ab16ca1 2019-05-08 83: puts [read [open $xvfs_tcl]]
f09ab16ca1 2019-05-08 84: puts ""
2b7fa3a8fa 2019-09-20 85: puts {set ::xvfs::argv $::argv}
2b7fa3a8fa 2019-09-20 86: puts {
2b7fa3a8fa 2019-09-20 87: foreach {arg val} $argv {
2b7fa3a8fa 2019-09-20 88: switch -exact -- $arg {
2b7fa3a8fa 2019-09-20 89: "--output" {
2b7fa3a8fa 2019-09-20 90: set ::minirivet::_outputChannel [open $val w]
2b7fa3a8fa 2019-09-20 91: }
2b7fa3a8fa 2019-09-20 92: }
2b7fa3a8fa 2019-09-20 93: }
2b7fa3a8fa 2019-09-20 94: }
2b7fa3a8fa 2019-09-20 95: puts ""
2b7fa3a8fa 2019-09-20 96: puts [list ::minirivet::_emitOutput $core_header_data]
2b7fa3a8fa 2019-09-20 97: puts ""
2b7fa3a8fa 2019-09-20 98:
7664854ef9 2019-05-08 99: puts ""
7664854ef9 2019-05-08 100: puts [string map $cleanup [::minirivet::parseStringToCode [read [open $template]]]]
f09ab16ca1 2019-05-08 101: }
f09ab16ca1 2019-05-08 102: default {
f09ab16ca1 2019-05-08 103: puts stderr "error: Invalid mode: $mode"
f09ab16ca1 2019-05-08 104: exit 1
f09ab16ca1 2019-05-08 105: }
f09ab16ca1 2019-05-08 106: }