1#! /bin/sh 2# -*- tcl -*- \ 3exec tclsh "$0" ${1+"$@"} 4 5# TMC - Trival Magic Compiler 6# === = ===================== 7 8# Use cases 9# --------- 10 11# (-) Compilation of one or more files in magic(5) syntax into a 12# single recognizer performing all the checks and mappings 13# encoded in them. 14# 15# Command syntax 16# -------------- 17# 18# Ad 1) tmc procname magic-file ?magic-file...? 19# 20# Compile all magic files into a recognizer, put it into the 21# named procedure, and write the result to stdout. 22# 23# Ad 2) tmc -merge tclfile procname magic-file ?magic-file...? 24# 25# Same as (1), but does not write to stdout. Instead the part of 26# the 'tclfile' delineated by marker lines containing "BEGIN 27# GENERATED CODE" and "END GENERATED CODE" is replaced with the 28# generated code. 29 30package require Tcl 8.4 31lappend auto_path [file dirname [file normalize [info script]]] ; # This directory 32lappend auto_path [file dirname [lindex $auto_path end]] ; # and the one above 33#puts *\t[join $auto_path \n*\t] 34package require fileutil::magic::cfront 35 36# ### ### ### ######### ######### ######### 37## Internal data and status 38 39namespace eval ::tmc { 40 41 # Path to where the output goes to. An empty string signals that 42 # the output is written to stdout. Otherwise it goes to the 43 # specified file, which has to exist, and is merged into it. 44 # 45 # Specified through the optional option '-merge'. 46 47 variable output "" 48 49 # Name of the procedure to generate from the input files. 50 51 variable proc "" 52 53 # List of the input files to process. 54 55 variable magic {} 56} 57 58# ### ### ### ######### ######### ######### 59## External data and status 60# 61## Only the file merge mode uses external data, which is explicitly 62## specified via the command line. It is a template the generated 63## recognizer is merged into, completely replacing an existing 64## recognizer. 65 66# ### ### ### ######### ######### ######### 67## Option processing. 68## Validate command line. 69## Full command line syntax. 70## 71# tmc ?-merge iofile? procname magic ?magic...? 72## 73 74proc ::tmc::processCmdline {} { 75 global argv 76 77 variable output 78 variable magic 79 variable proc 80 81 set output "" 82 set magic {} 83 set proc "" 84 85 # Process the options, perform basic validation. 86 87 while {[llength $argv]} { 88 set opt [lindex $argv 0] 89 if {![string match "-*" $opt]} break 90 if {$opt eq "-merge"} { 91 if {[llength $argv] < 2} Usage 92 set output [lindex $argv 1] 93 set argv [lrange $argv 2 end] 94 } else { 95 Usage 96 } 97 } 98 99 # Additional validation, and extraction of the non-option 100 # arguments. 101 102 if {[llength $argv] != 2} Usage 103 104 set proc [lindex $argv 0] 105 set magic [lrange $argv 1 end] 106 107 # Final validation across the whole configuration. 108 109 if {$proc eq ""} { 110 ArgError "Illegal empty proc name" 111 } 112 foreach m $magic { 113 CheckInput $m {Magic file} 114 } 115 if {$output ne ""} { 116 CheckTheMerge 117 } 118 return 119} 120 121# ### ### ### ######### ######### ######### 122## Option processing. 123## Helpers: Generation of error messages. 124## I. General usage/help message. 125## II. Specific messages. 126# 127# Both write their messages to stderr and then 128# exit the application with status 1. 129## 130 131proc ::tmc::Usage {} { 132 global argv0 133 puts stderr "$argv0 wrong#args, expected:\ 134 ?-merge iofile? procname magic magic..." 135 exit 1 136} 137 138proc ::tmc::ArgError {text} { 139 global argv0 140 puts stderr "$argv0: $text" 141 exit 1 142} 143 144proc in {list item} { 145 expr {([lsearch -exact $list $item] >= 0)} 146} 147 148# ### ### ### ######### ######### ######### 149## Check existence and permissions of an input/output file or 150## directory. 151 152proc ::tmc::CheckInput {f label} { 153 if {![file exists $f]} { 154 ArgError "Unable to find $label \"$f\"" 155 } elseif {![file readable $f]} { 156 ArgError "$label \"$f\" not readable (permission denied)" 157 } 158 return 159} 160 161proc ::tmc::CheckTheMerge {} { 162 variable output 163 164 if {$output eq ""} { 165 ArgError "No merge file specified" 166 } 167 if {![file exists $output]} { 168 ArgError "Merge file \"$output\" not found" 169 } elseif {![file isfile $output]} { 170 ArgError "Merge file \"$output\" is no such (is a directory)" 171 } elseif {![file readable $output]} { 172 ArgError "Merge file \"$output\" not readable (permission denied)" 173 } elseif {![file writable $output]} { 174 ArgError "Merge file \"$output\" not writable (permission denied)" 175 } 176 return 177} 178 179# ### ### ### ######### ######### ######### 180## Helper commands. File reading and writing. 181 182proc ::tmc::Get {f} { 183 return [read [set in [open $f r]]][close $in] 184} 185 186proc ::tmc::Write {f data} { 187 puts -nonewline [set out [open $f w]] $data 188 close $out 189 return 190} 191 192# ### ### ### ######### ######### ######### 193## Configuation phase, validate command line. 194 195::tmc::processCmdline 196 197# ### ### ### ######### ######### ######### 198## Helper command implementing the file merge functionality. 199 200proc ::tmc::Merge {f script} { 201 set out {} 202 set skip 0 203 foreach l [split [Get $f] \n] { 204 if {$skip == 0} { 205 lappend out $l 206 if {[string match {*BEGIN GENERATED CODE*} $l]} { 207 set skip 1 208 lappend out $script 209 } 210 } elseif {$skip == 1} { 211 if {[string match {*END GENERATED CODE*} $l]} { 212 lappend out $l 213 set skip 2 214 } 215 } else { 216 # Skip == 2 217 lappend out $l 218 } 219 } 220 Write $f [join $out \n] 221 return 222} 223 224# ### ### ### ######### ######### ######### 225## Invoking the functionality. 226 227if {[catch { 228 # Read and process all input files. 229 # Generate a single tcl procedure from them. 230 # Write the result either to stdout, or merge 231 # into the specified output file. 232 233 set tcl [eval [linsert $tmc::magic 0 \ 234 fileutil::magic::cfront::procdef \ 235 $tmc::proc]] 236 237 if {$tmc::output eq ""} { 238 puts stdout $tcl 239 } else { 240 ::tmc::Merge $tmc::output \n${tcl}\n 241 } 242} msg]} { 243 puts $::errorInfo 244 ::tmc::ArgError $msg 245} 246 247# ### ### ### ######### ######### ######### 248exit 249