Annotation For lib/xvfs/xvfs.tcl

Lines of lib/xvfs/xvfs.tcl from check-in a719156faf that are changed by the sequence of edits moving toward check-in f615eecc64:

                         1: #! /usr/bin/env tclsh
                         2: 
                         3: namespace eval ::xvfs {}
                         4: namespace eval ::xvfs::callback {}
                         5: 
                         6: set ::xvfs::_xvfsDir [file dirname [info script]]
                         7: 
                         8: # Functions
                         9: proc ::xvfs::_emitLine {line} {
                        10: 	if {[info command ::minirivet::_emitOutput] ne ""} {
                        11: 		::minirivet::_emitOutput "${line}\n"
                        12: 	} else {
                        13: 		puts $line
                        14: 	}
                        15: }
                        16: 
                        17: proc ::xvfs::printHelp {channel {errors ""}} {
                        18: 	if {[llength $errors] != 0} {
                        19: 		foreach error $errors {
                        20: 			puts $channel "error: $error"
                        21: 		}
                        22: 		puts $channel ""
                        23: 	}
                        24: 	puts $channel "Usage: dir2c \[--help\] \[--output <filename>\] --directory <rootDirectory> --name <fsName>"
                        25: 	flush $channel
                        26: }
                        27: 
                        28: proc ::xvfs::sanitizeCString {string} {
                        29: 	set output [join [lmap char [split $string ""] {
                        30: 		if {![regexp {[A-Za-z0-9./-]} $char]} {
                        31: 			binary scan $char H* char
                        32: 			set char "\\[format %03o 0x$char]"
                        33: 		}
                        34: 
                        35: 		set char
                        36: 	}] ""]
                        37: 
                        38: 	return $output
                        39: }
                        40: 
                        41: proc ::xvfs::sanitizeCStringList {list {prefix ""} {width 80}} {
                        42: 	set lines [list]
                        43: 	set row [list]
                        44: 	foreach item $list {
                        45: 		lappend row "\"[sanitizeCString $item]\""
                        46: 		
                        47: 		set rowString [join $row {, }]
                        48: 		set rowString "${prefix}${rowString}"
                        49: 		if {[string length $rowString] > $width} {
                        50: 			set row [list]
                        51: 			lappend lines "${rowString},"
                        52: 			unset rowString
                        53: 		}
                        54: 	}
                        55: 	if {[info exists rowString]} {
                        56: 		lappend lines $rowString
                        57: 	}
                        58: 	
                        59: 	return [join $lines "\n"]
                        60: }
                        61: 
                        62: proc ::xvfs::binaryToCHex {binary {prefix ""} {width 10}} {
                        63: 	set binary [binary encode hex $binary]
                        64: 	set output [list]
                        65: 
                        66: 	set width [expr {$width * 2}]
                        67: 	set stopAt [expr {$width - 1}]
                        68: 
                        69: 	set offset 0
                        70: 	while 1 {
                        71: 		set row [string range $binary $offset [expr {$offset + $stopAt}]]
                        72: 		if {[string length $row] == 0} {
                        73: 			break
                        74: 		}
                        75: 		incr offset [string length $row]
                        76: 
                        77: 		set rowOutput [list]
                        78: 		while {$row ne ""} {
                        79: 			set value [string range $row 0 1]
                        80: 			set row [string range $row 2 end]
                        81: 
                        82: 			lappend rowOutput "\\x$value"
                        83: 		}
                        84: 		set rowOutput [join $rowOutput {}]
                        85: 		set rowOutput "${prefix}\"${rowOutput}\""
                        86: 		lappend output $rowOutput
                        87: 	}
                        88: 
                        89: 	if {[llength $output] == 0} {
                        90: 		return "${prefix}\"\""
                        91: 	}
                        92: 
                        93: 	set output [join $output "\n"]
                        94: }
                        95: 
                        96: proc ::xvfs::processFile {fsName inputFile outputFile fileInfoDict} {
                        97: 	array set fileInfo $fileInfoDict
                        98: 
                        99: 	switch -exact -- $fileInfo(type) {
                       100: 		"file" {
                       101: 			set type "XVFS_FILE_TYPE_REG"
                       102: 			if {[info exists fileInfo(fileContents)]} {
                       103: 				set data $fileInfo(fileContents)
                       104: 			} else {
                       105: 				set fd [open $inputFile]
                       106: 				fconfigure $fd -encoding binary -translation binary -blocking true
                       107: 				set data [read $fd]
                       108: 				close $fd
                       109: 			}
                       110: 			set size [string length $data]
                       111: 			set data [string trimleft [binaryToCHex $data "\t\t\t"]]
                       112: 		}
                       113: 		"directory" {
                       114: 			set type "XVFS_FILE_TYPE_DIR"
                       115: 			set children $fileInfo(children)
                       116: 			set size [llength $children]
                       117: 			
                       118: 			if {$size == 0} {
                       119: 				set children "NULL"
                       120: 			} else {
                       121: 				set children [string trimleft [sanitizeCStringList $children "\t\t\t"]]
                       122: 				# This initializes it using a C99 compound literal, C99 is required
                       123: 				set children "(const char *\[\]) \{$children\}"
                       124: 			}
                       125: 		}
                       126: 		default {
                       127: 			return -code error "Unable to process $inputFile, unknown type: $fileInfo(type)"
                       128: 		}
                       129: 	}
                       130: 
                       131: 	::xvfs::_emitLine "\t\{"
                       132: 	::xvfs::_emitLine "\t\t.name = \"[sanitizeCString $outputFile]\","
                       133: 	::xvfs::_emitLine "\t\t.type = $type,"
                       134: 	::xvfs::_emitLine "\t\t.size = $size,"
                       135: 	switch -exact -- $fileInfo(type) {
                       136: 		"file" {
                       137: 			::xvfs::_emitLine "\t\t.data.fileContents = (const unsigned char *) $data"
                       138: 		}
                       139: 		"directory" {
                       140: 			::xvfs::_emitLine "\t\t.data.dirChildren  = $children"
                       141: 		}
                       142: 	}
                       143: 	::xvfs::_emitLine "\t\},"
                       144: }
                       145: 
                       146: proc ::xvfs::processDirectory {fsName directory {subDirectory ""}} {
                       147: 	set subDirectories [list]
                       148: 	set outputFiles [list]
                       149: 	set workingDirectory [file join $directory $subDirectory]
                       150: 	set outputDirectory $subDirectory
                       151: 
                       152: 	if {$subDirectory eq ""} {
                       153: 		set isTopLevel true
                       154: 	} else {
                       155: 		set isTopLevel false
                       156: 	}
                       157: 
                       158: 	if {$isTopLevel} {
                       159: 		::xvfs::_emitLine "static const struct xvfs_file_data xvfs_${fsName}_data\[\] = \{"
                       160: 	}
                       161: 
                       162: 	# XXX:TODO: Include hidden files ?
                       163: 	set children [list]
                       164: 	foreach file [glob -nocomplain -tails -directory $workingDirectory *] {
                       165: 		if {$file in {. ..}} {
                       166: 			continue
                       167: 		}
                       168: 
                       169: 		set inputFile [file join $workingDirectory $file]
                       170: 		set outputFile [file join $outputDirectory [encoding convertto utf-8 $file]]
                       171: 		set subDirectoryName [file join $outputDirectory $file]
                       172: 
                       173: 		if {[info command ::xvfs::callback::setOutputFileName] ne ""} {
                       174: 			set outputFile [::xvfs::callback::setOutputFileName $file $workingDirectory $inputFile $outputDirectory $outputFile]
                       175: 			if {$outputFile eq "/"} {
                       176: 				continue
                       177: 			}
                       178: 		}
                       179: 
                       180: 		unset -nocomplain fileInfo
                       181: 		catch {
                       182: 			file lstat $inputFile fileInfo
                       183: 		}
                       184: 		if {![info exists fileInfo]} {
                       185: 			puts stderr "warning: Unable to access $inputFile, skipping"
                       186: 		}
                       187: 
                       188: 		if {$fileInfo(type) eq "directory"} {
                       189: 			lappend subDirectories $subDirectoryName
                       190: 			continue
                       191: 		}
                       192: 
                       193: 		processFile $fsName $inputFile $outputFile [array get fileInfo]
                       194: 		lappend outputFiles $outputFile
                       195: 	}
                       196: 
                       197: 	foreach subDirectory $subDirectories {
                       198: 		lappend outputFiles {*}[processDirectory $fsName $directory $subDirectory]
                       199: 	}
                       200: 	
                       201: 	set inputFile $directory
                       202: 	set outputFile $outputDirectory
                       203: 	if {[info command ::xvfs::callback::setOutputFileName] ne ""} {
                       204: 		set outputFile [::xvfs::callback::setOutputFileName $directory $directory $inputFile $outputDirectory $outputFile]
                       205: 	}
                       206: 
                       207: 	if {$outputFile ne "/"} {
                       208: 		unset -nocomplain fileInfo
                       209: 		file stat $inputFile fileInfo
                       210: 		set children [list]
                       211: 		set outputFileLen [string length $outputFile]
                       212: 		foreach child $outputFiles {
                       213: 			if {[string range /$child 0 $outputFileLen] eq "/${outputFile}"} {
                       214: 				set child [string trimleft [string range $child $outputFileLen end] /]
                       215: 				if {![string match "*/*" $child]} {
                       216: 					lappend children $child
                       217: 				}
                       218: 			}
                       219: 		}
                       220: 		set fileInfo(children) $children
                       221: 
                       222: 		processFile $fsName $inputFile $outputFile [array get fileInfo]
                       223: 		lappend outputFiles $outputFile
                       224: 	}
                       225: 
                       226: 	if {$isTopLevel} {
                       227: 		if {[info command ::xvfs::callback::addOutputFiles] ne ""} {
                       228: 			lappend outputFiles {*}[::xvfs::callback::addOutputFiles $fsName]
                       229: 		}
                       230: 
                       231: 		::xvfs::_emitLine "\};"
                       232: 	}
                       233: 
                       234: 	return $outputFiles
                       235: }
                       236: 
                       237: proc ::xvfs::main {argv} {
                       238: 	# Main entry point
                       239: 	## 1. Parse arguments
                       240: 	if {[llength $argv] % 2 != 0} {
                       241: 		lappend argv ""
                       242: 	}
                       243: 
                       244: 	foreach {arg val} $argv {
                       245: 		switch -exact -- $arg {
                       246: 			"--help" {
                       247: 				printHelp stdout
                       248: 				exit 0
                       249: 			}
                       250: 			"--directory" {
                       251: 				set rootDirectory $val
                       252: 			}
                       253: 			"--name" {
                       254: 				set fsName $val
                       255: 			}
                       256: 			"--output" - "--header" {
                       257: 				# Ignored, handled as part of some other process
                       258: 			}
                       259: 			default {
                       260: 				printHelp stderr [list "Invalid option: $arg $val"]
                       261: 				exit 1
                       262: 			}
                       263: 		}
                       264: 	}
                       265: 
                       266: 	## 2. Validate arguments
                       267: 	set errors [list]
                       268: 	if {![info exists rootDirectory]} {
                       269: 		lappend errors "--directory must be specified"
                       270: 	}
                       271: 	if {![info exists fsName]} {
                       272: 		lappend errors "--name must be specified"
                       273: 	}
                       274: 
                       275: 	if {[llength $errors] != 0} {
                       276: 		printHelp stderr $errors
                       277: 		exit 1
                       278: 	}
                       279: 
                       280: 	## 3. Start processing directory and producing initial output
                       281: 	set ::xvfs::outputFiles [processDirectory $fsName $rootDirectory]
                       282: 
                       283: 	set ::xvfs::fsName $fsName
                       284: 	set ::xvfs::rootDirectory $rootDirectory
                       285: }
                       286: 
                       287: proc ::xvfs::run {args} {
                       288: 	uplevel #0 { package require minirivet }
                       289: 
                       290: 	set ::xvfs::argv $args
                       291: 	::minirivet::parse [file join $::xvfs::_xvfsDir xvfs.c.rvt]
                       292: }
                       293: 
                       294: proc ::xvfs::setOutputChannel {channel} {
                       295: 	uplevel #0 { package require minirivet }
                       296: 	tailcall ::minirivet::setOutputChannel $channel
                       297: }
                       298: 
                       299: proc ::xvfs::setOutputVariable {variable} {
                       300: 	uplevel #0 { package require minirivet }
                       301: 	tailcall ::minirivet::setOutputVariable $variable
                       302: }
                       303: 
                       304: proc ::xvfs::staticIncludeHeaderData {headerData} {
                       305: 	set ::xvfs::xvfsCoreH $headerData
                       306: }
                       307: 
                       308: proc ::xvfs::staticIncludeHeader {pathToHeaderFile} {
                       309: 	set fd [open $pathToHeaderFile]
                       310: 	::xvfs::staticIncludeHeaderData [read $fd]
                       311: 	close $fd
                       312: }
                       313: 
