Changeset 4023 for trunk/Ohana/src/libautocode/generate
- Timestamp:
- May 25, 2005, 6:21:56 AM (21 years ago)
- File:
-
- 1 edited
-
trunk/Ohana/src/libautocode/generate (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Ohana/src/libautocode/generate
r4020 r4023 38 38 39 39 # there are used internally (not just a replacement) 40 if ($key eq "TYPE") { $TYPE = $value; } 40 if ($key eq "TYPE") { $TYPE = $value; } 41 if ($key eq "SIZE") { $SIZE = $value; } 41 42 if ($key eq "STRUCT") { $STRUCT = $value; } 42 43 … … 53 54 } 54 55 } 55 if ($TYPE eq "BINTABLE") { &count_bintablesize; } 56 if ($TYPE eq "TABLE") { &count_tablesize; } 56 if ($TYPE eq "BINTABLE") { $Nexpect = &count_bintablesize; } 57 if ($TYPE eq "TABLE") { $Nexpect = &count_tablesize; } 58 if ($Nexpect != $SIZE) { die "size mismatch: $Nexpect vs $SIZE\n"; } 57 59 } 58 60 … … 95 97 if ($mode[$i] eq "SUBSTRUCT") { next; } 96 98 97 # need to handle all structures like: float poly[5][4] 98 # add [\d\.] to match ascii-type formats 99 ($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|; 100 if (!$type && !$length) { $type = $format[$i]; } 101 102 if ($type eq "char") { 103 if ($length == 0) { 104 $pt1 = sprintf "A"; 105 } else { 106 $pt1 = sprintf "%dA", $length; 107 } 108 } 109 110 if ($type eq "byte") { $pt1 = "B"; } 111 if ($type eq "short") { $pt1 = "I"; } 112 if ($type eq "int") { $pt1 = "J"; } 113 if ($type eq "e_time") { $pt1 = "J"; } 114 if ($type eq "float") { $pt1 = "E"; } 115 if ($type eq "double") { $pt1 = "D"; } 116 117 if ($type eq "rawshort") { $pt1 = "I"; } 99 ($type, $Np) = &get_type_array ($format[$i]); 100 101 # rawshort is a short without byteswapping 102 103 $pt1 = 0; 104 if ($type eq "char") { $pt1 = "A"; } 105 if ($type eq "byte") { $pt1 = "B"; } 106 if ($type eq "unsigned char") { $pt1 = "B"; } 107 if ($type eq "rawshort") { $pt1 = "I"; } 108 if ($type eq "short") { $pt1 = "I"; } 109 if ($type eq "unsigned short"){ $pt1 = "I"; } 110 if ($type eq "int") { $pt1 = "J"; } 111 if ($type eq "unsigned int") { $pt1 = "J"; } 112 if ($type eq "e_time") { $pt1 = "J"; } 113 if ($type eq "float") { $pt1 = "E"; } 114 if ($type eq "double") { $pt1 = "D"; } 115 if (!$pt1) { die "unknown type $type"; } 116 117 if ($Np == 1) { 118 $pt2 = $pt1; 119 } else { 120 $pt2 = sprintf "%d%s", $Np, $pt1; 121 } 118 122 119 123 printf FILE " fits_define_bintable_column (header, "; 120 printf FILE "\"%s\", ", $pt1; 121 printf FILE "\"%s\", ", $field[$i]; 122 printf FILE "\"%s\", ", $comment[$i]; 123 printf FILE "\"%s\", 1.0, 0.0);\n", $unit[$i]; 124 } 125 124 printf FILE "%-8s", "\"$pt2\", "; 125 printf FILE "%-20s", "\"$field[$i]\", "; 126 printf FILE "%-35s", "\"$comment[$i]\", "; 127 printf FILE "%-20s 1.0, 0.0);\n", "\"$unit[$i]\", "; 128 } 129 130 } 131 132 sub get_type_array { 133 134 my ($format) = $_[0]; 135 my ($type); 136 my ($Np, $N1, $N2, $N3); 137 138 $type = $N1 = $N2 = $N3 = $Np = 0; 139 if (!$type) { 140 ($type, $N1, $N2, $N3) = $format =~ m|^(.w+)\[(\d+)\]\[(\d+)\]\[(\d+)\]|; 141 $Np = $N1*$N2*$N3; 142 } 143 if (!$type) { 144 ($type, $N1, $N2) = $format =~ m|^(.+)\[(\d+)\]\[(\d+)\]|; 145 $Np = $N1*$N2; 146 } 147 if (!$type) { 148 ($type, $N1) = $format =~ m|^(.+)\[(\d+)\]|; 149 $Np = $N1; 150 } 151 if (!$type) { 152 $type = $format; 153 $Np = 1; 154 } 155 # print "type: $type, Np: $Np\n"; 156 if ($Np == 0) { die "syntax error in format/array\n"; } 157 return ($type, $Np); 126 158 } 127 159 … … 131 163 # skip SUBSTRUCT type of entries: 132 164 if ($mode[$i] eq "SUBSTRUCT") { next; } 165 166 ($type, $N1, $N2) = $format[$i] =~ m|^(\w+)\[(\d+)\]\[(\d+)\]|; 167 if ($N2) { die "ASCII table cannot have multi-valued column"; } 133 168 134 169 ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|; 135 170 if (!$type && !$length) { die "format must be specified for ASCII table"; } 136 171 137 if ($type eq "char") { $pt1 = sprintf "A%s", $length; } 138 if ($type eq "byte") { $pt1 = sprintf "I%s", $length; } 139 if ($type eq "short") { $pt1 = sprintf "I%s", $length; } 140 if ($type eq "int") { $pt1 = sprintf "I%s", $length; } 141 if ($type eq "e_time") { $pt1 = sprintf "I%s", $length; } 142 if ($type eq "float") { $pt1 = sprintf "F%s", $length; } 143 if ($type eq "double") { $pt1 = sprintf "F%s", $length; } 144 145 if ($type eq "rawshort") { $pt1 = sprintf "I%s", $length; } 172 $pt1 = 0; 173 if ($type eq "char") { $pt1 = sprintf "A%s", $length; } 174 if ($type eq "byte") { $pt1 = sprintf "I%s", $length; } 175 if ($type eq "unsigned char") { $pt1 = sprintf "I%s", $length; } 176 if ($type eq "rawshort") { $pt1 = sprintf "I%s", $length; } 177 if ($type eq "short") { $pt1 = sprintf "I%s", $length; } 178 if ($type eq "unsigned short"){ $pt1 = sprintf "I%s", $length; } 179 if ($type eq "int") { $pt1 = sprintf "I%s", $length; } 180 if ($type eq "unsigned int") { $pt1 = sprintf "I%s", $length; } 181 if ($type eq "e_time") { $pt1 = sprintf "I%s", $length; } 182 if ($type eq "float") { $pt1 = sprintf "F%s", $length; } 183 if ($type eq "double") { $pt1 = sprintf "F%s", $length; } 184 if (!$pt1) { die "unknown type $type"; } 146 185 147 186 printf FILE " fits_define_table_column (header, "; 148 printf FILE " \"%s\", ", $pt1;149 printf FILE " \"%s\", ", $field[$i];150 printf FILE " \"%s\", ", $comment[$i];151 printf FILE " \"%s\");\n", $unit[$i];187 printf FILE "%-8s", "\"$pt1\", "; 188 printf FILE "%-20s", "\"$field[$i]\", "; 189 printf FILE "%-35s", "\"$comment[$i]\", "; 190 printf FILE "%-20s);\n", "\"$unit[$i]\""; 152 191 } 153 192 … … 160 199 if ($mode[$i] eq "SUBFIELD") { next; } 161 200 162 ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|; 163 if (!$type && !$length) { $type = $format[$i]; } 164 165 if (($type eq "char") && ($length != 0)) { 166 $pt2 = sprintf "%s[%d];", $element[$i], $length; 201 # here we only want to match the pattern [1][2][3]..[N] 202 ($type, $array) = $format[$i] =~ m|^(\w+)(\[.*\])|; 203 # print "type: $type, array: $array\n"; 204 if (!$type && !$array) { $type = $format[$i]; } 205 206 if ($array && (($TYPE eq "BINTABLE") || ($type eq "char"))) { 207 $pt2 = sprintf "%s%s;", $element[$i], $array; 167 208 } else { 168 209 $pt2 = sprintf "%s;", $element[$i]; … … 179 220 } 180 221 222 # this does not work with ASCII tables, 223 # but should not be needed for ASCII tables! 181 224 sub write_byteswaps { 225 if ($TYPE eq "TABLE") { 226 printf FILE "/*** no byteswaps for ASCII tables ***/\n"; 227 return; 228 } 182 229 $N = 0; 183 230 for ($i = 0; $i < @field; $i++) { … … 185 232 if ($mode[$i] eq "SUBSTRUCT") { next; } 186 233 187 ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|; 188 if (!$type && !$length) { $type = $format[$i]; } 189 190 if ($type eq "char") { 191 if ($length == 0) { 192 $N ++; 193 } else { 194 $N += $length; 195 } 196 next; # skip byte swap command 197 } 198 if ($type eq "byte") { 199 $N ++; 200 next; 201 } 202 # this is a patch for old photreg tables: provide a fix for the tables 234 ($type, $Np) = &get_type_array ($format[$i]); 235 236 # rawshort is a patch for old photreg tables: provide a fix for the tables 203 237 # some photreg tables were not byteswapped for certain columns 204 if ($type eq "rawshort") { 205 $N +=2; 206 next; 207 } 208 if ($type eq "short") { 209 $T = "BYTE"; 210 $n = 2; 211 } 212 if ($type eq "int") { 213 $T = "WORD"; 214 $n = 4; 215 } 216 if ($type eq "e_time") { 217 $T = "WORD"; 218 $n = 4; 219 } 220 if ($type eq "float") { 221 $T = "WORD"; 222 $n = 4; 223 } 224 if ($type eq "double") { 225 $T = "DBLE"; 226 $n = 8; 227 } 228 printf FILE " SWAP_%s (%d); // %s\n", $T, $N, $field[$i]; 229 $N += $n; 238 239 $n = 0; 240 if ($type eq "char") { $N += $Np; next; } 241 if ($type eq "byte") { $N += $Np; next; } 242 if ($type eq "unsigned char") { $N += $Np; next; } 243 if ($type eq "rawshort") { $N += 2*$Np; next; } 244 if ($type eq "short") { $T = "BYTE"; $n = 2; } 245 if ($type eq "unsigned short"){ $T = "BYTE"; $n = 2; } 246 if ($type eq "int") { $T = "WORD"; $n = 4; } 247 if ($type eq "unsigned int") { $T = "WORD"; $n = 4; } 248 if ($type eq "e_time") { $T = "WORD"; $n = 4; } 249 if ($type eq "float") { $T = "WORD"; $n = 4; } 250 if ($type eq "double") { $T = "DBLE"; $n = 8; } 251 if (!$n) { die "unknown type $type"; } 252 for ($j = 0; $j < $Np; $j++) { 253 printf FILE " SWAP_%s (%d); // %s\n", $T, $N, $field[$i]; 254 $N += $n; 255 } 230 256 } 231 257 } … … 239 265 240 266 # add [\d\.] to match ascii-type formats 241 ($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|; 242 if (!$type && !$length) { 243 $type = $format[$i]; 244 $length = 0; 245 } 246 247 if ($type eq "char") { 248 if ($length) { 249 $Nbytes += $length; 250 } else { 251 $Nbytes ++; 252 } 253 } 254 if ($type eq "byte") { $Nbytes += 1; } 255 if ($type eq "short") { $Nbytes += 2; } 256 if ($type eq "int") { $Nbytes += 4; } 257 if ($type eq "e_time") { $Nbytes += 4; } 258 if ($type eq "float") { $Nbytes += 4; } 259 if ($type eq "double") { $Nbytes += 8; } 260 261 if ($type eq "rawshort") { $Nbytes += 2; } 267 ($type, $Np) = &get_type_array ($format[$i]); 268 269 $valid = 0; 270 if ($type eq "char") { $Nbytes += 1*$Np; $valid = 1; } 271 if ($type eq "byte") { $Nbytes += 1*$Np; $valid = 1; } 272 if ($type eq "unsigned char") { $Nbytes += 1*$Np; $valid = 1; } 273 if ($type eq "rawshort") { $Nbytes += 2*$Np; $valid = 1; } 274 if ($type eq "short") { $Nbytes += 2*$Np; $valid = 1; } 275 if ($type eq "unsigned short") { $Nbytes += 2*$Np; $valid = 1; } 276 if ($type eq "int") { $Nbytes += 4*$Np; $valid = 1; } 277 if ($type eq "unsigned int") { $Nbytes += 4*$Np; $valid = 1; } 278 if ($type eq "e_time") { $Nbytes += 4*$Np; $valid = 1; } 279 if ($type eq "float") { $Nbytes += 4*$Np; $valid = 1; } 280 if ($type eq "double") { $Nbytes += 8*$Np; $valid = 1; } 281 if (!$valid) { die "unknown type $type"; } 262 282 } 263 283 return ($Nbytes); … … 271 291 if ($mode[$i] eq "SUBSTRUCT") { next; } 272 292 273 ($length) = $format[$i] =~ m|^\w+\[([\d\.]+)\]|; 293 ($fpt) = $format[$i] =~ m|^\w+\[([\d\.]+)\]|; 294 $length = int($fpt); 295 # print "$format[$i], $length, $fpt\n"; 274 296 if ($length == 0) { die "ASCII table format requires field size"; } 275 297 $Nbytes += $length; … … 302 324 my ($i); 303 325 for ($i = 0; $i < @key; $i++) { 326 # if ($VERBOSE) { print "$key[$i] -- $value[$i]\n"; } 304 327 if ($line =~ m|\$$key[$i]|) { 305 # print "$key[$i] -- $value[$i]\n";306 328 if ($value[$i] eq "") { die "missing value for required key $key[$i]\n"; } 307 329 $line =~ s|\$$key[$i]|$value[$i]|g;
Note:
See TracChangeset
for help on using the changeset viewer.
