summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/ref.pl
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/SLOF/slof/ref.pl
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/SLOF/slof/ref.pl')
-rw-r--r--qemu/roms/SLOF/slof/ref.pl148
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";