a719156faf 2019-10-09  314: proc ::xvfs::generatePerfectHashFunctionCall {cVarName cVarLength invalidValue nameList} {
a719156faf 2019-10-09  315: 	set minVal 0
a719156faf 2019-10-09  316: 	set maxVal [llength $nameList]
a719156faf 2019-10-09  317: 	set testExpr {([zlib adler32 $nameItem $alpha] + $beta) % $gamma}
a719156faf 2019-10-09  318: 	set testExprC {((Tcl_ZlibAdler32($alpha, (unsigned char *) $cVarName, $cVarLength) + $beta) % $gamma)}
a719156faf 2019-10-09  319: 
a719156faf 2019-10-09  320: 	set round -1
a719156faf 2019-10-09  321: 
a719156faf 2019-10-09  322: 	set beta 0
a719156faf 2019-10-09  323: 	set gamma $maxVal
a719156faf 2019-10-09  324: 
a719156faf 2019-10-09  325: 	while true {
a719156faf 2019-10-09  326: 		incr round
a719156faf 2019-10-09  327: 
a719156faf 2019-10-09  328: 		set alpha $round
a719156faf 2019-10-09  329: 		set gamma [expr {($round % ($maxVal + 1)) + $maxVal}]
a719156faf 2019-10-09  330: 
a719156faf 2019-10-09  331: 		set idx -1
a719156faf 2019-10-09  332: 		set seenIndexes [list]
a719156faf 2019-10-09  333: 		set failed false
a719156faf 2019-10-09  334: 		foreach nameItem $nameList {
a719156faf 2019-10-09  335: 			incr idx
a719156faf 2019-10-09  336: 
a719156faf 2019-10-09  337: 			set testExprVal [expr $testExpr]
a719156faf 2019-10-09  338: 
a719156faf 2019-10-09  339: 			if {$testExprVal in $seenIndexes} {
a719156faf 2019-10-09  340: 				incr alpha
a719156faf 2019-10-09  341: 				set failed true
a719156faf 2019-10-09  342: 				break
a719156faf 2019-10-09  343: 			}
a719156faf 2019-10-09  344: 
a719156faf 2019-10-09  345: 			lappend seenIndexes $testExprVal
                       346: 		}
                       347: 
                       348: 		if {!$failed} {
                       349: 			break
                       350: 		}
                       351: 	}
                       352: 
a719156faf 2019-10-09  353: 	unset -nocomplain mapArray
a719156faf 2019-10-09  354: 	for {set idx 0} {$idx < $gamma} {incr idx} {
a719156faf 2019-10-09  355: 		set mapArray($idx) $invalidValue
a719156faf 2019-10-09  356: 	}
a719156faf 2019-10-09  357: 
a719156faf 2019-10-09  358: 	set idx -1
a719156faf 2019-10-09  359: 	foreach nameItem $nameList {
a719156faf 2019-10-09  360: 		incr idx
a719156faf 2019-10-09  361: 
a719156faf 2019-10-09  362: 		set mapArray([expr $testExpr]) $idx
a719156faf 2019-10-09  363: 	}
a719156faf 2019-10-09  364: 
a719156faf 2019-10-09  365: 	set map "(long\[\])\{"
a719156faf 2019-10-09  366: 	for {set idx 0} {$idx < $gamma} {incr idx} {
a719156faf 2019-10-09  367: 		append map "$mapArray($idx), "
a719156faf 2019-10-09  368: 	}
a719156faf 2019-10-09  369: 	set map [string range $map 0 end-2]
a719156faf 2019-10-09  370: 	append map "\}\[[subst $testExprC]\]"
a719156faf 2019-10-09  371: 	set phfCall $map
                       372: 
                       373: 	return $phfCall
                       374: }
                       375: 
                       376: package provide xvfs 1