diff options
| author | Filippos Karapetis | 2009-02-18 11:03:44 +0000 | 
|---|---|---|
| committer | Filippos Karapetis | 2009-02-18 11:03:44 +0000 | 
| commit | 1db017a6c22137ba26276a75a3901a0f99ccedca (patch) | |
| tree | cd1d715c6d33b9d85d175d4d8dc3a384aa4aa257 | |
| parent | fa59ce0d9f6282e08d52209d3afad3cc9f702ebb (diff) | |
| download | scummvm-rg350-1db017a6c22137ba26276a75a3901a0f99ccedca.tar.gz scummvm-rg350-1db017a6c22137ba26276a75a3901a0f99ccedca.tar.bz2 scummvm-rg350-1db017a6c22137ba26276a75a3901a0f99ccedca.zip | |
Removed the cfsml.pl tool from the SCI engine (eventually, it should go to /tools, together with the other ones...)
svn-id: r38467
| -rw-r--r-- | engines/sci/engine/cfsml.pl | 1183 | 
1 files changed, 0 insertions, 1183 deletions
| diff --git a/engines/sci/engine/cfsml.pl b/engines/sci/engine/cfsml.pl deleted file mode 100644 index 982a536b70..0000000000 --- a/engines/sci/engine/cfsml.pl +++ /dev/null @@ -1,1183 +0,0 @@ -#! /usr/bin/env perl -# The C File Storage Meta Language "reference" implementation -# This implementation is supposed to conform to version -$version = "0.8.2"; -# of the spec. Please contact the maintainer if it doesn't. -# -# cfsml.pl Copyright (C) 1999, 2000, 2001 Christoph Reichenbach -# -# -# This program may be modified and copied freely according to the terms of -# the GNU general public license (GPL), as long as the above copyright -# notice and the licensing information contained herein are preserved. -# -# Please refer to www.gnu.org for licensing details. -# -# This work is provided AS IS, without warranty of any kind, expressed or -# implied, including but not limited to the warranties of merchantibility, -# noninfringement, and fitness for a specific purpose. The author will not -# be held liable for any damage caused by this work or derivatives of it. -# -# By using this source code, you agree to the licensing terms as stated -# above. -# -# -# Please contact the maintainer for bug reports or inquiries. -# -# Current Maintainer: -# -#    Christoph Reichenbach (CJR) [jameson@linuxgames.com] -# -# -# Warning: This is still a "bit" messy. Sorry for that. -# - -#$debug = 1; - -$write_lines = "true"; -$source_file = "CFSML source file"; -$type_integer = "integer"; -$type_string = "string"; -$type_record = "RECORD"; -$type_pointer = "POINTER"; -$type_abspointer = "ABSPOINTER"; - -%types;      # Contains all type bindings -%records;    # Contains all record bindings - -$mode = undef; -while ($op = shift @ARGV) { -    if ($mode eq undef) { -	if ($op eq "-f") { -	    $mode = "fname"; -	} elsif ($op eq "-l") { -	    $write_lines = undef; -	} elsif ($op eq "-v") { -	    print "cfsml.pl, the CFSML code generator, version $version\n"; -	    print "This program is provided WITHOUT WARRANTY of any kind. It may be\n"; -	    print "copied and modified freely according to the terms of the GNU\n"; -	    print "General Public License.\n"; -	    exit(0); -	} elsif ($op eq "-h") { -	    print "CFSML help:\n"; -	    print "Usage: cat source | cfsml.pl [-v] [-h] [-l] [-f <filename>] > dest\n"; -	    print "  -h : help\n"; -	    print "  -v : print version\n"; -	    print "  -l : disable line number printing in dest file\n"; -	    print "  -f : specify file name for line number printing\n"; -	    exit(0); -	} else { -	    die "Unknown option '$op'\n"; -	} -    } elsif ($mode eq "fname") { -	$source_file = $op; -	$mode = 0; -    } else { -	die "Invalid internal state '$mode'\n"; -    } -} - -sub write_line_pp -# write_line_pp(int line_nr, bool input_file?) -{ -    my $line_nr = shift; -    my $_file = shift; -    my $filename = "cfsml.pl"; - -    if (_file) { -	$filename = $source_file; -    } - -    if ($write_lines) { -	print "#line $line_nr \"$filename\"\n"; -    } -} - -sub create_string_functions -  { -    $firstline = __LINE__; -    $firstline += 4; -    write_line_pp($firstline, 0); -    print <<'EOF'; - -#include <stdarg.h> /* We need va_lists */ -#include "sci/include/sci_memory.h" - -#ifdef CFSML_DEBUG_MALLOC -/* -#define free(p)        dbg_sci_free(p) -#define malloc(s)      dbg_sci_malloc(s) -#define calloc(n, s)   dbg_sci_calloc(n, s) -#define realloc(p, s)  dbg_sci_realloc(p, s) -*/ -#define free        dbg_sci_free -#define malloc      dbg_sci_malloc -#define calloc      dbg_sci_calloc -#define realloc     dbg_sci_realloc -#endif - -static void -_cfsml_error(const char *fmt, ...) -{ -  va_list argp; - -  fprintf(stderr, "Error: "); -  va_start(argp, fmt); -  vfprintf(stderr, fmt, argp); -  va_end(argp); - -} - - -static struct _cfsml_pointer_refstruct { -    struct _cfsml_pointer_refstruct *next; -    void *ptr; -} *_cfsml_pointer_references = NULL; - -static struct _cfsml_pointer_refstruct **_cfsml_pointer_references_current = &_cfsml_pointer_references; - -static char *_cfsml_last_value_retrieved = NULL; -static char *_cfsml_last_identifier_retrieved = NULL; - -static void -_cfsml_free_pointer_references_recursively(struct _cfsml_pointer_refstruct *refs, int free_pointers) -{ -    if (!refs) -	return; -    #ifdef CFSML_DEBUG_MALLOC -    SCI_MEMTEST; -    #endif - -    _cfsml_free_pointer_references_recursively(refs->next, free_pointers); -    #ifdef CFSML_DEBUG_MALLOC -    SCI_MEMTEST; - -    fprintf(stderr,"Freeing ptrref %p [%p] %s\n", refs->ptr, refs, free_pointers? -	    "ALL": "cleanup only"); -    #endif - -    if (free_pointers) -	free(refs->ptr); - -    #ifdef CFSML_DEBUG_MALLOC -    SCI_MEMTEST; -    #endif -    free(refs); -    #ifdef CFSML_DEBUG_MALLOC -    SCI_MEMTEST; -    #endif -} - -static void -_cfsml_free_pointer_references(struct _cfsml_pointer_refstruct **meta_ref, int free_pointers) -{ -    _cfsml_free_pointer_references_recursively(*meta_ref, free_pointers); -    *meta_ref = NULL; -    _cfsml_pointer_references_current = meta_ref; -} - -static struct _cfsml_pointer_refstruct ** -_cfsml_get_current_refpointer() -{ -    return _cfsml_pointer_references_current; -} - -static void _cfsml_register_pointer(void *ptr) -{ -    struct _cfsml_pointer_refstruct *newref = (struct _cfsml_pointer_refstruct*)sci_malloc(sizeof (struct _cfsml_pointer_refstruct)); -    #ifdef CFSML_DEBUG_MALLOC -    SCI_MEMTEST; -    fprintf(stderr,"Registering ptrref %p [%p]\n", ptr, newref); -    #endif -    newref->next = *_cfsml_pointer_references_current; -    newref->ptr = ptr; -    *_cfsml_pointer_references_current = newref; -} - - -static char * -_cfsml_mangle_string(const char *s) -{ -  const char *source = s; -  char c; -  char *target = (char *) sci_malloc(1 + strlen(s) * 2); /* We will probably need less than that */ -  char *writer = target; - -  while ((c = *source++)) { - -    if (c < 32) { /* Special character? */ -      *writer++ = '\\'; /* Escape... */ -      c += ('a' - 1); -    } else if (c == '\\' || c == '"') -      *writer++ = '\\'; /* Escape, but do not change */ -    *writer++ = c; - -  } -  *writer = 0; /* Terminate string */ - -  return (char *) sci_realloc(target, strlen(target) + 1); -} - - -static char * -_cfsml_unmangle_string(const char *s, unsigned int length) -{ -  char *target = (char *) sci_malloc(1 + strlen(s)); -  char *writer = target; -  const char *source = s; -  const char *end = s + length; -  char c; - -  while ((source != end) && (c = *source++) && (c > 31)) { -    if (c == '\\') { /* Escaped character? */ -      c = *source++; -      if ((c != '\\') && (c != '"')) /* Un-escape 0-31 only */ -	c -= ('a' - 1); -    } -    *writer++ = c; -  } -  *writer = 0; /* Terminate string */ - -  return (char *) sci_realloc(target, strlen(target) + 1); -} - - -static char * -_cfsml_get_identifier(FILE *fd, int *line, int *hiteof, int *assignment) -{ -  int c; -  int mem = 32; -  int pos = 0; -  int done = 0; -  char *retval = (char *) sci_malloc(mem); - -  if (_cfsml_last_identifier_retrieved) { -      free(_cfsml_last_identifier_retrieved); -      _cfsml_last_identifier_retrieved = NULL; -  } - -  while (isspace(c = fgetc(fd)) && (c != EOF)); -  if (c == EOF) { -    _cfsml_error("Unexpected end of file at line %d\n", *line); -    free(retval); -    *hiteof = 1; -    return NULL; -  } - -  ungetc(c, fd); - -  while (((c = fgetc(fd)) != EOF) && ((pos == 0) || (c != '\n')) && (c != '=')) { - -     if (pos == mem - 1) /* Need more memory? */ -       retval = (char *) sci_realloc(retval, mem *= 2); - -     if (!isspace(c)) { -        if (done) { -           _cfsml_error("Single word identifier expected at line %d\n", *line); -           free(retval); -           return NULL; -        } -        retval[pos++] = c; -     } else -        if (pos != 0) -           done = 1; /* Finished the variable name */ -        else if (c == '\n') -           ++(*line); -  } - -  if (c == EOF) { -    _cfsml_error("Unexpected end of file at line %d\n", *line); -    free(retval); -    *hiteof = 1; -    return NULL; -  } - -  if (c == '\n') { -    ++(*line); -    if (assignment) -      *assignment = 0; -  } else -    if (assignment) -      *assignment = 1; - -  if (pos == 0) { -    _cfsml_error("Missing identifier in assignment at line %d\n", *line); -    free(retval); -    return NULL; -  } - -  if (pos == mem - 1) /* Need more memory? */ -     retval = (char *) sci_realloc(retval, mem += 1); - -  retval[pos] = 0; /* Terminate string */ -EOF - -if ($debug) { -    print "  printf(\"identifier is '%s'\\n\", retval);\n"; -} - -  $firstline = __LINE__; -  $firstline += 4; -  write_line_pp($firstline, 0); -  print <<'EOF2'; - -  return _cfsml_last_identifier_retrieved = retval; -} - - -static char * -_cfsml_get_value(FILE *fd, int *line, int *hiteof) -{ -  int c; -  int mem = 64; -  int pos = 0; -  char *retval = (char *) sci_malloc(mem); - -  if (_cfsml_last_value_retrieved) { -      free(_cfsml_last_value_retrieved); -      _cfsml_last_value_retrieved = NULL; -  } - -  while (((c = fgetc(fd)) != EOF) && (c != '\n')) { - -     if (pos == mem - 1) /* Need more memory? */ -       retval = (char *) sci_realloc(retval, mem *= 2); - -     if (pos || (!isspace(c))) -        retval[pos++] = c; - -  } - -  while ((pos > 0) && (isspace(retval[pos - 1]))) -     --pos; /* Strip trailing whitespace */ - -  if (c == EOF) -    *hiteof = 1; - -  if (pos == 0) { -    _cfsml_error("Missing value in assignment at line %d\n", *line); -    free(retval); -    return NULL; -  } - -  if (c == '\n') -     ++(*line); - -  if (pos == mem - 1) /* Need more memory? */ -    retval = (char *) sci_realloc(retval, mem += 1); - -  retval[pos] = 0; /* Terminate string */ -EOF2 - -    if ($debug) { -	print "  printf(\"value is '%s'\\n\", retval);\n"; -    } - -    $firstline = __LINE__; -    $firstline += 4; -    write_line_pp($firstline, 0); -  print <<'EOF3'; -  return (_cfsml_last_value_retrieved = (char *) sci_realloc(retval, strlen(retval) + 1)); -  /* Re-allocate; this value might be used for quite some while (if we are -  ** restoring a string) -  */ -} -EOF3 -  } - - -# Call with $expression as a simple expression, like "tos + 1". -# Returns (in this case) ("tos", "-1"). -sub lvaluize -  { -    my @retval; -#    print "//DEBUG: $expression ["; -    my @tokens = split (/([+-\/\*])/, $expression); -#    print join(",", @tokens); -    $retval[0] = $tokens[0]; - -    my $rightvalue = ""; -    for ($i = 1; $tokens[$i]; $i++) { - -      if ($tokens[$i] eq "+") { -	$rightvalue .= "-"; -      } elsif ($tokens[$i] eq "-") { -	$rightvalue .= "+"; -      } elsif ($tokens[$i] eq "/") { -	$rightvalue .= "*"; -      } elsif ($tokens[$i] eq "*") { -	$rightvalue .= "/"; -      } else { -	$rightvalue .= $tokens[$i]; -      } -    } - -    $retval[1] = $rightvalue; - -#   print "] => ($retval[0];$retval[1])\n"; - -    return @retval; -  } - - - -sub create_declaration -  { -    $typename = $type; -    $ctype = $types{$type}->{'ctype'}; - -    if (not $types{$type}->{'external'}) { -      $types{$type}{'writer'} = "_cfsml_write_" . $typename; -      $types{$type}{'reader'} = "_cfsml_read_" . $typename; -      write_line_pp(__LINE__, 0); -      print "static void\n$types{$type}{'writer'}(FILE *fh, $ctype* save_struc);\n"; -      print "static int\n$types{$type}{'reader'}(FILE *fh, $ctype* save_struc, const char *lastval,". -	" int *line, int *hiteof);\n\n"; -    }; - -  } - -sub create_writer -  { -    $typename = $type; -    $ctype = $types{$type}{'ctype'}; - -    write_line_pp(__LINE__, 0); -    print "static void\n_cfsml_write_$typename(FILE *fh, $ctype* save_struc)\n{\n"; -    if ($types{$type}{'type'} eq $type_record) { -        print "  int min, max, i;\n\n"; -    } - -    if ($types{$type}{'type'} eq $type_integer) { -      print "  fprintf(fh, \"%li\", (long) *save_struc);\n"; -    } -    elsif ($types{$type}{'type'} eq $type_string) { -	write_line_pp(__LINE__, 0); -	print "  if (!(*save_struc))\n"; -	print "    fprintf(fh, \"\\\\null\\\\\");\n"; -	print "  else {\n"; -	print "    char *token = _cfsml_mangle_string((const char *) *save_struc);\n"; -	print "    fprintf(fh, \"\\\"%s\\\"\", token);\n"; -	print "    free(token);\n"; -	print "  }\n"; -    } -    elsif ($types{$type}{'type'} eq $type_record) { -	write_line_pp(__LINE__, 0); -	print "  fprintf(fh, \"{\\n\");\n"; - -	for $n (@{$records{$type}}) { - -	    print "  fprintf(fh, \"$n->{'name'} = \");\n"; - -	    if ($n->{'array'}) { # Check for arrays - -		if ($n->{'array'} eq 'static' or $n->{'size'} * 2) { # fixed integer value? -		    print "    min = max = $n->{'size'};\n"; -		} -		else { # No, a variable -		    print "    min = max = save_struc->$n->{'size'};\n"; -		} - -		if ($n->{'maxwrite'}) { # A write limit? -		    print "    if (save_struc->$n->{'maxwrite'} < min)\n"; -		    print "       min = save_struc->$n->{'maxwrite'};\n"; -		} - -		if ($n->{'array'} eq 'dynamic') { -		    print "    if (!save_struc->$n->{'name'})\n"; -		    print "       min = max = 0; /* Don't write if it points to NULL */\n"; -		} - -		write_line_pp(__LINE__, 0); -		print "    fprintf(fh, \"[%d][\\n\", max);\n"; -		print "    for (i = 0; i < min; i++) {\n"; -		print "      $types{$n->{'type'}}{'writer'}"; -		my $subscribstr = "[i]"; # To avoid perl interpolation problems -		print "(fh, &(save_struc->$n->{'name'}$subscribstr));\n"; -		print "      fprintf(fh, \"\\n\");\n"; -		print "    }\n"; -		print "    fprintf(fh, \"]\");\n"; - -	} elsif ($n->{'type'} eq $type_pointer) { # Relative pointer - -	  print "    fprintf(fh, \"%d\", save_struc->$n->{'name'} - save_struc->$n->{'anchor'});" . -	    " /* Relative pointer */\n"; - -      } elsif ($n->{'type'} eq $type_abspointer) { # Absolute pointer - -	  print "    if (!save_struc->$n->{'name'})\n"; -	  print "      fprintf(fh, \"\\\\null\\\\\");\n"; -	  print "    else \n"; -	  print "      $types{$n->{'reftype'}}{'writer'}"; -	  print "(fh, save_struc->$n->{'name'});\n"; - -	} else { # Normal record entry - -	  print "    $types{$n->{'type'}}{'writer'}"; -	  print "(fh, ($types{$n->{'type'}}{'ctype'}*) &(save_struc->$n->{'name'}));\n"; - -	} - -	print "    fprintf(fh, \"\\n\");\n"; -      } - -      print "  fprintf(fh, \"}\");\n"; -    } -    else { -      print STDERR "Warning: Attempt to create_writer for invalid type '$types{$type}{'type'}'\n"; -    } -    print "}\n\n"; - -  } - - -sub create_reader -  { -    $typename = $type; -    $ctype = $types{$type}{'ctype'}; - -    write_line_pp(__LINE__, 0); -    print "static int\n_cfsml_read_$typename"; -    print "(FILE *fh, $ctype* save_struc, const char *lastval, int *line, int *hiteof)\n{\n"; - -    print "  char *token;\n"; -    if ($types{$type}{'type'} eq $type_record) { -      print "int min, max, i;\n"; -    } -    my $reladdress_nr = 0; # Number of relative addresses needed -    my $reladdress = 0; # Current relative address number -    my $reladdress_resolver = ""; # Relative addresses are resolved after the main while block - -    if ($types{$type}{'type'} eq $type_record) { - -      foreach $n (@{$records{$type}}) { # Count relative addresses we need -	if ($n->{'type'} eq $type_pointer) { -	  ++$reladdress_nr; -	} -      } - -      if ($reladdress_nr) { # Allocate stack space for all relative addresses needed -	print "  int reladdresses[$reladdress_nr] = {0};\n"; -      } -    } - -    if ($types{$type}{'type'} eq $type_integer) { -	write_line_pp(__LINE__, 0); -	print "\n  *save_struc = strtol(lastval, &token, 0);\n"; -	print "  if ( (*save_struc == 0) && (token == lastval) ) {\n"; -	print "     _cfsml_error(\"strtol failed at line %d\\n\", *line);\n"; -	print "     return CFSML_FAILURE;\n"; -	print "  }\n"; -	print "  if (*token != 0) {\n"; -	print "     _cfsml_error(\"Non-integer encountered while parsing int value at line %d\\n\","; -	print " *line);\n"; -	print "     return CFSML_FAILURE;\n"; -	print "  }\n"; -	print "  return CFSML_SUCCESS;\n"; -    } elsif ($types{$type}{'type'} eq $type_string) { -	write_line_pp(__LINE__, 0); -	print "\n"; -	print "  if (strcmp(lastval, \"\\\\null\\\\\")) { /* null pointer? */\n"; -    print "    unsigned int length = strlen(lastval);\n"; -	print "    if (*lastval == '\"') { /* Quoted string? */\n"; -	print "      while (lastval[length] != '\"')\n"; -	print "        --length;\n\n"; -	print "      if (!length) { /* No matching double-quotes? */\n"; -	print "        _cfsml_error(\"Unbalanced quotes at line %d\\n\", *line);\n"; -	print "        return CFSML_FAILURE;\n"; -	print "      }\n\n"; -	print "      lastval++; /* ...and skip the opening quotes locally */\n"; -	print "      length--;\n"; -	print "    }\n"; -	print "    *save_struc = _cfsml_unmangle_string(lastval, length);\n"; -	print "    _cfsml_register_pointer(*save_struc);\n"; -	print "    return CFSML_SUCCESS;\n"; -	print "  } else {\n"; -	print "    *save_struc = NULL;\n"; -	print "    return CFSML_SUCCESS;\n"; -	print "  }\n"; -    } elsif ($types{$type}{'type'} eq $type_record) { -	write_line_pp(__LINE__, 0); -	print "  int assignment, closed, done;\n\n"; -	print "  if (strcmp(lastval, \"{\")) {\n"; -	print "     _cfsml_error(\"Reading record $type; expected opening braces in line %d, got \\\"%s\\\"\\n\","; -	print "*line, lastval);\n"; -	print "     return CFSML_FAILURE;\n"; -	print "  };\n"; -	print "  closed = 0;\n"; -	print "  do {\n"; -	print "    const char *value;\n"; -	print "    token = _cfsml_get_identifier(fh, line, hiteof, &assignment);\n\n"; -	print "    if (!token) {\n"; -	print "       _cfsml_error(\"Expected token at line %d\\n\", *line);\n"; -	print "       return CFSML_FAILURE;\n"; -	print "    }\n"; -	print "    if (!assignment) {\n"; -	print "      if (!strcmp(token, \"}\")) \n"; -	print "         closed = 1;\n"; -	print "      else {\n"; -	print "        _cfsml_error(\"Expected assignment or closing braces in line %d\\n\", *line);\n"; -	print "        return CFSML_FAILURE;\n"; -	print "      }\n"; -	print "    } else {\n"; -	print "      value = \"\";\n"; -	print "      while (!value || !strcmp(value, \"\"))\n"; -	print "        value = _cfsml_get_value(fh, line, hiteof);\n"; -	print "      if (!value) {\n"; -	print "        _cfsml_error(\"Expected token at line %d\\n\", *line);\n"; -	print "        return CFSML_FAILURE;\n"; -	print "      }\n"; -#	print "    }\n"; - - -      foreach $n (@{$records{$type}}) { # Now take care of all record elements - -	my $type = $n->{'type'}; -	my $reference = undef; -	if ($type eq $type_abspointer) { -	    $reference = 1; -	    $type = $n->{'reftype'}; -	} -	my $name = $n->{'name'}; -	my $reader = $types{$type}{'reader'}; -	my $size = $n->{'size'}; - -	print "      if (!strcmp(token, \"$name\")) {\n"; - -	if ($type eq $type_pointer) { # A relative pointer - -	  $reader = $types{'int'}{'reader'}; # Read relpointer as int - -	  write_line_pp(__LINE__, 0); -	  print "         if ($reader(fh, &(reladdresses[$reladdress]), value, line, hiteof)) {\n"; -	  print "            _cfsml_error(\"Expected token at line %d\\n\", *line);\n"; -	  print "            return CFSML_FAILURE;\n"; -	  print "         }\n"; - -	  # Make sure that the resulting variable is interpreted correctly -	  $reladdress_resolver .= "  save_struc->$n->{'name'} =". -	    " save_struc->$n->{'anchor'} + reladdresses[$reladdress];\n"; - -	  ++$reladdress; # Prepare reladdress for next element - -	} elsif ($n->{'array'}) { # Is it an array? -	    write_line_pp(__LINE__, 0); -	    print "         if ((value[0] != '[') || (value[strlen(value) - 1] != '[')) {\n"; -	    # The value must end with [, since we're starting array data, and it must also -	    # begin with [, since this is either the only character in the line, or it starts -	    # the "amount of memory to allocate" block -	    print "            _cfsml_error(\"Opening brackets expected at line %d\\n\", *line);\n"; -	    print "            return CFSML_FAILURE;\n"; -	    print "         }\n"; - -	  if ($n->{'array'} eq 'dynamic') { -	      write_line_pp(__LINE__, 0); -	    # We need to allocate the array first -	    print "         /* Prepare to restore dynamic array */\n"; -	    # Read amount of memory to allocate -	    print "         max = strtol(value + 1, NULL, 0);\n"; -	    print "         if (max < 0) {\n"; -	    print "            _cfsml_error(\"Invalid number of elements to allocate for dynamic "; -	    print "array '%s' at line %d\\n\", token, *line);\n"; -	    print "            return CFSML_FAILURE;\n"; -	    print "         }\n\n"; - -	    print "         if (max) {\n"; -	    print "           save_struc->$name = ($n->{'type'} *) sci_malloc(max * sizeof($type));\n"; -	    print "#ifdef SATISFY_PURIFY\n"; -            print "           memset(save_struc->$name, 0, max * sizeof($type));\n"; -	    print "#endif\n"; -	    print "           _cfsml_register_pointer(save_struc->$name);\n"; -	    print "         }\n"; -	    print "         else\n"; -	    print "           save_struc->$name = NULL;\n" - -	    } else { # static array -		print "         /* Prepare to restore static array */\n"; -		print "         max = $size;\n"; -	    } - -	    write_line_pp(__LINE__, 0); -	    print "         done = i = 0;\n"; -	    print "         do {\n"; -	    if ($type eq $type_record) { -		print "           if (!(value = _cfsml_get_value(fh, line, hiteof))) {\n"; -	    } else { -		print "           if (!(value = _cfsml_get_identifier(fh, line, hiteof, NULL))) {\n"; -	    } -	    write_line_pp(__LINE__, 0); -	     -	    print "              _cfsml_error(\"Token expected at line %d\\n\", *line);\n"; -	    print "              return 1;\n"; -	    print "           }\n"; -	    print "           if (strcmp(value, \"]\")) {\n"; -	    print "             if (i == max) {\n"; -	    print "               _cfsml_error(\"More elements than space available (%d) in '%s' at "; -	    print "line %d\\n\", max, token, *line);\n"; -	    print "               return CFSML_FAILURE;\n"; -	    print "             }\n"; -	    my $helper = "[i++]"; -	    print "             if ($reader(fh, &(save_struc->$name$helper), value, line, hiteof)) {\n"; -	    print "                _cfsml_error(\"Token expected by $reader() for $name$helper at line %d\\n\", *line);\n"; -	    print "                return CFSML_FAILURE;\n"; -	    print "             }\n"; -	    print "           } else done = 1;\n"; -	    print "         } while (!done);\n"; - -	    if ($n->{'array'} eq "dynamic") { -		my @xpr = lvaluize($expression = $n->{'size'}); -		print "         save_struc->$xpr[0] = max $xpr[1]; /* Set array size accordingly */\n"; -	    } - -	    if ($n->{'maxwrite'}) { -		my @xpr = lvaluize($expression = $n->{'maxwrite'}); -		print "         save_struc->$xpr[0] = i $xpr[1]; /* Set number of elements */\n"; -	    } - -	} -	elsif ($reference) { -	    write_line_pp(__LINE__, 0); -	    print "        if (strcmp(value, \"\\\\null\\\\\")) { /* null pointer? */\n"; -	    print "           save_struc->$name = sci_malloc(sizeof ($type));\n"; -	    print "           _cfsml_register_pointer(save_struc->$name);\n"; -	    print "           if ($reader(fh, save_struc->$name, value, line, hiteof)) {\n"; -	    print "              _cfsml_error(\"Token expected by $reader() for $name at line %d\\n\", *line);\n"; -	    print "              return CFSML_FAILURE;\n"; -	    print "           }\n"; -	    print "        } else save_struc->$name = NULL;\n"; -	} -	else { # It's a simple variable or a struct -	    write_line_pp(__LINE__, 0); -	    print "         if ($reader(fh, ($types{$type}{'ctype'}*) &(save_struc->$name), value, line, hiteof)) {\n"; -	    print "            _cfsml_error(\"Token expected by $reader() for $name at line %d\\n\", *line);\n"; -	    print "            return CFSML_FAILURE;\n"; -	    print "         }\n"; -	} -	print "      } else\n"; - -      } -	write_line_pp(__LINE__, 0); -	print "       {\n"; -	print "          _cfsml_error(\"$type: Assignment to invalid identifier '%s' in line %d\\n\","; -	print " token, *line);\n"; -	print "          return CFSML_FAILURE;\n"; -	print "       }\n"; -	print "     }\n"; - -      print "  } while (!closed); /* Until closing braces are hit */\n"; - -      print $reladdress_resolver; # Resolves any relative addresses - -      print "  return CFSML_SUCCESS;\n"; -    } else { -      print STDERR "Warning: Attempt to create_reader for invalid type '$types{$type}{'type'}'\n"; -    } - -    print "}\n\n"; -  } - -# Built-in types - -%types = ( -	  'int' => { -		    'type' => $type_integer, -		    'ctype' => "int", -		   }, - -	  'string' => { -		       'type' => $type_string, -		       'ctype' => "char *", -		      }, -	 ); - - - -sub create_function_block { -  print "\n/* Auto-generated CFSML declaration and function block */\n\n"; -  write_line_pp(__LINE__, 0); -  print "#define CFSML_SUCCESS 0\n"; -  print "#define CFSML_FAILURE 1\n\n"; -  create_string_functions; - -  foreach $n ( keys %types ) { -    create_declaration($type = $n); -  } - -  foreach $n ( keys %types ) { -    if (not $types{$n}->{'external'}) { -      create_writer($type = $n); -      create_reader($type = $n); -    } -  } -  print "\n/* Auto-generated CFSML declaration and function block ends here */\n"; -  print "/* Auto-generation performed by cfsml.pl $version */\n"; -} - - -# Gnerates code to read a data type -# Parameters: $type: Type to read -#             $datap: Pointer to the write destination -#             $fh: Existing filehandle of an open file to use -#             $eofvar: Variable to store _cfsml_eof into -sub insert_reader_code { -  print "/* Auto-generated CFSML data reader code */\n"; -  write_line_pp(__LINE__, 0); -  print "  {\n"; -  if (!$linecounter) { -      write_line_pp(__LINE__, 0); -      print "    int _cfsml_line_ctr = 0;\n"; -      $linecounter = '_cfsml_line_ctr'; -  } -  if ($atomic) { -      write_line_pp(__LINE__, 0); -      print "    struct _cfsml_pointer_refstruct **_cfsml_myptrrefptr = _cfsml_get_current_refpointer();\n"; -  } -  write_line_pp(__LINE__, 0); -  print "    int _cfsml_eof = 0, _cfsml_error;\n"; -  print "    int dummy;\n"; - -  if ($firsttoken) { -      write_line_pp(__LINE__, 0); -      print "    const char *_cfsml_inp = $firsttoken;\n"; -  } else { -      write_line_pp(__LINE__, 0); -      print "    const char *_cfsml_inp =". -	  " _cfsml_get_identifier($fh, &($linecounter), &_cfsml_eof, &dummy);\n\n"; -  } - -  write_line_pp(__LINE__, 0); -  print "    _cfsml_error =". -      " $types{$type}{'reader'}($fh, $datap, _cfsml_inp, &($linecounter), &_cfsml_eof);\n"; - -  if ($eofvar) { -      write_line_pp(__LINE__, 0); -      print "    $eofvar = _cfsml_error;\n"; -  } -  if ($atomic) { -      write_line_pp(__LINE__, 0); -      print "     _cfsml_free_pointer_references(_cfsml_myptrrefptr, _cfsml_error);\n"; -  } -  write_line_pp(__LINE__, 0); -  print "     if (_cfsml_last_value_retrieved) {\n"; -  print "       free(_cfsml_last_value_retrieved);\n"; -  print "       _cfsml_last_value_retrieved = NULL;\n"; -  print "     }\n"; -  print "     if (_cfsml_last_identifier_retrieved) {\n"; -  print "       free(_cfsml_last_identifier_retrieved);\n"; -  print "       _cfsml_last_identifier_retrieved = NULL;\n"; -  print "     }\n"; -  print "  }\n"; -  print "/* End of auto-generated CFSML data reader code */\n"; -} - -# Generates code to write a data type -# Parameters: $type: Type to write -#             $datap: Pointer to the write destination -#             $fh: Existing filehandle of an open file to use -sub insert_writer_code { -    write_line_pp(__LINE__, 0); -    print "/* Auto-generated CFSML data writer code */\n"; -    print "  $types{$type}{'writer'}($fh, $datap);\n"; -    print "  fprintf($fh, \"\\n\");\n"; -    print "/* End of auto-generated CFSML data writer code */\n"; -} - - -################ -# Main program # -################ - -$parsing = 0; -$struct = undef; # Not working on a struct -$commentmode = undef; -$line = 0; - -while (<STDIN>) { - -  $line++; - -  if ($parsing) { -    ($data) = split "#"; # Remove shell-style comments -    @_ = ($data); - -    s/\/\*.*\*\///g; # Remove C-style one-line comments - -    ($data) = split "\/\/"; # Remove C++-style comments -    @_ = ($data); - -    if ($commentmode) { - -      if (grep /\*\//, $_) { -	($empty, $_) = split /\*\//; -      } else { -	@_ = (); # Empty line -      } - -    } else { -      if (grep /\/\*/, $_) { -	$commentmode = 1; -	($_) = split /\/\*/; -      } -    } - - -    # Now tokenize: -    s/;//; -    split /(\".*\"|[,\[\]\(\)\{\}])|\s+/; - -    @items = @_; - -    @tokens = (); - -    $tokens_nr = 0; -    for ($n = 0; $n < scalar @items; $n++) { # Get rid of all undefs -      if ($_[$n]) { -	$_ = $items[$n]; -	s/\"//g; -	$tokens[$tokens_nr++] = $_; -      } -    } - -    # Now all tokens are in @tokens, and we have $tokens_nr of them. - -#    print "//DEBUG: " . join ("|", @tokens) . "\n"; - -    if ($tokens_nr) { -      if ($tokens_nr == 2 && $tokens[0] eq "%END" && $tokens[1] eq "CFSML") { - -	$struct && die "Record $struct needs closing braces in intput file (line $line)."; - -	$parsing = 0; -	create_function_block; -	my $linep = $line + 1; -	write_line_pp($linep, 1); -      } elsif ($struct) { # Parsing struct -	if ($tokens_nr == 1) { -	  if ($tokens[0] eq "}") { -	    $struct = undef; -	  } else { die "Invalid declaration of $token[0] in input file (line $line)\n";}; -	} else { # Must be a member declaration - -	  my @structrecs = (@{$records{$struct}}); -	  my $newidx = (scalar @structrecs) or "0"; -	  my %member = (); -	  $member{'name'} = $tokens[1]; -	  $member{'type'} = $tokens[0]; - -	  if ($tokens_nr == 3 && $tokens[1] == "*") { -	      $tokens_nr = 2; -	      $member{'name'} = $tokens[2]; -	      $member{'reftype'} = $tokens[0]; -	      $member{'type'} = $type_abspointer; -	  } - -	  if ($tokens_nr == 4 and $tokens[0] eq $type_pointer) { # Relative pointer - -	    if (not $tokens[2] eq "RELATIVETO") { -	      die "Invalid relative pointer declaration in input file (line $line)\n"; -	    } - -	    $member{'anchor'} = $tokens[3]; # RelPointer anchor - -	  } else { # Non-pointer - -	    if (not $types{$tokens[0]}) { -	      die "Unknown type $tokens[0] used in input file (line $line)\n"; -	    } - -	    if ($tokens_nr > 2) { # Array - -	      if ($tokens[2] ne "[") { -		die "Invalid token '$tokens[2]' in input file (line $line)\n"; -	      } - -	      $member{'array'} = "static"; - -	      if ($tokens[$tokens_nr - 1] ne "]") { -		die "Array declaration incorrectly terminated in input file (line $line)\n"; -	      } - -	      $parsepos = 3; - -	      while ($parsepos < $tokens_nr) { - -		if ($tokens[$parsepos] eq ",") { - -		  $parsepos++; - -		} elsif ($tokens[$parsepos] eq "STATIC") { - -		  $member{'array'} = "static"; -		  $parsepos++; - -		} elsif ($tokens[$parsepos] eq "DYNAMIC") { - -		  $member{'array'} = "dynamic"; -		  $parsepos++; - -		} elsif ($tokens[$parsepos] eq "MAXWRITE") { - -		  $member{'maxwrite'} = $tokens[$parsepos + 1]; -		  $parsepos += 2; - -		} elsif ($tokens[$parsepos] eq "]") { - -		  $parsepos++; -		  if ($parsepos != $tokens_nr) { -		    die "Error: Invalid tokens after array declaration in input file (line $line)\n"; - -		  } -		} else { - -		  if ($member{'size'}) { -		    die "Attempt to use more than one array size in input file (line $line)\n" . -		      "(Original size was \"$member->{'size'}\", new size is \"$tokens[$parsepos]\"\n"; -		  } - -		  $member{'size'} = $tokens[$parsepos]; -		  $parsepos++; -		} -	      } - - -	      unless ($member{'size'}) { -		die "Array declaration without size in input file (line $line)\n"; -	      } -	    } -	  } - -	  @{$records{$struct}}->[$newidx] = \%member; -	} -      } else { # not parsing struct; normal operation. - -	if ($tokens[0] eq "TYPE") { # Simple type declaration - -	  my $newtype = $tokens[1]; - -	  $types{$newtype}->{'ctype'} = $tokens[2]; - -	  if ($tokens_nr == 5) { # must be ...LIKE... - -	    unless ($tokens[3] eq "LIKE") { -	      die "Invalid TYPE declaration in input file (line $line)\n"; -	    } - -	    $types{$newtype}->{'type'} = $types{$tokens[4]}->{'type'}; -	    $types{$newtype}->{'reader'} = $types{$tokens[4]}->{'reader'}; -	    $types{$newtype}->{'writer'} = $types{$tokens[4]}->{'writer'}; - -	  } elsif ($tokens_nr == 6) { # must be ...USING... - -	    unless ($tokens[3] eq "USING") { -	      die "Invalid TYPE declaration in input file (line $line)\n"; -	    } - -	    $types{$newtype}->{'writer'} = $tokens[4]; -	    $types{$newtype}->{'reader'} = $tokens[5]; -	    $types{$newtype}->{'external'} = 'T'; - -	  } else { -	    die "Invalid TYPE declaration in input file (line $line)\n"; -	  } - -	} elsif ($tokens[0] eq "RECORD") { - -	  $struct = $tokens[1]; -	  if ($types{$struct}) { -	    die "Attempt to re-define existing type $struct as a struct in input file (line $line)"; -	  } -	  $types{$struct}{'type'} = $type_record; -	  if ($tokens_nr < 3 or $tokens_nr > 6 or $tokens[$tokens_nr - 1] ne "{") { -	    die "Invalid record declaration in input file (line $line)"; -	  } - -	  my $extoffset = 2; - -	  if ($tokens_nr > 3) { -	      if ($tokens[2] ne "EXTENDS") { # Record declaration with explicit c type -		  $types{$struct}{'ctype'} = $tokens[2]; -		  $extoffset = 3; -	      } else { # Record name is the same as the c type name -		  $types{$struct}{'ctype'} = $struct; -	      } -	  } elsif ($tokens_nr == 3) { -		  $types{$struct}{'ctype'} = $struct; -	  } - -	  if (($tokens_nr > $extoffset + 1) && ($extoffset + 1 <= $tokens_nr)) { -	      if ($tokens[$extoffset] ne "EXTENDS") { -		  die "Invalid or improper keyword \"$tokens[$extoffset]\" in input file (line $line)"; -	      } -	      if ($extoffset + 2 >= $tokens_nr) { -		  die "RECORD \"$struct\" extends on unspecified type in input file (line $line)"; -	      } -	      my $ext_type = $tokens[$extoffset + 1]; - -	      if (!($types{$ext_type}{type} eq $type_record)) { -		  print "$types{$ext_type}{type}"; -		  die "RECORD \"$struct\" attempts to extend non-existing or non-record type \"$ext_type\" in input file (line $line)"; -	      } - -	      (@{$records{$struct}}) = (@{$records{$ext_type}}); # Copy type information from super type -	  } - -	} else { -	  die "Invalid declaration \"$tokens[0]\" in line $line"; -	} -      } -    } - - -  } else { - -    ($subtoken) = split ";"; # Get rid of trailing ;s -    $tokens_nr = @tokens = split " ", $subtoken; - -    if ($tokens_nr == 1 && $tokens[0] eq "%CFSML") { - -      $parsing = 1; - -    } elsif ($tokens[0] eq "%CFSMLWRITE" and $tokens[3] eq "INTO" and $tokens_nr >= 5) { - -      insert_writer_code($type = $tokens[1], $datap = $tokens[2], $fh = $tokens[4]); -      my $templine = $line + 1; -      write_line_pp($templine, 1); # Yes, this sucks. - -    } elsif (($tokens[0] eq "%CFSMLREAD") or ($tokens[0] eq "%CFSMLREAD-ATOMIC") and $tokens[3] eq "FROM" and $tokens_nr >= 5) { - -      my $myeofvar = 0; -      my $myfirsttoken = 0; -      my $mylinecounter = 0; - -      my $idcounter = 5; - -      while ($idcounter < $tokens_nr) { -	if ($tokens[$idcounter] eq "ERRVAR" and $tokens_nr >= $idcounter + 2) { -	  $myeofvar = $tokens[$idcounter + 1]; -	  $idcounter += 2; -	} elsif ($tokens[$idcounter] eq "FIRSTTOKEN" and $tokens_nr >= $idcounter + 2) { -	  $myfirsttoken = $tokens[$idcounter + 1]; -	  $idcounter += 2; -	} elsif ($tokens[$idcounter] eq "LINECOUNTER" and $tokens_nr >= $idcounter + 2) { -	  $mylinecounter = $tokens[$idcounter + 1]; -	  $idcounter += 2; -	} else { -	  die "Unknown %CFSMLREAD operational token: $tokens[$idcounter]\n"; -	} -      } -      insert_reader_code($type = $tokens[1], $datap = $tokens[2], -			 $fh = $tokens[4], $eofvar = $myeofvar, $firsttoken = $myfirsttoken, -			$linecounter = $mylinecounter, $atomic = ($tokens[0] eq "%CFSMLREAD-ATOMIC")); -      my $templine = $line + 1; -      write_line_pp($templine, 1); # Yes, this sucks, too. - -    } else { -      print; -    } -  } - -} - -if ($parsing) { -  print <STDERR>, "Warning: Missing %END CFSML\n"; -} | 
