The Museum of HP Calculators

HP Forum Archive 18

[ Return to Index | Top of Index ]

A compiler for HP-11C
Message #1 Posted by Thomas Klemm on 2 Mar 2008, 5:45 p.m.

For some time I was looking for an easier way to bring programs to Eric's Nonpareil HP-11C emulator
than by "typing" them with the mouse. It was only recently that I became aware of the format used
when saving the state: it's a zipped XML-file

With the help of HP-11C Hex-Table I wrote a small perl-script that does two things:

  • Run the script with option -c to "compile" a listing to an XML-file
  • Print the listing of the program saved within an XML-file

Compressing and uncompressing is not part of the script. Use gzip/gunzip.

These are the three steps needed to load a program:

1. Create a listing of the progam as plain text

# cat sqeq.hp
LBL A
ENTER
R^
/
R^
LASTx
/
2
CHS
/
ENTER
ENTER
x^2
R^
-
SQRT
-
x<>y
LASTx
+
RTN

2. Compile the program to an XML-file and zip it

# hp-11c.pl -c sqeq.hp | gzip -cf > sqeq

3. Now you can open the file in the emulator

File -> Open (Ctrl+O)

On the other hand you can save the state and print a listing of the program:

# gunzip -c sqeq | hp-11c.pl
001 - 42,21,11   LBL A
002 -       36   ENTER
003 -   43  33   R-^
004 -       10   ÷
005 -   43  33   R-^
006 -   43  36   LASTx
007 -       10   ÷
008 -        2   2
009 -       16   CHS
010 -       10   ÷
011 -       36   ENTER
012 -       36   ENTER
013 -   43  11   x^2
014 -   43  33   R-^
015 -       30   -
016 -       11   SQRT x
017 -       30   -
018 -       34   x<->y
019 -   43  36   LASTx
020 -       40   +
021 -   43  32   RTN

If you just want a nice listing you can run the script twice:

# hp-11c.pl -c sqeq.hp | hp-11c.pl

A few notes on the perl-script:

I "printed" Eric's table as plain text using lynx. This was used to create the @code table.
However I made some minor changes (e.g. P -> PI) where I thought it was appropriate.

I saved the state of the emulator after an "Obdurate reset" and used this XML-file as a base
for the output.

There are some replacements (lines 86-91) that allows for a slightly different input from the output.
For instance you can use * and / instead of × and ÷. Feel free to add your own rules.


#!/usr/bin/perl -w

use strict;

my %dec = ( 0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, a => 10, b => 11, c => 12, d => 13, e => 14, f => 15, );

my %hex; @hex{values %dec} = keys %dec;

