X-Git-Url: https://gerrit.opnfv.org/gerrit/gitweb?a=blobdiff_plain;f=qemu%2Froms%2FSLOF%2Fslof%2Fref.pl;fp=qemu%2Froms%2FSLOF%2Fslof%2Fref.pl;h=b21f139013fa9a426e669e04971bad1f3176aca2;hb=e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb;hp=0000000000000000000000000000000000000000;hpb=9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00;p=kvmfornfv.git

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";