diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/ref.pl')
| -rw-r--r-- | qemu/roms/SLOF/slof/ref.pl | 148 |
1 files changed, 0 insertions, 148 deletions
diff --git a/qemu/roms/SLOF/slof/ref.pl b/qemu/roms/SLOF/slof/ref.pl deleted file mode 100644 index b21f13901..000000000 --- a/qemu/roms/SLOF/slof/ref.pl +++ /dev/null @@ -1,148 +0,0 @@ -# ***************************************************************************** -# * 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"; |