#!/usr/local/bin/perl -s

$gcalert = 1 if ($list);

$list = 1 if ($assign);
$list = 1 if ($setupassign);
$list = 1 if ($exports);
$list = 1 if ($winex);
$list = 1 if ($gwinex);

while (<>) {
    chop;
    if ($_ eq '/* START */') {
	@exported = ();

	print "typedef struct {\n" unless $list;

	while (<>) {
	    if (substr($_, 0, 2) eq '/*' || substr($_, 0, 1) eq '#') {
		print $_ unless $list;
		if (substr($_, 0, 1) eq '#') {
		    @exported = (@exported, $_);
		}
	    } else {
		chop;
		if (!($_ =~ /^ *$/)) {
		    if ($_ =~ /^extern /) {
			$_ = substr($_, 7);
		    }
		    if ($_ =~ /^XFORM_NONGCING /) {
			$_ = substr($_, 15);
		    }
		    if ($_ =~ /^MZ_EXTERN /) {
			$_ = substr($_, 10);
		    }

		    if ($_ =~ /^volatile /) {
			$_ = substr($_, 9);
			$volatile = 'volatile ';
		    } else {
			$volatile = '';
                    }

		    if ($_ =~ /^const /) {
			$_ = substr($_, 6);
			$const = 'const ';
		    } elsif ($_ =~ /^struct /) {
			$_ = substr($_, 7);
			$const = 'struct ';
		    } else {
			$const = '';
		    }

		    if ($_ =~ /^unsigned /) {
			$_ = substr($_, 9);
			$unsigned = 'unsigned ';
		    } else {
			$unsigned = '';
                    }

		    if ($_ =~ /\[1?\];$/) {
			$star = '*';
		    } else {
			$star = '';
		    }

		    $_ =~ /([a-zA-Z0-9_]*) ([*]*)([a-zA-Z0-9_]*)(.*)/;
		    if (substr($4, 0, 1) eq '(') {
			print "$const$unsigned$1 $2(*$3)$4\n" unless $list;
		    } else {
			print "$const$volatile$unsigned$1 $star$2$3;\n" unless $list;
		    }
		    @exported = (@exported, $3);

		    if (&Unbalanced($4)) {
			do {
			    $_ = <>;
			    print $_ unless $list;
			} while (!($_ =~ /\);/));
		    }
		}
	    }
	}

	print "#ifndef SCHEME_EX_INLINE\n} Scheme_Extension_Table;\n#endif\n" unless $list;
    } else {
	print "$_\n" unless $list;
    }
}

$elsesuspend = 0;
$suspend = 0;

%nonprocs = ();

print "#!..\n" if $exports;
print "EXPORTS\n" if ($winex || $gwinex);

if ($list) {
    foreach $f (@exported) {
	if (substr($f, 0, 1) eq '#') {
	    if ($exports || $winex || $gwinex) {
		if ($f =~ /#ifdef MZ_REAL_THREADS/) {
		    $suspend = 1;
		}
		if ($f =~ /#ifndef MZ_REAL_THREADS/) {
		    $elsesuspend = 1;
		}
		if ($f =~ /#ifdef MACINTOSH_EVENTS/) {
		    $suspend = 1;
		}
		if ($f =~ /#ifdef USE_MAC_FILE_TOOLBOX/) {
		    $suspend = 1;
		}
		if ($f =~ /#ifdef USE_MAC_CARBON_FILE_TOOLBOX/) {
		    $suspend = 1;
		}
		if ($f =~ /#ifdef MZ_USE_SINGLE_FLOATS/) {
		    $suspend = 1;
		}
		if ($exports && $f =~ /#ifdef USE_MZ_SETJMP/) {
		    $suspend = 1;
		}
		if ($f =~ /#\s*ifdef MZ_PRECISE_GC/) {
		    if ($precisegc) {
			$elsesuspend = 1;
		    } else {
			$suspend = 1;
		    }
		}
		if ($f =~ /#ifndef LINK_EXTENSIONS_BY_TABLE/) {
		    $elsesuspend = 1;
		}
		if ($f =~ /#\s*else/) {
		    $suspend = 0;
		    $suspend = 1 if $elsesuspend;
		    $elsesuspend = 0;
		}
		if ($f =~ /#\s*endif/) {
		    $suspend = $elsesuspend = 0;
		}
	    } else {
		print $f;
	    }
	} else {
	    if ($assign) {
		print "  scheme_extension_table->$f = $f;\n";
	    } elsif ($setupassign) {
		print "  $f = table->$f;\n";
	    } elsif ($exports) {
		print "$f\n" unless $suspend;
	    } elsif ($winex || $gwinex) {
		$data = "";
		if (($f =~ /scheme_current_thread/)
		    || ($f =~ /scheme_fuel_counter/)
		    || ($f =~ /scheme_eof/)
		    || ($f =~ /scheme_null/)
		    || ($f =~ /scheme_true/)
		    || ($f =~ /scheme_false/)
		    || ($f =~ /scheme_void/)
		    || ($f =~ /scheme_undefined/)
		    || ($f =~ /scheme_null/)) {
		    $data = " DATA";
		}
		if ($winex && ($f =~ /^scheme_/)) {
		    print " $f$data\n" unless $suspend;
		} elsif ($gwinex && ($f =~ /^GC_/)) {
		    print " $f$data\n" unless $suspend;
		}
	    } else {
		print "#define $f (scheme_extension_table->$f)\n";
	    }
	}
    }
}

if ($gcalert) {
  print "#ifdef MZ_PRECISE_GC\n";
  print "#pragma GC_VARIABLE_SATCK_THOUGH_TABLE\n";
  print "#endif\n";
}

sub Unbalanced {
    local ($s) = @_;

    $balance = 0;
    while ($s ne '') {
	$char = substr($s, 0, 1);
	if ($char eq '(') {
	    $balance += 1;
	} elsif ($char eq ')') {
	    $balance -= 1;
	}
	$s = substr($s, 1);
    }

    return $balance;
}
