diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/ref.pl')
| -rw-r--r-- | qemu/roms/SLOF/slof/ref.pl | 148 |
1 files changed, 148 insertions, 0 deletions
diff --git a/qemu/roms/SLOF/slof/ref.pl b/qemu/roms/SLOF/slof/ref.pl new file mode 100644 index 000000000..b21f13901 --- /dev/null +++ b/qemu/roms/SLOF/slof/ref.pl @@ -0,0 +1,148 @@ +# ***************************************************************************** +# * Copyright (c) 2004, 2008 IBM Corporation +# * All rights reserved. +# * This program and the accompanying materials +# * are made available under the terms of the BSD License +# * which accompanies this distribution, and is available at +# * http://www.opensource.org/licenses/bsd-license.php +# * +# * Contributors: +# * IBM Corporation - initial implementation +# ****************************************************************************/ +#!/usr/bin/perl + +# +# Copyright 2002,2003,2004 Segher Boessenkool <segher@kernel.crashing.org> +# + + +use Getopt::Std; +use Data::Dumper; + +$CELLSIZE = length(sprintf "%x", ~0) / 2; +$CELLSIZE = 8; +$DEBUG = 0; + +sub usage +{ + printf STDERR "Usage: ref.pl [ -s 32|64 ] [ -d ] \n"; + printf STDERR " ref.pl -h\n"; + exit 0; +} + +sub string +{ + my ($s, $extra) = @_; + + $DEBUG and printf STDERR "\nstring:[%s][%02x]\n", $s, ord $extra; + $s = sprintf "%s%c%s", $extra, length($s), $s; + @s = ($s =~ /(.{1,$CELLSIZE})/gs); + do { s/([\x00-\x1f\x22\x5c\x7f-\xff])/sprintf "\\%03o", ord $1/egs } for @s; + my @reut = ("{ .c = \"" . (join "\" }, { .c = \"", @s) . "\" },", scalar @s); + # $DEBUG and print STDERR Dumper \@reut; + return @reut; +} + +sub forth_to_c_name +{ + ($_, my $numeric) = @_; + s/([^a-zA-Z0-9])/sprintf("_X%02x_", ord($1))/ge; + s/__/_/g; +# s/^_//; + s/_$//; + s/^(\d)/_$1/ if $numeric; + return $_; +} + +sub special_forth_to_c_name +{ + ($_, my $numeric) = @_; + + $DEBUG and print STDERR "\tasked for $_ [[numeric is $numeric]]\n"; + my ($name, $arg) = (/^([^(]+)(.*)$/); + # $DEBUG and print STDERR "\tname is $name -- arg is $arg\n"; + if ($special{$name} == 1) { + $_ = forth_to_c_name($name, $numeric) . $arg; + } elsif ($special{$name} != 2) { + $_ = forth_to_c_name($_, $numeric); + } + # $DEBUG and print STDERR "\tmaking it $_\n"; + return $_; +} + +getopts('dhs:') or die "Invalid option!\n"; + +$opt_h and usage(); +$opt_d and $DEBUG=1; +$opt_s and $opt_s != 32 and $opt_s != 64 and die("Only -s32 or -s64 allowed"); + +$opt_s and $opt_s == 32 and $CELLSIZE=4; + +$DEBUG and printf STDERR "Cell size set to $CELLSIZE;\n"; + +$link = "0"; +%special = ( _N => 2, _O => 2, _C => 2, _A => 2 ); + +$DEBUG and print STDERR "Compiling:"; +while ($line = <>) { + if ($line =~ /^([a-z]{3})\(([^ ]+)./) { + $typ = $1; + $name = $2; + + $DEBUG and print STDERR "\n\t\t$name###\n"; + + $name =~ s/\)$// if $line =~ /\)\s+_ADDING.*$/; + # $DEBUG and print STDERR " $name"; + $cname = forth_to_c_name($name, 1); + $par = ''; + $add = ''; + $extra = "\0"; + if ($typ eq "imm") { + $typ = "col"; + $extra = "\1"; + } +# if ($typ eq "com") { +# $typ = "col"; +# $extra = "\3"; +# } + ($str, $strcells) = (string $name, $extra); + if ($line =~ /^str\([^"]*"([^"]*)"/) { + # $DEBUG and print STDERR "[[[$1]]]\n"; + ($s) = (string $1); + $line =~ s/"[^"]*"/$s/; + } + if ($line =~ /_ADDING +(.*)$/) { + $special{$name} = 1; + @typ = (split /\s+/, $1); + $count = 0; + $par = "(" . (join ", ", map { $count++; "_x$count" } @typ) . ")"; + $count = 0; + $add = join " ", map { $count++; "$_(_x$count)" } @typ; + $line =~ s/\s+_ADDING.*$//; + } + # $DEBUG and print STDERR $line; + ($body) = ($line =~ /^...\((.*)\)$/); + @body = split " ", $body; + # $DEBUG and print STDERR "\n"; + # $DEBUG and print STDERR "BODY WAS: ", (join " ", @body), "\n"; + if ($typ ne "str" and $typ ne "con") { + @body = map { special_forth_to_c_name($_, $typ eq "col") } @body; + } else { + $body[0] = special_forth_to_c_name($body[0]); + } + # $DEBUG and print STDERR "BODY IS: ", (join " ", @body), "\n"; + $body = join " ", @body; + $body =~ s/ /, /; + # $DEBUG and print STDERR "===> $body\n"; + + print "header($cname, { .a = $link }, $str) "; + $link = "xt_$cname"; + print "$typ($body)\n"; + print "#define $cname$par ref($cname, $strcells+1) $add\n"; + (my $xxcname) = ($cname =~ /^_?(.*)/); + $add and print "#define DO$xxcname ref($cname, $strcells+1)\n"; + } else { + print $line; + } +} +$DEBUG and print STDERR "\n"; |