my @display = ( ['42,21, 0', '42,21, 1', '42,21, 2', '42,21, 3', '42,21, 4', '42,21, 5', '42,21, 6', '42,21, 7', '42,21, 8', '42,21, 9', '42,21,11', '42,21,12', '42,21,13', '42,21,14', '42,21,15', '42,21,25', ], [' 22 0', ' 22 1', ' 22 2', ' 22 3', ' 22 4', ' 22 5', ' 22 6', ' 22 7', ' 22 8', ' 22 9', ' 22 11', ' 22 12', ' 22 13', ' 22 14', ' 22 15', ' 22 25', ], [' 32 0', ' 32 1', ' 32 2', ' 32 3', ' 32 4', ' 32 5', ' 32 6', ' 32 7', ' 32 8', ' 32 9', ' 32 11', ' 32 12', ' 32 13', ' 32 14', ' 32 15', ' 32 25', ], ['42, 8, 0', '42, 8, 1', '42, 8, 2', '42, 8, 3', '42, 8, 4', '42, 8, 5', '42, 8, 6', '42, 8, 7', '43, 4, 0', '43, 4, 1', '44,40, 0', '44,40, 1', '44,40, 2', '44,40, 3', '44,40, 4', ' 45 25', ], ['42, 9, 0', '42, 9, 1', '42, 9, 2', '42, 9, 3', '42, 9, 4', '42, 9, 5', '42, 9, 6', '42, 9, 7', '43, 5, 0', '43, 5, 1', '44,40, 5', '44,40, 6', '44,40, 7', '44,40, 8', '44,40, 9', '44,40,24', ], [' 45 0', ' 45 1', ' 45 2', ' 45 3', ' 45 4', ' 45 5', ' 45 6', ' 45 7', ' 45 8', ' 45 9', '44,30, 0', '44,30, 1', '44,30, 2', '44,30, 3', '44,30, 3', ' 45 24', ], [' 45 .0', ' 45 .1', ' 45 .2', ' 45 .3', ' 45 .4', ' 45 .5', ' 45 .6', ' 45 .7', ' 45 .8', ' 45 .9', '44,30, 5', '44,30, 6', '44,30, 7', '44,30, 8', '44,30, 9', '44,30,24', ], [' 44 0', ' 44 1', ' 44 2', ' 44 3', ' 44 4', ' 44 5', ' 44 6', ' 44 7', ' 44 8', ' 44 9', '44,20, 0', '44,20, 1', '44,20, 2', '44,20, 3', '44,20, 3', ' 44 24', ], [' 44 .0', ' 44 .1', ' 44 .2', ' 44 .3', ' 44 .4', ' 44 .5', ' 44 .6', ' 44 .7', ' 44 .8', ' 44 .9', '44,20, 5', '44,20, 6', '44,20, 7', '44,20, 8', '44,20, 9', '44,20,24', ], ['42, 7, 0', '42, 7, 1', '42, 7, 2', '42, 7, 3', '42, 7, 4', '42, 7, 5', '42, 7, 6', '42, 7, 7', '42, 7, 8', '42, 7, 9', '44,40, 0', '44,10, 1', '44,10, 2', '44,10, 3', '44,10, 4', ' 44 25', ], ['42,22,23', '43,22,23', '42,22,24', '43,22,24', '42,22,25', '43,22,25', ' 45 49', ' 44 36', '43, 6, 0', '43, 6, 1', '44,10, 5', '44,10, 6', '44,10, 7', '44,10, 8', '44,10, 9', '44,10,24', ], [' 42 31', ' 42 32', ' 42 34', ' 43 32', ' 42 16', ' 43 34', ' 43 36', ' 43 23', ' 43 24', ' 43 25', ' 43 11', ' 43 12', ' 43 13', ' 43 14', ' 43 15', ' 43 26', ], [' 31', ' 33', ' 34', ' 43 35', ' 16', ' 26', ' 36', ' 23', ' 24', ' 25', ' 11', ' 12', ' 13', ' 14', ' 15', ' 42 26', ], [' 43 0', ' 43 1', ' 43 2', ' 43 3', ' 42 23', ' 43 33', ' 42 36', ' 43 7', ' 43 8', ' 43 9', ' 43 40', ' 43 30', ' 43 20', ' 43 10', ' 43 49', ' 43 48', ], [' 42 0', ' 42 1', ' 42 2', ' 42 3', ' 42 4', ' 42 5', ' 42 6', ' 43 44', ' 42 44', ' 43 16', ' 42 40', ' 42 30', ' 42 20', ' 42 10', ' 42 49', ' 42 48', ], [' 0', ' 1', ' 2', ' 3', ' 4', ' 5', ' 6', ' 7', ' 8', ' 9', ' 40', ' 30', ' 20', ' 10', ' 49', ' 48', ], );

