#!/usr/bin/perl
# 2013-09-03 Johann E. Klasek, johann AT klasek at
#
# Untokenize a HypraAss tokenized Sourcecode from CBM PRG file
# and print it in ASCII to STDOUT.
#
# hacat -n [-] | FILE [FILE ...]
#
# -n no linenumbers
#
# Notes:
# The first line contains a comment with filename and starting address which
# is compatible with petcat's output of the OpenCBM project.
#
# Revisions:
# 2013-09-06 JK
# First version.
# 2013-09-12 JK
# Input handling made more general.
#
### SETUP
#BEGIN {
# (my $base = $0 ) =~ s|/[^/]*$||;
# # find include parts in directory of the main program
# unshift @INC, $base;
#
#};
## token table (generated)
#require "token.pl";
my $b;
#print "DEBUG: ARGV0=($ARGV[0])\n";
if ($ARGV[0] eq "-n") { shift @ARGV; $fnolinenumber = 1; }
### READ BYTE
sub getb {
my $c;
return ord($c) if sysread(ARGV,$c,1) == 1;
return undef;
}
### PARAMETER PROCESSING
unshift @ARGV, "-" if ! @ARGV;
### MAIN
while(my $file = shift @ARGV) {
open(ARGV,"<$file");
# load address is alway little endian!
my $addrlo = getb();
#printf("%02X ", $addrlo);
my $addrhi = getb();
#printf("%02X ", $addrhi);
my $addr = ($addrhi << 8) + $addrlo;
printf ";<%s> ==%04X==\n", ($file eq "-" ? "stdin" : $file), $addr;
my $instr = 0;
while (defined ($b = getb())) {
#printf("%02X ", $b);
# get link
$link = ($b << 8) + getb();
#printf "", $link;
last if ($link == 0);
# get linenumber
$line = getb() + (getb() << 8) ;
$out = sprintf "%d ", $line;
# get codeline
while (defined ($b = getb()) && $b != 0) {
#printf("%02X ", $b);
# Double quote: into/out of a strin ...
if ($b == 0x22) { $instr ^= 1; $out .= chr($b); next; }
if (! $instr) {
# not inside string
if ($b == 0xff) {
# function token
$b = getb();
#$tname = $fun_token{$b};
$out .= ($tname eq "" ? "" : $tname);
next;
}
elsif ($b >= 0x80) {
# command token
#$tname = $cmd_token{$b};
$out .= ($tname eq "" ? "" : $tname);
next;
}
}
# no token or inside string
$out .= chr($b);
#printf("%02X ", $b);
}
# get EOL
if ($b == 0) {
# EOL
# reformat output
($line,$label,$statement,$ops,$comment) = ($out =~ m{^(\d+)\s([a-z]\S*)?\s+(\S\S\S)([^;]*)\s*(;.*)?$}i);
if (defined $statement) {
printf "%5d ", $line if !$fnolinenumber;
printf "%-8s %3s %-14s%s\n", $label, $statement, $ops, $comment;
}
else {
($line,$remainder) = ($out =~ m{^(\d+)\s(.*)$});
printf "%5d ", $line if !$fnolinenumber;
printf "%s\n", $remainder;
}
$out="";
next;
}
}
}