#!/usr/bin/perl -w

# Creates aux/asm.src from bytecode and register lists
# usage:
# mkasm aux/asm.src

# Copyright (c) 2008, 2023 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

use strict;

use Cwd 'cwd';
use File::Spec::Functions qw(catfile);

use vars qw($VERSION $PERVERSION);
($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base aux/mkasm 1.-94.-2.4") =~ /\s(\S+)$/;

# we do not want to depend on any generated modules when making compilers
require (catfile(cwd(), qw(INTERCAL Generate.pm)));

{
    no warnings;
    $Language::INTERCAL::Generate::verbose = 0;
}

die "Usage: mkasm file\n" if @ARGV != 1;

my ($file) = @ARGV;
open(STDOUT, "> $file") or die "$file: $!\n";

{
    my @dv = ('@@DATA ByteCode@@', '@@VERSION@@');
    my ($dv) = Language::INTERCAL::Generate::Convert(@dv);
    print "!\n!PLEASE NOTE: DATA VERSION: $dv\n";
}

my @getbytecode = (
    '@@DATA ByteCode@@',
    '@@ALL OPCODES NUMBER@@ @@NAME@@',
);

my %bc_number = ();
for my $bc (Language::INTERCAL::Generate::Convert(@getbytecode)) {
    $bc =~ /^\s*(\d+)\s+(\S+)\s*$/ or next;
    my ($number, $name) = ($1, $2);
    $bc_number{$name} = $number;
}

my @getregisters = (
    '@@DATA ByteCode@@',
    '% @@ALL DOUBLE_OH_SEVEN NUMBER@@ @@NAME@@ DOS',
    '@ @@ALL WHIRLPOOL NUMBER@@ @@NAME@@ WHP',
    '^ @@ALL SHARK_FIN NUMBER@@ @@NAME@@ SHF',
);

my $last = '';
for my $rp (Language::INTERCAL::Generate::Convert(@getregisters)) {
    $rp =~ /^\s*(\S)\s+\d+\s+(\S+)\s+(\S+)\s*$/ or next;
    my ($name, $reg, $code) = ($1, $2, $3);
    my $op = $bc_number{$code};
    if ($last ne $name) {
	print "!\n",
	      "!PLEASE NOTE: NAMES OF \"$name\" REGISTERS\n",
	      "SPECIAL_REGISTER \"$name\" REG$op=* : REG$op\n",
	      "REG$op CONSTANT : \"$code\" CONSTANT\n";
	$last = $name;
    }
    print "REG$op \"$reg\"=2 : \"$name$reg\"\n";
}

print "!\n!PLEASE NOTE: \"BYTECODE\" INSTRUCTION NAMES\n";
for my $bc (sort keys %bc_number) {
    print "BYTECODE \"$bc\"=1 : \"$bc\"\n";
}

print "!\n!PLEASE NOTE: \"BYTECODE\" COMPATIBILITY WITH OLD SOURCES\n";
print "BYTECODE \"ENS\"=1 : \"MKB\"\n";
print "BYTECODE \"FRE\"=1 : \"NLB\"\n";
print "BYTECODE \"OWN\"=1 : \"BLM\"\n";