my @code = ( ['LBL 0' , 'LBL 1' , 'LBL 2' , 'LBL 3' , 'LBL 4' , 'LBL 5' , 'LBL 6' , 'LBL 7' , 'LBL 8' , 'LBL 9' , 'LBL A' , 'LBL B' , 'LBL C' , 'LBL D' , 'LBL E' , 'spare' ,], ['GTO 0' , 'GTO 1' , 'GTO 2' , 'GTO 3' , 'GTO 4' , 'GTO 5' , 'GTO 6' , 'GTO 7' , 'GTO 8' , 'GTO 9' , 'GTO A' , 'GTO B' , 'GTO C' , 'GTO D' , 'GTO E' , 'GTO I' ,], ['GSB 0' , 'GSB 1' , 'GSB 2' , 'GSB 3' , 'GSB 4' , 'GSB 5' , 'GSB 6' , 'GSB 7' , 'GSB 8' , 'GSB 9' , 'GSB A' , 'GSB B' , 'GSB C' , 'GSB D' , 'GSB E' , 'GSB I' ,], ['SCI 0' , 'SCI 1' , 'SCI 2' , 'SCI 3' , 'SCI 4' , 'SCI 5' , 'SCI 6' , 'SCI 7' , 'SF 0' , 'SF 1' , 'STO + 0', 'STO + 1', 'STO + 2', 'STO + 3', 'STO + 4', 'RCL I' ,], ['ENG 0' , 'ENG 1' , 'ENG 2' , 'ENG 3' , 'ENG 4' , 'ENG 5' , 'ENG 6' , 'ENG 7' , 'CF 0' , 'CF 1' , 'STO + 5', 'STO + 6', 'STO + 7', 'STO + 8', 'STO + 9', 'STO + (i)',], ['RCL 0' , 'RCL 1' , 'RCL 2' , 'RCL 3' , 'RCL 4' , 'RCL 5' , 'RCL 6' , 'RCL 7' , 'RCL 8' , 'RCL 9' , 'STO - 0', 'STO - 1', 'STO - 2', 'STO - 3', 'STO - 4', 'RCL (i)' ,], ['RCL .0', 'RCL .1' , 'RCL .2' , 'RCL .3' , 'RCL .4' , 'RCL .5' , 'RCL .6' , 'RCL .7' , 'RCL .8', 'RCL .9', 'STO - 5', 'STO - 6', 'STO - 7', 'STO - 8', 'STO - 9', 'STO - (i)',], ['STO 0' , 'STO 1' , 'STO 2' , 'STO 3' , 'STO 4' , 'STO 5' , 'STO 6' , 'STO 7' , 'STO 8' , 'STO 9' , 'STO × 0', 'STO × 1', 'STO × 2', 'STO × 3', 'STO × 4', 'STO (i)' ,], ['STO .0', 'STO .1' , 'STO .2' , 'STO .3' , 'STO .4' , 'STO .5' , 'STO .6' , 'STO .7' , 'STO .8', 'STO .9', 'STO × 5', 'STO × 6', 'STO × 7', 'STO × 8', 'STO × 9', 'STO × (i)',], ['FIX 0' , 'FIX 1' , 'FIX 2' , 'FIX 3' , 'FIX 4' , 'FIX 5' , 'FIX 6' , 'FIX 7' , 'FIX 8' , 'FIX 9' , 'STO ÷ 0', 'STO ÷ 1', 'STO ÷ 2', 'STO ÷ 3', 'STO ÷ 4', 'STO I' ,], ['SINH' , 'SINH^-1', 'COSH' , 'COSH^-1', 'TANH' , 'TANH^-1', 'RCL S+' , 'STO RAN#', 'F? 0' , 'F? 1' , 'STO ÷ 5', 'STO ÷ 6', 'STO ÷ 7', 'STO ÷ 8', 'STO ÷ 9', 'STO ÷ (i)',], ['PSE' , 'CLRS' , 'CLR REG', 'RTN' , 'PI' , 'RND' , 'LASTx' , 'SIN^-1' , 'COS^-1', 'TAN^-1', 'x^2' , 'LN' , 'LOG' , '%' , 'D%' , '->P' ,], ['R/S' , 'R-v' , 'x<->y' , 'CLx' , 'CHS' , 'EEX' , 'ENTER' , 'SIN' , 'COS' , 'TAN' , 'SQRT x' , 'e^x' , '10^x' , 'y^x' , '1/x' , '->R' ,], ['x bar' , 'Cy,x' , '->H' , '->DEG' , 'x<->(i)', 'R-^' , 'RAN#' , 'DEG' , 'RAD' , 'GRAD' , 'x=0' , 'x!=0' , 'x>0' , 'x<0' , 'S-' , 's' ,], ['x!' , 'Py,x' , '->H.MS' , '->RAD' , 'x<->I' , 'DSE' , 'ISG' , 'INT' , 'FRAC' , 'ABS' , 'x=y' , 'x!=y' , 'x>y' , 'x=<y' , 'L.R.' , 'y hat, r' ,], ['0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' , '8' , '9' , '+' , '-' , '×' , '÷' , 'S+' , '.' ,], );

my %encode;

for my $i (0 .. 15) { my $msd = $hex{$i}; for my $j (0 .. 15) { my $lsd = $hex{$j}; $encode{uc $code[$i][$j]} = "$msd$lsd"; } }

my $clopt; if ($ARGV[0] && $ARGV[0] =~ /^-/) { $clopt = shift; }

