Annotation For lib/xvfs/xvfs.tcl

Origin for each line in lib/xvfs/xvfs.tcl from check-in 717062426a:

47dcf5fc27 2019-05-01    1: #! /usr/bin/env tclsh
47dcf5fc27 2019-05-01    2: 
47dcf5fc27 2019-05-01    3: namespace eval ::xvfs {}
0e8537c65f 2019-09-20    4: namespace eval ::xvfs::callback {}
2b7fa3a8fa 2019-09-20    5: 
2b7fa3a8fa 2019-09-20    6: set ::xvfs::_xvfsDir [file dirname [info script]]
47dcf5fc27 2019-05-01    7: 
47dcf5fc27 2019-05-01    8: # Functions
0bdbe4333e 2019-09-20    9: proc ::xvfs::_emitLine {line} {
eebfe1f40f 2020-03-25   10: 	lappend ::xvfs::_emitLine $line
0bdbe4333e 2019-09-20   11: }
0bdbe4333e 2019-09-20   12: 
47dcf5fc27 2019-05-01   13: proc ::xvfs::printHelp {channel {errors ""}} {
47dcf5fc27 2019-05-01   14: 	if {[llength $errors] != 0} {
47dcf5fc27 2019-05-01   15: 		foreach error $errors {
702c74c153 2019-09-20   16: 			puts $channel "error: $error"
47dcf5fc27 2019-05-01   17: 		}
702c74c153 2019-09-20   18: 		puts $channel ""
47dcf5fc27 2019-05-01   19: 	}
717062426a 2020-04-13   20: 	puts $channel "Usage: xvfs-create \[--help\] \[--static-init {true|false}\] \[--set-mode {flexible|standalone|client}\] \[--output <filename>\] --directory <rootDirectory> --name <fsName>"
47dcf5fc27 2019-05-01   21: 	flush $channel
47dcf5fc27 2019-05-01   22: }
47dcf5fc27 2019-05-01   23: 
47dcf5fc27 2019-05-01   24: proc ::xvfs::sanitizeCString {string} {
47dcf5fc27 2019-05-01   25: 	set output [join [lmap char [split $string ""] {
47dcf5fc27 2019-05-01   26: 		if {![regexp {[A-Za-z0-9./-]} $char]} {
47dcf5fc27 2019-05-01   27: 			binary scan $char H* char
47dcf5fc27 2019-05-01   28: 			set char "\\[format %03o 0x$char]"
47dcf5fc27 2019-05-01   29: 		}
47dcf5fc27 2019-05-01   30: 
47dcf5fc27 2019-05-01   31: 		set char
47dcf5fc27 2019-05-01   32: 	}] ""]
47dcf5fc27 2019-05-01   33: 
47dcf5fc27 2019-05-01   34: 	return $output
47dcf5fc27 2019-05-01   35: }
47dcf5fc27 2019-05-01   36: 
32b55a907b 2019-05-02   37: proc ::xvfs::sanitizeCStringList {list {prefix ""} {width 80}} {
32b55a907b 2019-05-02   38: 	set lines [list]
32b55a907b 2019-05-02   39: 	set row [list]
32b55a907b 2019-05-02   40: 	foreach item $list {
32b55a907b 2019-05-02   41: 		lappend row "\"[sanitizeCString $item]\""
32b55a907b 2019-05-02   42: 		
32b55a907b 2019-05-02   43: 		set rowString [join $row {, }]
32b55a907b 2019-05-02   44: 		set rowString "${prefix}${rowString}"
32b55a907b 2019-05-02   45: 		if {[string length $rowString] > $width} {
32b55a907b 2019-05-02   46: 			set row [list]
d961175fd9 2019-09-20   47: 			lappend lines "${rowString},"
32b55a907b 2019-05-02   48: 			unset rowString
32b55a907b 2019-05-02   49: 		}
32b55a907b 2019-05-02   50: 	}
32b55a907b 2019-05-02   51: 	if {[info exists rowString]} {
32b55a907b 2019-05-02   52: 		lappend lines $rowString
32b55a907b 2019-05-02   53: 	}
32b55a907b 2019-05-02   54: 	
32b55a907b 2019-05-02   55: 	return [join $lines "\n"]
32b55a907b 2019-05-02   56: }
32b55a907b 2019-05-02   57: 
47dcf5fc27 2019-05-01   58: proc ::xvfs::binaryToCHex {binary {prefix ""} {width 10}} {
2176e9cacf 2019-09-18   59: 	set binary [binary encode hex $binary]
47dcf5fc27 2019-05-01   60: 	set output [list]
47dcf5fc27 2019-05-01   61: 
47dcf5fc27 2019-05-01   62: 	set width [expr {$width * 2}]
47dcf5fc27 2019-05-01   63: 	set stopAt [expr {$width - 1}]
47dcf5fc27 2019-05-01   64: 
2176e9cacf 2019-09-18   65: 	set offset 0
2176e9cacf 2019-09-18   66: 	while 1 {
2176e9cacf 2019-09-18   67: 		set row [string range $binary $offset [expr {$offset + $stopAt}]]
2176e9cacf 2019-09-18   68: 		if {[string length $row] == 0} {
2176e9cacf 2019-09-18   69: 			break
2176e9cacf 2019-09-18   70: 		}
2176e9cacf 2019-09-18   71: 		incr offset [string length $row]
47dcf5fc27 2019-05-01   72: 
47dcf5fc27 2019-05-01   73: 		set rowOutput [list]
47dcf5fc27 2019-05-01   74: 		while {$row ne ""} {
47dcf5fc27 2019-05-01   75: 			set value [string range $row 0 1]
47dcf5fc27 2019-05-01   76: 			set row [string range $row 2 end]
47dcf5fc27 2019-05-01   77: 
47dcf5fc27 2019-05-01   78: 			lappend rowOutput "\\x$value"
47dcf5fc27 2019-05-01   79: 		}
47dcf5fc27 2019-05-01   80: 		set rowOutput [join $rowOutput {}]
47dcf5fc27 2019-05-01   81: 		set rowOutput "${prefix}\"${rowOutput}\""
47dcf5fc27 2019-05-01   82: 		lappend output $rowOutput
47dcf5fc27 2019-05-01   83: 	}
47dcf5fc27 2019-05-01   84: 
47dcf5fc27 2019-05-01   85: 	if {[llength $output] == 0} {
47dcf5fc27 2019-05-01   86: 		return "${prefix}\"\""
47dcf5fc27 2019-05-01   87: 	}
47dcf5fc27 2019-05-01   88: 
47dcf5fc27 2019-05-01   89: 	set output [join $output "\n"]
47dcf5fc27 2019-05-01   90: }
47dcf5fc27 2019-05-01   91: 
47dcf5fc27 2019-05-01   92: proc ::xvfs::processFile {fsName inputFile outputFile fileInfoDict} {
47dcf5fc27 2019-05-01   93: 	array set fileInfo $fileInfoDict
47dcf5fc27 2019-05-01   94: 
47dcf5fc27 2019-05-01   95: 	switch -exact -- $fileInfo(type) {
47dcf5fc27 2019-05-01   96: 		"file" {
47dcf5fc27 2019-05-01   97: 			set type "XVFS_FILE_TYPE_REG"
d8e00cd4a3 2019-09-20   98: 			if {[info exists fileInfo(fileContents)]} {
d8e00cd4a3 2019-09-20   99: 				set data $fileInfo(fileContents)
d8e00cd4a3 2019-09-20  100: 			} else {
d8e00cd4a3 2019-09-20  101: 				set fd [open $inputFile]
d8e00cd4a3 2019-09-20  102: 				fconfigure $fd -encoding binary -translation binary -blocking true
d8e00cd4a3 2019-09-20  103: 				set data [read $fd]
d8e00cd4a3 2019-09-20  104: 				close $fd
d8e00cd4a3 2019-09-20  105: 			}
47dcf5fc27 2019-05-01  106: 			set size [string length $data]
47dcf5fc27 2019-05-01  107: 			set data [string trimleft [binaryToCHex $data "\t\t\t"]]
47dcf5fc27 2019-05-01  108: 		}
47dcf5fc27 2019-05-01  109: 		"directory" {
47dcf5fc27 2019-05-01  110: 			set type "XVFS_FILE_TYPE_DIR"
32b55a907b 2019-05-02  111: 			set children $fileInfo(children)
32b55a907b 2019-05-02  112: 			set size [llength $children]
32b55a907b 2019-05-02  113: 			
32b55a907b 2019-05-02  114: 			if {$size == 0} {
32b55a907b 2019-05-02  115: 				set children "NULL"
32b55a907b 2019-05-02  116: 			} else {
32b55a907b 2019-05-02  117: 				set children [string trimleft [sanitizeCStringList $children "\t\t\t"]]
32b55a907b 2019-05-02  118: 				# This initializes it using a C99 compound literal, C99 is required
32b55a907b 2019-05-02  119: 				set children "(const char *\[\]) \{$children\}"
32b55a907b 2019-05-02  120: 			}
47dcf5fc27 2019-05-01  121: 		}
47dcf5fc27 2019-05-01  122: 		default {
47dcf5fc27 2019-05-01  123: 			return -code error "Unable to process $inputFile, unknown type: $fileInfo(type)"
47dcf5fc27 2019-05-01  124: 		}
47dcf5fc27 2019-05-01  125: 	}
47dcf5fc27 2019-05-01  126: 
0bdbe4333e 2019-09-20  127: 	::xvfs::_emitLine "\t\{"
0bdbe4333e 2019-09-20  128: 	::xvfs::_emitLine "\t\t.name = \"[sanitizeCString $outputFile]\","
0bdbe4333e 2019-09-20  129: 	::xvfs::_emitLine "\t\t.type = $type,"
32b55a907b 2019-05-02  130: 	switch -exact -- $fileInfo(type) {
32b55a907b 2019-05-02  131: 		"file" {
eebfe1f40f 2020-03-25  132: 			::xvfs::_emitLine "\t\t.data.fileContents = (const unsigned char *) $data,"
32b55a907b 2019-05-02  133: 		}
32b55a907b 2019-05-02  134: 		"directory" {
eebfe1f40f 2020-03-25  135: 			::xvfs::_emitLine "\t\t.data.dirChildren  = $children,"
32b55a907b 2019-05-02  136: 		}
32b55a907b 2019-05-02  137: 	}
eebfe1f40f 2020-03-25  138: 	::xvfs::_emitLine "\t\t.size = $size"
0bdbe4333e 2019-09-20  139: 	::xvfs::_emitLine "\t\},"
47dcf5fc27 2019-05-01  140: }
47dcf5fc27 2019-05-01  141: 
47dcf5fc27 2019-05-01  142: proc ::xvfs::processDirectory {fsName directory {subDirectory ""}} {
47dcf5fc27 2019-05-01  143: 	set subDirectories [list]
47dcf5fc27 2019-05-01  144: 	set outputFiles [list]
47dcf5fc27 2019-05-01  145: 	set workingDirectory [file join $directory $subDirectory]
47dcf5fc27 2019-05-01  146: 	set outputDirectory $subDirectory
47dcf5fc27 2019-05-01  147: 
47dcf5fc27 2019-05-01  148: 	if {$subDirectory eq ""} {
47dcf5fc27 2019-05-01  149: 		set isTopLevel true
47dcf5fc27 2019-05-01  150: 	} else {
47dcf5fc27 2019-05-01  151: 		set isTopLevel false
47dcf5fc27 2019-05-01  152: 	}
47dcf5fc27 2019-05-01  153: 
47dcf5fc27 2019-05-01  154: 	if {$isTopLevel} {
0bdbe4333e 2019-09-20  155: 		::xvfs::_emitLine "static const struct xvfs_file_data xvfs_${fsName}_data\[\] = \{"
47dcf5fc27 2019-05-01  156: 	}
47dcf5fc27 2019-05-01  157: 
47dcf5fc27 2019-05-01  158: 	# XXX:TODO: Include hidden files ?
32b55a907b 2019-05-02  159: 	set children [list]
47dcf5fc27 2019-05-01  160: 	foreach file [glob -nocomplain -tails -directory $workingDirectory *] {
47dcf5fc27 2019-05-01  161: 		if {$file in {. ..}} {
47dcf5fc27 2019-05-01  162: 			continue
47dcf5fc27 2019-05-01  163: 		}
47dcf5fc27 2019-05-01  164: 
47dcf5fc27 2019-05-01  165: 		set inputFile [file join $workingDirectory $file]
d99958bdd3 2019-05-03  166: 		set outputFile [file join $outputDirectory [encoding convertto utf-8 $file]]
30c469fcf7 2019-09-20  167: 		set subDirectoryName [file join $outputDirectory $file]
0e8537c65f 2019-09-20  168: 
0e8537c65f 2019-09-20  169: 		if {[info command ::xvfs::callback::setOutputFileName] ne ""} {
ed3da129b8 2019-09-20  170: 			set outputFile [::xvfs::callback::setOutputFileName $file $workingDirectory $inputFile $outputDirectory $outputFile]
e592c85e70 2019-09-20  171: 			if {$outputFile eq "/"} {
0e8537c65f 2019-09-20  172: 				continue
0e8537c65f 2019-09-20  173: 			}
0e8537c65f 2019-09-20  174: 		}
47dcf5fc27 2019-05-01  175: 
47dcf5fc27 2019-05-01  176: 		unset -nocomplain fileInfo
47dcf5fc27 2019-05-01  177: 		catch {
47dcf5fc27 2019-05-01  178: 			file lstat $inputFile fileInfo
47dcf5fc27 2019-05-01  179: 		}
47dcf5fc27 2019-05-01  180: 		if {![info exists fileInfo]} {
30ffb49c05 2019-09-20  181: 			puts stderr "warning: Unable to access $inputFile, skipping"
47dcf5fc27 2019-05-01  182: 		}
47dcf5fc27 2019-05-01  183: 
47dcf5fc27 2019-05-01  184: 		if {$fileInfo(type) eq "directory"} {
30c469fcf7 2019-09-20  185: 			lappend subDirectories $subDirectoryName
32b55a907b 2019-05-02  186: 			continue
47dcf5fc27 2019-05-01  187: 		}
47dcf5fc27 2019-05-01  188: 
47dcf5fc27 2019-05-01  189: 		processFile $fsName $inputFile $outputFile [array get fileInfo]
47dcf5fc27 2019-05-01  190: 		lappend outputFiles $outputFile
47dcf5fc27 2019-05-01  191: 	}
47dcf5fc27 2019-05-01  192: 
47dcf5fc27 2019-05-01  193: 	foreach subDirectory $subDirectories {
47dcf5fc27 2019-05-01  194: 		lappend outputFiles {*}[processDirectory $fsName $directory $subDirectory]
47dcf5fc27 2019-05-01  195: 	}
32b55a907b 2019-05-02  196: 	
32b55a907b 2019-05-02  197: 	set inputFile $directory
32b55a907b 2019-05-02  198: 	set outputFile $outputDirectory
e592c85e70 2019-09-20  199: 	if {[info command ::xvfs::callback::setOutputFileName] ne ""} {
e592c85e70 2019-09-20  200: 		set outputFile [::xvfs::callback::setOutputFileName $directory $directory $inputFile $outputDirectory $outputFile]
e592c85e70 2019-09-20  201: 	}
32b55a907b 2019-05-02  202: 
e592c85e70 2019-09-20  203: 	if {$outputFile ne "/"} {
e592c85e70 2019-09-20  204: 		unset -nocomplain fileInfo
e592c85e70 2019-09-20  205: 		file stat $inputFile fileInfo
30c469fcf7 2019-09-20  206: 		set children [list]
30c469fcf7 2019-09-20  207: 		set outputFileLen [string length $outputFile]
30c469fcf7 2019-09-20  208: 		foreach child $outputFiles {
30c469fcf7 2019-09-20  209: 			if {[string range /$child 0 $outputFileLen] eq "/${outputFile}"} {
30c469fcf7 2019-09-20  210: 				set child [string trimleft [string range $child $outputFileLen end] /]
30c469fcf7 2019-09-20  211: 				if {![string match "*/*" $child]} {
30c469fcf7 2019-09-20  212: 					lappend children $child
30c469fcf7 2019-09-20  213: 				}
30c469fcf7 2019-09-20  214: 			}
30c469fcf7 2019-09-20  215: 		}
e592c85e70 2019-09-20  216: 		set fileInfo(children) $children
e592c85e70 2019-09-20  217: 
e592c85e70 2019-09-20  218: 		processFile $fsName $inputFile $outputFile [array get fileInfo]
e592c85e70 2019-09-20  219: 		lappend outputFiles $outputFile
e592c85e70 2019-09-20  220: 	}
47dcf5fc27 2019-05-01  221: 
47dcf5fc27 2019-05-01  222: 	if {$isTopLevel} {
d8e00cd4a3 2019-09-20  223: 		if {[info command ::xvfs::callback::addOutputFiles] ne ""} {
e592c85e70 2019-09-20  224: 			lappend outputFiles {*}[::xvfs::callback::addOutputFiles $fsName]
d8e00cd4a3 2019-09-20  225: 		}
d8e00cd4a3 2019-09-20  226: 
0bdbe4333e 2019-09-20  227: 		::xvfs::_emitLine "\};"
47dcf5fc27 2019-05-01  228: 	}
47dcf5fc27 2019-05-01  229: 
47dcf5fc27 2019-05-01  230: 	return $outputFiles
47dcf5fc27 2019-05-01  231: }
47dcf5fc27 2019-05-01  232: 
47dcf5fc27 2019-05-01  233: proc ::xvfs::main {argv} {
47dcf5fc27 2019-05-01  234: 	# Main entry point
47dcf5fc27 2019-05-01  235: 	## 1. Parse arguments
47dcf5fc27 2019-05-01  236: 	if {[llength $argv] % 2 != 0} {
47dcf5fc27 2019-05-01  237: 		lappend argv ""
47dcf5fc27 2019-05-01  238: 	}
47dcf5fc27 2019-05-01  239: 
717062426a 2020-04-13  240: 	set staticInit false
47dcf5fc27 2019-05-01  241: 	foreach {arg val} $argv {
47dcf5fc27 2019-05-01  242: 		switch -exact -- $arg {
47dcf5fc27 2019-05-01  243: 			"--help" {
47dcf5fc27 2019-05-01  244: 				printHelp stdout
47dcf5fc27 2019-05-01  245: 				exit 0
47dcf5fc27 2019-05-01  246: 			}
47dcf5fc27 2019-05-01  247: 			"--directory" {
47dcf5fc27 2019-05-01  248: 				set rootDirectory $val
47dcf5fc27 2019-05-01  249: 			}
47dcf5fc27 2019-05-01  250: 			"--name" {
47dcf5fc27 2019-05-01  251: 				set fsName $val
717062426a 2020-04-13  252: 			}
717062426a 2020-04-13  253: 			"--static-init" {
717062426a 2020-04-13  254: 				set staticInit $val
807cab65f7 2020-03-25  255: 			}
807cab65f7 2020-03-25  256: 			"--output" - "--header" - "--set-mode" {
0bdbe4333e 2019-09-20  257: 				# Ignored, handled as part of some other process
47dcf5fc27 2019-05-01  258: 			}
47dcf5fc27 2019-05-01  259: 			default {
47dcf5fc27 2019-05-01  260: 				printHelp stderr [list "Invalid option: $arg $val"]
47dcf5fc27 2019-05-01  261: 				exit 1
47dcf5fc27 2019-05-01  262: 			}
47dcf5fc27 2019-05-01  263: 		}
47dcf5fc27 2019-05-01  264: 	}
47dcf5fc27 2019-05-01  265: 
47dcf5fc27 2019-05-01  266: 	## 2. Validate arguments
47dcf5fc27 2019-05-01  267: 	set errors [list]
47dcf5fc27 2019-05-01  268: 	if {![info exists rootDirectory]} {
47dcf5fc27 2019-05-01  269: 		lappend errors "--directory must be specified"
47dcf5fc27 2019-05-01  270: 	}
47dcf5fc27 2019-05-01  271: 	if {![info exists fsName]} {
47dcf5fc27 2019-05-01  272: 		lappend errors "--name must be specified"
47dcf5fc27 2019-05-01  273: 	}
47dcf5fc27 2019-05-01  274: 
47dcf5fc27 2019-05-01  275: 	if {[llength $errors] != 0} {
47dcf5fc27 2019-05-01  276: 		printHelp stderr $errors
47dcf5fc27 2019-05-01  277: 		exit 1
47dcf5fc27 2019-05-01  278: 	}
47dcf5fc27 2019-05-01  279: 
717062426a 2020-04-13  280: 	## 3. Initialization
717062426a 2020-04-13  281: 	if {$staticInit} {
717062426a 2020-04-13  282: 		::xvfs::_emitLine "#define XVFS_${fsName}_INIT_STATIC 1"
717062426a 2020-04-13  283: 	}
717062426a 2020-04-13  284: 
717062426a 2020-04-13  285: 	## 4. Start processing directory and producing initial output
32b55a907b 2019-05-02  286: 	set ::xvfs::outputFiles [processDirectory $fsName $rootDirectory]
47dcf5fc27 2019-05-01  287: 
47dcf5fc27 2019-05-01  288: 	set ::xvfs::fsName $fsName
47dcf5fc27 2019-05-01  289: 	set ::xvfs::rootDirectory $rootDirectory
eebfe1f40f 2020-03-25  290: 
eebfe1f40f 2020-03-25  291: 	# Return the output
eebfe1f40f 2020-03-25  292: 	return [join $::xvfs::_emitLine "\n"]
2b7fa3a8fa 2019-09-20  293: }
2b7fa3a8fa 2019-09-20  294: 
e592c85e70 2019-09-20  295: proc ::xvfs::run {args} {
d36db7c01b 2019-09-20  296: 	uplevel #0 { package require minirivet }
3cb72a0d20 2019-09-20  297: 
e592c85e70 2019-09-20  298: 	set ::xvfs::argv $args
2b7fa3a8fa 2019-09-20  299: 	::minirivet::parse [file join $::xvfs::_xvfsDir xvfs.c.rvt]
2b7fa3a8fa 2019-09-20  300: }
2b7fa3a8fa 2019-09-20  301: 
d36db7c01b 2019-09-20  302: proc ::xvfs::setOutputChannel {channel} {
d36db7c01b 2019-09-20  303: 	uplevel #0 { package require minirivet }
d36db7c01b 2019-09-20  304: 	tailcall ::minirivet::setOutputChannel $channel
d36db7c01b 2019-09-20  305: }
d36db7c01b 2019-09-20  306: 
d36db7c01b 2019-09-20  307: proc ::xvfs::setOutputVariable {variable} {
d36db7c01b 2019-09-20  308: 	uplevel #0 { package require minirivet }
d36db7c01b 2019-09-20  309: 	tailcall ::minirivet::setOutputVariable $variable
09e53d3c38 2019-09-20  310: }
09e53d3c38 2019-09-20  311: 
09e53d3c38 2019-09-20  312: proc ::xvfs::staticIncludeHeaderData {headerData} {
09e53d3c38 2019-09-20  313: 	set ::xvfs::xvfsCoreH $headerData
09e53d3c38 2019-09-20  314: }
09e53d3c38 2019-09-20  315: 
09e53d3c38 2019-09-20  316: proc ::xvfs::staticIncludeHeader {pathToHeaderFile} {
09e53d3c38 2019-09-20  317: 	set fd [open $pathToHeaderFile]
09e53d3c38 2019-09-20  318: 	::xvfs::staticIncludeHeaderData [read $fd]
09e53d3c38 2019-09-20  319: 	close $fd
807cab65f7 2020-03-25  320: }
807cab65f7 2020-03-25  321: 
807cab65f7 2020-03-25  322: proc ::xvfs::setSpecificMode {mode} {
807cab65f7 2020-03-25  323: 	::minirivet::_emitOutput "#undef XVFS_MODE_SERVER\n"
807cab65f7 2020-03-25  324: 	::minirivet::_emitOutput "#undef XVFS_MODE_CLIENT\n"
807cab65f7 2020-03-25  325: 	::minirivet::_emitOutput "#undef XVFS_MODE_FLEXIBLE\n"
807cab65f7 2020-03-25  326: 	::minirivet::_emitOutput "#undef XVFS_MODE_STANDALONE\n"
807cab65f7 2020-03-25  327: 	::minirivet::_emitOutput "#define XVFS_MODE_[string toupper $mode] 1\n"
37d00c3cfb 2019-11-04  328: }
37d00c3cfb 2019-11-04  329: 
37d00c3cfb 2019-11-04  330: proc ::xvfs::_tryFit {list} {
37d00c3cfb 2019-11-04  331: 	set idx -1
37d00c3cfb 2019-11-04  332: 	set lastItem -100000
37d00c3cfb 2019-11-04  333: 	foreach item $list {
37d00c3cfb 2019-11-04  334: 		incr idx
37d00c3cfb 2019-11-04  335: 
37d00c3cfb 2019-11-04  336: 		if {$item <= $lastItem} {
37d00c3cfb 2019-11-04  337: 			return ""
37d00c3cfb 2019-11-04  338: 		}
37d00c3cfb 2019-11-04  339: 
37d00c3cfb 2019-11-04  340: 		set difference [expr {$item - $idx}]
37d00c3cfb 2019-11-04  341: 		if {$idx != 0} {
37d00c3cfb 2019-11-04  342: 			set divisor [expr {$item / $idx}]
37d00c3cfb 2019-11-04  343: 		} else {
37d00c3cfb 2019-11-04  344: 			set divisor 1
37d00c3cfb 2019-11-04  345: 		}
37d00c3cfb 2019-11-04  346: 		lappend differences $difference
37d00c3cfb 2019-11-04  347: 		lappend divisors $divisor
37d00c3cfb 2019-11-04  348: 
37d00c3cfb 2019-11-04  349: 		set lastItem $item
37d00c3cfb 2019-11-04  350: 	}
37d00c3cfb 2019-11-04  351: 
37d00c3cfb 2019-11-04  352: 	foreach divisor [lrange $divisors 1 end] {
37d00c3cfb 2019-11-04  353: 		incr divisorCount
37d00c3cfb 2019-11-04  354: 		incr divisorValue $divisor
37d00c3cfb 2019-11-04  355: 	}
37d00c3cfb 2019-11-04  356: 	set divisor [expr {$divisorValue / $divisorCount}]
37d00c3cfb 2019-11-04  357: 
37d00c3cfb 2019-11-04  358: 	for {set i 0} {$i < [llength $list]} {incr i} {
37d00c3cfb 2019-11-04  359: 		lappend outList $i
37d00c3cfb 2019-11-04  360: 	}
37d00c3cfb 2019-11-04  361: 
37d00c3cfb 2019-11-04  362: 	set mapFunc " - ${difference}"
37d00c3cfb 2019-11-04  363: 
37d00c3cfb 2019-11-04  364: 	set newList [lmap v $list { expr "\$v${mapFunc}" }]
37d00c3cfb 2019-11-04  365: 	if {$newList eq $outList} {
37d00c3cfb 2019-11-04  366: 		return $mapFunc
37d00c3cfb 2019-11-04  367: 	}
37d00c3cfb 2019-11-04  368: 
37d00c3cfb 2019-11-04  369: 	if {$divisor != 1} {
37d00c3cfb 2019-11-04  370: 		set mapFunc " / ${divisor}"
37d00c3cfb 2019-11-04  371: 		set newList [lmap v $list { expr "\$v${mapFunc}" }]
37d00c3cfb 2019-11-04  372: 		if {$newList eq $outList} {
37d00c3cfb 2019-11-04  373: 			return $mapFunc
37d00c3cfb 2019-11-04  374: 		}
37d00c3cfb 2019-11-04  375: 
37d00c3cfb 2019-11-04  376: 		set subMapFunc [_tryFit $newList]
37d00c3cfb 2019-11-04  377: 		if {$subMapFunc != ""} {
37d00c3cfb 2019-11-04  378: 			return " / ${divisor}${subMapFunc}"
37d00c3cfb 2019-11-04  379: 		}
37d00c3cfb 2019-11-04  380: 	}
37d00c3cfb 2019-11-04  381: 
37d00c3cfb 2019-11-04  382: 	return ""
37d00c3cfb 2019-11-04  383: }
37d00c3cfb 2019-11-04  384: 
f615eecc64 2019-10-10  385: proc ::xvfs::generatePerfectHashFunctionCall {cVarName cVarLength invalidValue nameList args} {
37d00c3cfb 2019-11-04  386: 	# Manage config
37d00c3cfb 2019-11-04  387: 	## Default config
f615eecc64 2019-10-10  388: 	array set config {
37d00c3cfb 2019-11-04  389: 		useCacheFirst  false
37d00c3cfb 2019-11-04  390: 		cacheValue     true
37d00c3cfb 2019-11-04  391: 		enableCache    false
f615eecc64 2019-10-10  392: 	}
37d00c3cfb 2019-11-04  393: 	set config(cacheFile) [file join [file normalize ~/.cache] xvfs phf-cache.db]
f615eecc64 2019-10-10  394: 
37d00c3cfb 2019-11-04  395: 	## User config
f615eecc64 2019-10-10  396: 	foreach {configKey configVal} $args {
f615eecc64 2019-10-10  397: 		if {![info exists config($configKey)]} {
f615eecc64 2019-10-10  398: 			error "Invalid option: $configKey"
f615eecc64 2019-10-10  399: 		}
f615eecc64 2019-10-10  400: 	}
f615eecc64 2019-10-10  401: 	array set config $args
f615eecc64 2019-10-10  402: 
37d00c3cfb 2019-11-04  403: 	if {$config(enableCache)} {
37d00c3cfb 2019-11-04  404: 		package require sqlite3
37d00c3cfb 2019-11-04  405: 	}
37d00c3cfb 2019-11-04  406: 
37d00c3cfb 2019-11-04  407: 	# Adjustment for computing the expense of a function call by its length
37d00c3cfb 2019-11-04  408: 	# Calls that take longer should be made longer, so make CRC32 longer
37d00c3cfb 2019-11-04  409: 	# than Adler32
37d00c3cfb 2019-11-04  410: 	set lengthAdjustment [list Tcl_ZlibCRC32 Tcl_CRCxxx32]
37d00c3cfb 2019-11-04  411: 
37d00c3cfb 2019-11-04  412: 	# Check for a cached entry
37d00c3cfb 2019-11-04  413: 	if {$config(enableCache) && $config(useCacheFirst)} {
37d00c3cfb 2019-11-04  414: 		catch {
37d00c3cfb 2019-11-04  415: 			set hashKey $nameList
37d00c3cfb 2019-11-04  416: 
37d00c3cfb 2019-11-04  417: 			sqlite3 ::xvfs::phfCache $config(cacheFile)
37d00c3cfb 2019-11-04  418: 			::xvfs::phfCache eval {CREATE TABLE IF NOT EXISTS cache(hashKey PRIMARY KEY, function BLOB);}
37d00c3cfb 2019-11-04  419: 			::xvfs::phfCache eval {SELECT function FROM cache WHERE hashKey = $hashKey LIMIT 1;} cacheRow {}
37d00c3cfb 2019-11-04  420: 		}
37d00c3cfb 2019-11-04  421: 		catch {
37d00c3cfb 2019-11-04  422: 			::xvfs::phfCache close
37d00c3cfb 2019-11-04  423: 		}
37d00c3cfb 2019-11-04  424: 
37d00c3cfb 2019-11-04  425: 		if {[info exists cacheRow(function)]} {
37d00c3cfb 2019-11-04  426: 			set phfCall $cacheRow(function)
37d00c3cfb 2019-11-04  427: 			set phfCall [string map [list @@CVARNAME@@ $cVarName @@CVARLENGTH@@ $cVarLength @@INVALIDVALUE@@ $invalidValue] $phfCall]
37d00c3cfb 2019-11-04  428: 
37d00c3cfb 2019-11-04  429: 			return $phfCall
37d00c3cfb 2019-11-04  430: 		}
37d00c3cfb 2019-11-04  431: 	}
37d00c3cfb 2019-11-04  432: 
37d00c3cfb 2019-11-04  433: 	set minVal 0
37d00c3cfb 2019-11-04  434: 	set maxVal [llength $nameList]
37d00c3cfb 2019-11-04  435: 	set testExpr_(0) {[zlib adler32 $nameItem $alpha] % $gamma}
37d00c3cfb 2019-11-04  436: 	set testExpr(1) {[zlib crc32 $nameItem $alpha] % $gamma}
37d00c3cfb 2019-11-04  437: 	set testExpr_(2) {[zlib adler32 $nameItem [zlib crc32 $nameItem $alpha]] % $gamma}
37d00c3cfb 2019-11-04  438: 	set testExpr_(3) {[zlib crc32 $nameItem [zlib adler32 $nameItem $alpha]] % $gamma}
37d00c3cfb 2019-11-04  439: 	set testExprC(0) {((Tcl_ZlibAdler32(${alpha}LU, (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@) % ${gamma}LU)${fitMod})}
37d00c3cfb 2019-11-04  440: 	set testExprC(1) {((Tcl_ZlibCRC32(${alpha}LU, (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@) % ${gamma}LU)${fitMod})}
37d00c3cfb 2019-11-04  441: 	set testExprC(2) {((Tcl_ZlibAdler32(Tcl_ZlibCRC32(${alpha}LU, (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@), (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@) % ${gamma}LU)${fitMod})}
37d00c3cfb 2019-11-04  442: 	set testExprC(3) {((Tcl_ZlibCRC32(Tcl_ZlibAdler32(${alpha}LU, (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@), (unsigned char *) @@CVARNAME@@, @@CVARLENGTH@@) % ${gamma}LU)${fitMod})}
37d00c3cfb 2019-11-04  443: 
37d00c3cfb 2019-11-04  444: 	# Short-circuit for known cases
37d00c3cfb 2019-11-04  445: 	if {$maxVal == 1} {
37d00c3cfb 2019-11-04  446: 		return 0
37d00c3cfb 2019-11-04  447: 	}
37d00c3cfb 2019-11-04  448: 
37d00c3cfb 2019-11-04  449: 	set round -1
37d00c3cfb 2019-11-04  450: 
37d00c3cfb 2019-11-04  451: 	while true {
37d00c3cfb 2019-11-04  452: 		incr round
37d00c3cfb 2019-11-04  453: 
37d00c3cfb 2019-11-04  454: 		set gamma [expr {$maxVal + ($round % ($maxVal * 128))}]
37d00c3cfb 2019-11-04  455: 		set alpha [expr {$round / 6}]
37d00c3cfb 2019-11-04  456: 
37d00c3cfb 2019-11-04  457: 		foreach {testExprID testExprContents} [array get testExpr] {
37d00c3cfb 2019-11-04  458: 			set unFitList [list]
37d00c3cfb 2019-11-04  459: 			foreach nameItem $nameList {
37d00c3cfb 2019-11-04  460: 				set testExprVal [expr $testExprContents]
37d00c3cfb 2019-11-04  461: 				lappend unFitList $testExprVal
37d00c3cfb 2019-11-04  462: 			}
37d00c3cfb 2019-11-04  463: 
37d00c3cfb 2019-11-04  464: 			set failed false
37d00c3cfb 2019-11-04  465: 			set fitMod [_tryFit $unFitList]
37d00c3cfb 2019-11-04  466: 			if {$fitMod eq ""} {
37d00c3cfb 2019-11-04  467: 				set failed true
f615eecc64 2019-10-10  468: 			}
f615eecc64 2019-10-10  469: 
f615eecc64 2019-10-10  470: 			if {!$failed} {
f615eecc64 2019-10-10  471: 				break
f615eecc64 2019-10-10  472: 			}
a719156faf 2019-10-09  473: 		}
a719156faf 2019-10-09  474: 
a719156faf 2019-10-09  475: 		if {!$failed} {
a719156faf 2019-10-09  476: 			break
a719156faf 2019-10-09  477: 		}
37d00c3cfb 2019-11-04  478: 
37d00c3cfb 2019-11-04  479: 	}
37d00c3cfb 2019-11-04  480: 
37d00c3cfb 2019-11-04  481: 	set phfCall [string map [list { - 0LU} ""] [subst $testExprC($testExprID)]]
37d00c3cfb 2019-11-04  482: 
37d00c3cfb 2019-11-04  483: 	# Check cache for a better answer
37d00c3cfb 2019-11-04  484: 	if {$config(enableCache)} {
37d00c3cfb 2019-11-04  485: 		catch {
37d00c3cfb 2019-11-04  486: 			set hashKey $nameList
37d00c3cfb 2019-11-04  487: 			set cacheDir [file dirname $config(cacheFile)]
37d00c3cfb 2019-11-04  488: 			file mkdir $cacheDir
37d00c3cfb 2019-11-04  489: 
37d00c3cfb 2019-11-04  490: 			unset -nocomplain cacheRow
37d00c3cfb 2019-11-04  491: 
37d00c3cfb 2019-11-04  492: 			sqlite3 ::xvfs::phfCache $config(cacheFile)
37d00c3cfb 2019-11-04  493: 			::xvfs::phfCache eval {CREATE TABLE IF NOT EXISTS cache(hashKey PRIMARY KEY, function BLOB);}
37d00c3cfb 2019-11-04  494: 			::xvfs::phfCache eval {SELECT function FROM cache WHERE hashKey = $hashKey LIMIT 1;} cacheRow {}
37d00c3cfb 2019-11-04  495: 
37d00c3cfb 2019-11-04  496: 			set updateCache false
37d00c3cfb 2019-11-04  497: 			if {[info exists cacheRow(function)]} {
37d00c3cfb 2019-11-04  498: 				if {[string length [string map $lengthAdjustment $cacheRow(function)]] <= [string length [string map $lengthAdjustment $phfCall]]} {
37d00c3cfb 2019-11-04  499: 					# Use the cached value since it is better
37d00c3cfb 2019-11-04  500: 					set phfCall $cacheRow(function)
37d00c3cfb 2019-11-04  501: 				} else {
37d00c3cfb 2019-11-04  502: 					set updateCache true
37d00c3cfb 2019-11-04  503: 				}
37d00c3cfb 2019-11-04  504: 			} else {
37d00c3cfb 2019-11-04  505: 				set updateCache true
37d00c3cfb 2019-11-04  506: 			}
37d00c3cfb 2019-11-04  507: 
37d00c3cfb 2019-11-04  508: 			if {$updateCache && $config(cacheValue)} {
37d00c3cfb 2019-11-04  509: 				# Save to cache
37d00c3cfb 2019-11-04  510: 				::xvfs::phfCache eval {INSERT OR REPLACE INTO cache (hashKey, function) VALUES ($hashKey, $phfCall);}
37d00c3cfb 2019-11-04  511: 			}
37d00c3cfb 2019-11-04  512: 		}
37d00c3cfb 2019-11-04  513: 
37d00c3cfb 2019-11-04  514: 		catch {
37d00c3cfb 2019-11-04  515: 			::xvfs::phfCache close
37d00c3cfb 2019-11-04  516: 		}
37d00c3cfb 2019-11-04  517: 	}
37d00c3cfb 2019-11-04  518: 
37d00c3cfb 2019-11-04  519: 	set phfCall [string map [list @@CVARNAME@@ $cVarName @@CVARLENGTH@@ $cVarLength @@INVALIDVALUE@@ $invalidValue] $phfCall]
a719156faf 2019-10-09  520: 
a719156faf 2019-10-09  521: 	return $phfCall
37d00c3cfb 2019-11-04  522: }
37d00c3cfb 2019-11-04  523: 
37d00c3cfb 2019-11-04  524: proc ::xvfs::generateHashTable {outCVarName cVarName cVarLength invalidValue nameList args} {
37d00c3cfb 2019-11-04  525: 	# Manage config
37d00c3cfb 2019-11-04  526: 	## Default config
37d00c3cfb 2019-11-04  527: 	array set config {
37d00c3cfb 2019-11-04  528: 		prefix        ""
37d00c3cfb 2019-11-04  529: 		hashTableSize 10
37d00c3cfb 2019-11-04  530: 		validate      0
37d00c3cfb 2019-11-04  531: 		onValidated   "break;"
37d00c3cfb 2019-11-04  532: 	}
37d00c3cfb 2019-11-04  533: 
37d00c3cfb 2019-11-04  534: 	## User config
37d00c3cfb 2019-11-04  535: 	foreach {configKey configVal} $args {
37d00c3cfb 2019-11-04  536: 		if {![info exists config($configKey)]} {
37d00c3cfb 2019-11-04  537: 			error "Invalid option: $configKey"
37d00c3cfb 2019-11-04  538: 		}
37d00c3cfb 2019-11-04  539: 	}
37d00c3cfb 2019-11-04  540: 	array set config $args
37d00c3cfb 2019-11-04  541: 
37d00c3cfb 2019-11-04  542: 	if {[llength $nameList] < $config(hashTableSize)} {
37d00c3cfb 2019-11-04  543: 		set config(hashTableSize) [llength $nameList]
37d00c3cfb 2019-11-04  544: 	}
37d00c3cfb 2019-11-04  545: 
37d00c3cfb 2019-11-04  546: 	set maxLength 0
37d00c3cfb 2019-11-04  547: 	set index -1
37d00c3cfb 2019-11-04  548: 	foreach name $nameList {
37d00c3cfb 2019-11-04  549: 		incr index
37d00c3cfb 2019-11-04  550: 		set length [string length $name]
37d00c3cfb 2019-11-04  551: 		set hash [expr {[zlib adler32 $name 0] % $config(hashTableSize)}]
37d00c3cfb 2019-11-04  552: 
37d00c3cfb 2019-11-04  553: 		lappend indexesAtLength($length) $index
37d00c3cfb 2019-11-04  554: 		lappend indexesAtHash($hash) $index
37d00c3cfb 2019-11-04  555: 
37d00c3cfb 2019-11-04  556: 		if {$length > $maxLength} {
37d00c3cfb 2019-11-04  557: 			set maxLength $length
37d00c3cfb 2019-11-04  558: 		}
37d00c3cfb 2019-11-04  559: 	}
37d00c3cfb 2019-11-04  560: 
37d00c3cfb 2019-11-04  561: 	set maxIndexes 0
37d00c3cfb 2019-11-04  562: 	foreach {hash indexes} [array get indexesAtHash] {
37d00c3cfb 2019-11-04  563: 		set indexesCount [llength $indexes]
37d00c3cfb 2019-11-04  564: 
37d00c3cfb 2019-11-04  565: 		if {$indexesCount > $maxIndexes} {
37d00c3cfb 2019-11-04  566: 			set maxIndexes $indexesCount
37d00c3cfb 2019-11-04  567: 		}
37d00c3cfb 2019-11-04  568: 	}
37d00c3cfb 2019-11-04  569: 
37d00c3cfb 2019-11-04  570: 	lappend outputHeader "${config(prefix)}long ${outCVarName}_idx;"
37d00c3cfb 2019-11-04  571: 	lappend outputHeader "${config(prefix)}int ${outCVarName}_hash;"
37d00c3cfb 2019-11-04  572: 
37d00c3cfb 2019-11-04  573: 	for {set hash 0} {$hash < $config(hashTableSize)} {incr hash} {
37d00c3cfb 2019-11-04  574: 		if {[info exists indexesAtHash($hash)]} {
37d00c3cfb 2019-11-04  575: 			set indexes $indexesAtHash($hash)
37d00c3cfb 2019-11-04  576: 		} else {
37d00c3cfb 2019-11-04  577: 			set indexes [list]
37d00c3cfb 2019-11-04  578: 		}
37d00c3cfb 2019-11-04  579: 
3c8c52a9f8 2019-11-04  580: 		if {[llength $indexes] != $maxIndexes} {
3c8c52a9f8 2019-11-04  581: 			lappend indexes $invalidValue
3c8c52a9f8 2019-11-04  582: 		}
37d00c3cfb 2019-11-04  583: 		lappend outputHeader "${config(prefix)}static const long ${outCVarName}_hashTable_${hash}\[\] = \{"
37d00c3cfb 2019-11-04  584: 		lappend outputHeader "${config(prefix)}\t[join $indexes {, }]"
37d00c3cfb 2019-11-04  585: 		lappend outputHeader "${config(prefix)}\};"
37d00c3cfb 2019-11-04  586: 	}
37d00c3cfb 2019-11-04  587: 
37d00c3cfb 2019-11-04  588: 	lappend outputHeader "${config(prefix)}static const long * const ${outCVarName}_hashTable\[${config(hashTableSize)}\] = \{"
37d00c3cfb 2019-11-04  589: 
37d00c3cfb 2019-11-04  590: 	for {set hash 0} {$hash < $config(hashTableSize)} {incr hash} {
37d00c3cfb 2019-11-04  591: 		lappend outputHeader "${config(prefix)}\t${outCVarName}_hashTable_${hash},"
37d00c3cfb 2019-11-04  592: 	}
37d00c3cfb 2019-11-04  593: 
37d00c3cfb 2019-11-04  594: 	lappend outputHeader "${config(prefix)}\};"
37d00c3cfb 2019-11-04  595: 	lappend outputBody "${config(prefix)}${outCVarName}_hash = Tcl_ZlibAdler32(0, (unsigned char *) ${cVarName}, ${cVarLength}) % ${config(hashTableSize)};"
3c8c52a9f8 2019-11-04  596: 	lappend outputBody "${config(prefix)}for (${outCVarName}_idx = 0; ${outCVarName}_idx < ${maxIndexes}; ${outCVarName}_idx++) \{"
37d00c3cfb 2019-11-04  597: 	lappend outputBody "${config(prefix)}\t${outCVarName} = ${outCVarName}_hashTable\[${outCVarName}_hash\]\[${outCVarName}_idx\];"
37d00c3cfb 2019-11-04  598: 	lappend outputBody "${config(prefix)}\tif (${outCVarName} == $invalidValue) \{"
37d00c3cfb 2019-11-04  599: 	lappend outputBody "${config(prefix)}\t\tbreak;"
37d00c3cfb 2019-11-04  600: 	lappend outputBody "${config(prefix)}\t\}"
37d00c3cfb 2019-11-04  601: 	lappend outputBody ""
37d00c3cfb 2019-11-04  602: 	lappend outputBody "${config(prefix)}\tif (${config(validate)}) \{"
37d00c3cfb 2019-11-04  603: 	lappend outputBody "${config(prefix)}\t\t${config(onValidated)}"
37d00c3cfb 2019-11-04  604: 	lappend outputBody "${config(prefix)}\t\}"
37d00c3cfb 2019-11-04  605: 	lappend outputBody "${config(prefix)}\}"
37d00c3cfb 2019-11-04  606: 
37d00c3cfb 2019-11-04  607: 	return [dict create header [join $outputHeader "\n"] body [join $outputBody "\n"]]
d36db7c01b 2019-09-20  608: }
47dcf5fc27 2019-05-01  609: 
47dcf5fc27 2019-05-01  610: package provide xvfs 1