if ($clopt && $clopt =~ /^-c/) { # compile

my @bytes;

while (<>) { chomp; s|(?<!\w)/(?!\w)|÷|; s|(?<!\w)\*(?!\w)|×|; s|<>|<->|; s|^SQRT$|SQRT x|; s|^RDN$|R-v|; s|^R\^$|R-^|; push @bytes, $encode{uc $_}; }

my $idx = $#bytes; my $byte = $idx % 7 + 1; my $addr = 0xfc - int($idx / 7); my $xml = sprintf <<XML, $byte, $addr; <loc addr="0fd" data="00000000000000"/> <loc addr="0fe" data="00000000000%01d%02x"/> <loc addr="0ff" data="00000000000000"/> </memory> </state> XML

for my $addr (reverse (0xe0 .. 0xfc)) { my @data = splice @bytes, 0, 7; $#data = 6; $xml = sprintf(<<XML, $addr, join '', map { $_ || '00' } reverse @data) . $xml; <loc addr="%03x" data="%s"/> XML }

print <<XML; <?xml version="1.0" encoding="ISO-8859-1"?> <!DOCTYPE state SYSTEM "nonpareil.dtd"> <state version="1.00" model="11C" platform="voyager" arch="nut"> <ui/> <chip name="Nut"> <registers> <reg name="a" data="00000000000000"/> <reg name="b" data="000000fffff000"/> <reg name="c" data="00000000000eae"/> <reg name="m" data="00000000000000"/> <reg name="n" data="00000000000000"/> <reg name="g" data="04"/> <reg name="p" data="c"/> <reg name="q" data="3"/> <reg name="q_sel" data="0"/> <reg name="fo" data="00"/> <reg name="s" data="0800"/> <reg name="pc" data="0000"/> <reg name="stack" index="0" data="006d"/> <reg name="stack" index="1" data="0042"/> <reg name="stack" index="2" data="0000"/> <reg name="stack" index="3" data="0000"/> <reg name="decimal" data="0"/> <reg name="carry" data="0"/> <reg name="awake" data="0"/> <reg name="pf_addr" data="00"/> <reg name="ram_addr" data="007"/> <reg name="active_bank" index="0" data="0"/> <reg name="active_bank" index="1" data="0"/> <reg name="active_bank" index="2" data="0"/> <reg name="active_bank" index="3" data="0"/> <reg name="active_bank" index="4" data="0"/> <reg name="active_bank" index="5" data="0"/> <reg name="active_bank" index="6" data="0"/> <reg name="active_bank" index="7" data="0"/> <reg name="active_bank" index="8" data="0"/> <reg name="active_bank" index="9" data="0"/> <reg name="active_bank" index="a" data="0"/> <reg name="active_bank" index="b" data="0"/> <reg name="active_bank" index="c" data="0"/> <reg name="active_bank" index="d" data="0"/> <reg name="active_bank" index="e" data="0"/> <reg name="active_bank" index="f" data="0"/> </registers> </chip> <chip name="Voyager LCD"> <registers> <reg name="enable" data="1"/> <reg name="blink" data="0"/> </registers> </chip> <memory as="ram"> <loc addr="000" data="00000000000000"/> <loc addr="001" data="00000000000000"/> <loc addr="002" data="00000000000000"/> <loc addr="003" data="00000000000000"/> <loc addr="004" data="000000fffff000"/> <loc addr="005" data="00000000000008"/> <loc addr="006" data="0000000000000c"/> <loc addr="007" data="00000000000eae"/> <loc addr="008" data="00000000000000"/> <loc addr="009" data="2faf8befbe2280"/> <loc addr="00a" data="00000000000000"/> $xml XML

} else { # list

my @nibs; my $addr; my $byte;

LINE: while (<>) { while (m|<loc addr="(\w+)" data="(\w+)"/>|g) { if ($1 eq '0fe') { ($byte, $addr) = $2 =~ /(\w)(\w\w)$/; last LINE; } unshift @nibs, reverse split //, $2; } }

# get rid of the data before addr 0fe splice @nibs, 0, 14;

# calculate where to end $#nibs = 2 * ((0xfc - hex $addr) * 7 + $byte) - 1;

my $line = 1;

while (@nibs) { my ($lsd, $msd) = map { $dec{$_} } (shift @nibs, shift @nibs); printf "%03d - $display[$msd][$lsd] $code[$msd][$lsd]\n", $line++; } }

      
Re: A compiler for HP-11C
Message #2 Posted by Eric Smith on 2 Mar 2008, 9:20 p.m.,
in response to message #1 by Thomas Klemm

Nice work.

By the way, the ".nst" file (Nonpareil STate) doesn't have to be compressed, though Nonpareil always writes them in gzip-compressed form. The output of your script can be used directly.

            
Re: A compiler for HP-11C
Message #3 Posted by Thomas Klemm on 3 Mar 2008, 4:22 p.m.,
in response to message #2 by Eric Smith

Thanks for the hint. Therefore all you have to do to compile a program is:

hp-11c.pl -c sqeq.hp > sqeq.nst
      
Re: A compiler for HP-11C
Message #4 Posted by Egan Ford on 2 Mar 2008, 10:10 p.m.,
in response to message #1 by Thomas Klemm

Very nice work. Can you whip out a 15C and 16C version too?

            
Re: A compiler for HP-11C
Message #5 Posted by Thomas Klemm on 3 Mar 2008, 4:17 p.m.,
in response to message #4 by Egan Ford

The 16C version is more or less the same program.
For the 15C version I need probably a little more time since two-byte instructions are used.
What about a 12C version? Any interest?


#!/usr/bin/perl -w

use strict;

my %dec = ( 0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, a => 10, b => 11, c => 12, d => 13, e => 14, f => 15, );

my %hex; @hex{values %dec} = keys %dec;

my @display = ( ['43,22, 0', '43,22, 1' , '43,22, 2' , '43,22, 3' , '43,22, 4', '43,22, 5', '43,22, 6', '43,22, 7', '43,22, 8', '43,22, 9', '43,22, A' , '43,22, b', '43,22, C', '43,22, d', '43,22, E', '43,22, F', ], ['43, 4, 0', '43, 4, 1' , '43, 4, 2' , '43, 4, 3' , '43, 4, 4', '43, 4, 5', '43,36, 0', '43,36, 1', '43,36, 2', '43,36, 3', '43,36, 4' , '43,36, 5', '43,36, 6', '43,36, 7', '43,36, 8', '43,36, 9', ], ['43, 5, 0', '43, 5, 1' , '43, 5, 2' , '43, 5, 3' , '43, 5, 4', '43, 5, 5', '42,45, 0', '42,45, 1', '42,45, 2', '42,45, 3', '42,45, 4' , '42,45, 5', '42,45, 6', '42,45, 7', '42,45, 8', '42,45, 9', ], ['43, 6, 0', '43, 6, 1' , '43, 6, 2' , '43, 6, 3' , '43, 6, 4', '43, 6, 5', '42,45, 6', '42,45, 7', '42,45, 8', '42,45, 9', '42,45,48' , '42,45, b', '42,45, C', '42,45, d', '42,45, E', '42,45, F', ], [' 22 0', ' 22 1' , ' 22 2' , ' 22 3' , ' 22 4', ' 22 5', ' 22 6', ' 22 7', ' 22 8', ' 22 9', ' 22 A' , ' 22 b', ' 22 C', ' 22 d', ' 22 E', ' 22 F', ], [' 21 0', ' 21 1' , ' 21 2' , ' 21 3' , ' 21 4', ' 21 5', ' 21 6', ' 21 7', ' 21 8', ' 21 9', ' 21 A' , ' 21 b', ' 21 C', ' 21 d', ' 21 E', ' 21 F', ], [' 45 0', ' 45 1' , ' 45 2' , ' 45 3' , ' 45 4', ' 45 5', ' 45 6', ' 45 7', ' 45 8', ' 45 9', ' 45 A' , ' 45 b', ' 45 C', ' 45 d', ' 45 E', ' 45 F', ], [' 45 .0', ' 45 .1' , ' 45 .2' , ' 45 .3' , ' 45 .4', ' 45 .5', ' 45 .6', ' 45 .7', ' 45 .8', ' 45 .9', ' 45 .A' , ' 45 .b', ' 45 .C', ' 45 .d', ' 45 .E', ' 45 .F', ], [' 44 0', ' 44 1' , ' 44 2' , ' 44 3' , ' 44 4', ' 44 5', ' 44 6', ' 44 7', ' 44 8', ' 44 9', ' 44 A' , ' 44 b', ' 44 C', ' 44 d', ' 44 E', ' 44 F', ], [' 44 .0', ' 44 .1' , ' 44 .2' , ' 44 .3' , ' 44 .4', ' 44 .5', ' 44 .6', ' 44 .7', ' 44 .8', ' 44 .9', ' 44 .A' , ' 44 .b', ' 44 .C', ' 44 .d', ' 44 .E', ' 44 .F', ], [' 44 .0', ' 43 23' , ' 43 24' , ' 43 25' , ' 43 26', ' 43 33', ' 43 36', ' 43 45', ' 43 44', ' 43 48', ' 43 34' , ' 43 49', ' 43 40', ' 43 30', ' 43 20', ' 43 10', ], [' 0', ' 42 23' , ' 42 24' , ' 42 25' , ' 42 26', ' 45 31', ' 45 32', ' 22 32', ' 42 44', ' 42 21', ' 42 34' , ' 42 49', ' 42 40', ' 42 30', ' 42 20', ' 42 10', ], [' 43 35', ' 23' , ' 24' , ' 25' , ' 26', ' 33', ' 36', ' 21 32', ' 31', ' 48', ' 34' , ' 49', ' 40', ' 30', ' 20', ' 10', ], [' 43 0', ' 43 1' , ' 43 2' , ' 43 3' , ' 43 21', ' 44 31', ' 44 32', ' 43 7', ' 43 8', ' 43 9', ' 43 A' , ' 43 b', ' 43 C', ' 43 d', ' 43 E', ' 43 F', ], [' 42 22', ' 42 1' , ' 42 2' , ' 42 3' , ' 42 4', ' 42 5', ' 42 6', ' 42 7', ' 42 8', ' 42 9', ' 42 A' , ' 42 b', ' 42 C', ' 42 d', ' 42 E', ' 42 F', ], [' 0', ' 1' , ' 2' , ' 3' , ' 4', ' 5', ' 6', ' 7', ' 8', ' 9', ' A' , ' b', ' C', ' d', ' E', ' F', ], );

my @code = ( ['LBL 0' , 'LBL 1' , 'LBL 2' , 'LBL 3' , 'LBL 4' , 'LBL 5' , 'LBL 6' , 'LBL 7' , 'LBL 8' , 'LBL 9' , 'LBL A' , 'LBL B' , 'LBL C' , 'LBL D' , 'LBL E' , 'LBL F' ,], ['SF 0' , 'SF 1' , 'SF 2' , 'SF 3' , 'SF 4' , 'SF 5' , 'WINDOW 0', 'WINDOW 1', 'WINDOW 2', 'WINDOW 3', 'WINDOW 4' , 'WINDOW 5', 'WINDOW 6', 'WINDOW 7', ':1E' , ':1F' ,], ['CF 0' , 'CF 1' , 'CF 2' , 'CF 3' , 'CF 4' , 'CF 5' , 'FLOAT 0' , 'FLOAT 1' , 'FLOAT 2' , 'FLOAT 3' , 'FLOAT 4' , 'FLOAT 5' , ':2C' , ':2D' , ':2E' , ':2F' ,], ['F? 0' , 'F? 1' , 'F? 2' , 'F? 3' , 'F? 4' , 'F? 5' , 'FLOAT 6' , 'FLOAT 7' , 'FLOAT 8' , 'FLOAT 9' , 'FLOAT .' , ':3B' , ':3C' , ':3D' , ':3E' , ':3F' ,], ['GTO 0' , 'GTO 1' , 'GTO 2' , 'GTO 3' , 'GTO 4' , 'GTO 5' , 'GTO 6' , 'GTO 7' , 'GTO 8' , 'GTO 9' , 'GTO A' , 'GTO B' , 'GTO C' , 'GTO D' , 'GTO E' , 'GTO F' ,], ['GSB 0' , 'GSB 1' , 'GSB 2' , 'GSB 3' , 'GSB 4' , 'GSB 5' , 'GSB 6' , 'GSB 7' , 'GSB 8' , 'GSB 9' , 'GSB A' , 'GSB B' , 'GSB C' , 'GSB D' , 'GSB E' , 'GSB F' ,], ['RCL 0' , 'RCL 1' , 'RCL 2' , 'RCL 3' , 'RCL 4' , 'RCL 5' , 'RCL 6' , 'RCL 7' , 'RCL 8' , 'RCL 9' , 'RCL A' , 'RCL B' , 'RCL C' , 'RCL D' , 'RCL E' , 'RCL F' ,], ['RCL .0' , 'RCL .1' , 'RCL .2' , 'RCL .3' , 'RCL .4' , 'RCL .5' , 'RCL .6' , 'RCL .7' , 'RCL .8' , 'RCL .9' , 'RCL .A' , 'RCL .B' , 'RCL .C' , 'RCL .D' , 'RCL .E' , 'RCL .F' ,], ['STO 0' , 'STO 1' , 'STO 2' , 'STO 3' , 'STO 4' , 'STO 5' , 'STO 6' , 'STO 7' , 'STO 8' , 'STO 9' , 'STO A' , 'STO B' , 'STO C' , 'STO D' , 'STO E' , 'STO F' ,], ['STO .0' , 'STO .1' , 'STO .2' , 'STO .3' , 'STO .4' , 'STO .5' , 'STO .6' , 'STO .7' , 'STO .8' , 'STO .9' , 'STO .A' , 'STO .B' , 'STO .C' , 'STO .D' , 'STO .E' , 'STO .F' ,], [':A0' , 'DSZ' , 'ISZ' , 'SQRT x' , '1/x' , 'R-^' , 'LSTx' , '>' , '<' , 'x!=0' , 'PSE' , 'x=y' , 'x=0' , 'x>0' , 'DBL×' , 'DBL÷' ,], [':B0' , 'SHOW HEX' , 'SHOW DEC' , 'SHOW OCT' , 'SHOW BIN', 'RCL (i)' , 'RCL I' , 'GTO I' , 'WSIZE' , 'x<>(i)' , 'CLEAR REG', 'EEX' , 'OR' , 'NOT' , 'AND' , 'XOR' ,], ['Clx' , 'HEX' , 'DEC' , 'OCT' , 'BIN' , 'R-v' , 'ENTER' , 'GSB I' , 'R/S' , '.' , 'x<>y' , 'CHS' , '+' , '-' , '×' , '÷' ,], ['x!=y' , 'x<=y' , 'x<0' , 'x>y' , 'RTN' , 'STO (i)' , 'STO I' , '#B' , 'ABS' , 'DBLR' , 'LJ' , 'ASR' , 'RLC' , 'RRC' , 'RLCn' , 'RRCn' ,], ['x<>I' , "SET COMPL 1'S","SET COMPL 2'S", 'SET COMPL UNSGN', 'SB' , 'CB' , 'B?' , 'MASKL' , 'MASKR' , 'RMD' , 'SL' , 'SR' , 'RL' , 'RR' , 'RLn' , 'RRn' ,], ['0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' , '8' , '9' , 'A' , 'B' , 'C' , 'D' , 'E' , 'F' ,], );

my %encode;

for my $i (0 .. 15) { my $msd = $hex{$i}; for my $j (0 .. 15) { my $lsd = $hex{$j}; $encode{uc $code[$i][$j]} = "$msd$lsd"; } }

$encode{'SQRT'} = $encode{'SQRT x'}; $encode{'RDN'} = $encode{'R-V'}; $encode{'R DOWN'} = $encode{'R-V'}; $encode{'R UP'} = $encode{'R-^'}; $encode{"1'S"} = $encode{"SET COMPL 1'S"}; $encode{"2'S"} = $encode{"SET COMPL 2'S"}; $encode{'UNSGN'} = $encode{'SET COMPL UNSGN'}; $encode{'X#0'} = $encode{'X!=0'}; $encode{'X#Y'} = $encode{'X!=Y'};

my $clopt; if ($ARGV[0] && $ARGV[0] =~ /^-/) { $clopt = shift; }

if ($clopt && $clopt =~ /^-c/) {

my @bytes;

while (<>) { chomp; s|(?<!\w)/(?!\w)|÷|; s|(?<!\w)\*(?!\w)|×|; s|<->|<>|; push @bytes, $encode{uc $_}; }

my $idx = $#bytes; my $byte = $idx % 7 + 1; my $addr = 0xfc - int($idx / 7); my $xml = sprintf <<XML, $byte, $addr; <loc addr="0fd" data="00000000000000"/> <loc addr="0fe" data="00000000000%01d%02x"/> <loc addr="0ff" data="00000000000000"/> </memory> </state> XML

for my $addr (reverse (0xe0 .. 0xfc)) { my @data = splice @bytes, 0, 7; $#data = 6; $xml = sprintf(<<XML, $addr, join '', map { $_ || '00' } reverse @data) . $xml; <loc addr="%03x" data="%s"/> XML }

print <<XML; <?xml version="1.0" encoding="ISO-8859-1"?> <!DOCTYPE state SYSTEM "nonpareil.dtd"> <state version="1.00" model="16C" platform="voyager" arch="nut"> <ui/> <chip name="Nut"> <registers> <reg name="a" data="00000000000000"/> <reg name="b" data="f0000000000000"/> <reg name="c" data="eae00000000000"/> <reg name="m" data="00000000000000"/> <reg name="n" data="00000000000000"/> <reg name="g" data="02"/> <reg name="p" data="c"/> <reg name="q" data="3"/> <reg name="q_sel" data="0"/> <reg name="fo" data="00"/> <reg name="s" data="0800"/> <reg name="pc" data="0000"/> <reg name="stack" index="0" data="006b"/> <reg name="stack" index="1" data="0042"/> <reg name="stack" index="2" data="0000"/> <reg name="stack" index="3" data="0000"/> <reg name="decimal" data="0"/> <reg name="carry" data="0"/> <reg name="awake" data="0"/> <reg name="pf_addr" data="00"/> <reg name="ram_addr" data="007"/> <reg name="active_bank" index="0" data="0"/> <reg name="active_bank" index="1" data="0"/> <reg name="active_bank" index="2" data="0"/> <reg name="active_bank" index="3" data="0"/> <reg name="active_bank" index="4" data="0"/> <reg name="active_bank" index="5" data="0"/> <reg name="active_bank" index="6" data="0"/> <reg name="active_bank" index="7" data="0"/> <reg name="active_bank" index="8" data="0"/> <reg name="active_bank" index="9" data="0"/> <reg name="active_bank" index="a" data="0"/> <reg name="active_bank" index="b" data="0"/> <reg name="active_bank" index="c" data="0"/> <reg name="active_bank" index="d" data="0"/> <reg name="active_bank" index="e" data="0"/> <reg name="active_bank" index="f" data="0"/> </registers> </chip> <chip name="Voyager LCD"> <registers> <reg name="enable" data="1"/> <reg name="blink" data="0"/> </registers> </chip> <memory as="ram"> <loc addr="000" data="00000000000000"/> <loc addr="001" data="00000000000000"/> <loc addr="002" data="00000000000000"/> <loc addr="003" data="00000000000000"/> <loc addr="004" data="f0000000000000"/> <loc addr="005" data="f0000000000020"/> <loc addr="006" data="02cf0000000000"/> <loc addr="007" data="eae00000000000"/> <loc addr="008" data="00000000000000"/> <loc addr="009" data="00000000000000"/> <loc addr="00a" data="5c0080bc000000"/> $xml XML

} else {

my @nibs; my $addr; my $byte;

LINE: while (<>) { while (m|<loc addr="(\w+)" data="(\w+)"/>|g) { if ($1 eq '0fe') { ($byte, $addr) = $2 =~ /(\w)(\w\w)$/; last LINE; } unshift @nibs, reverse split //, $2; } }

# get rid of the data before addr 0fe splice @nibs, 0, 14;

# calculate where to end $#nibs = 2 * ((0xfc - hex $addr) * 7 + $byte) - 1;

my $line = 1;

while (@nibs) { my ($lsd, $msd) = map { $dec{$_} } (shift @nibs, shift @nibs); printf "%03d - $display[$msd][$lsd] $code[$msd][$lsd]\n", $line++; }

}

                  
Re: A compiler for HP-11C
Message #6 Posted by Egan Ford on 3 Mar 2008, 4:40 p.m.,
in response to message #5 by Thomas Klemm

Yes I forgot to ask for that, but a 12C version too. I figured the 12C and 16C would be easy.

Thanks.

                        
Re: A compiler for HP-11C
Message #7 Posted by Thomas Klemm on 3 Mar 2008, 5:03 p.m.,
in response to message #6 by Egan Ford

Quote:
I figured the 12C and 16C would be easy.

They are but the creation of the @display table takes a lot of time.
There might be a simpler way but currently I compile all 256 instructions
and check them in the display of the emulator.

I suppose the 15C won't be that difficult too.


[ Return to Index | Top of Index ]

Go back to the main exhibit hall