Macro preprocessor for the LC3 CLI toolkit, as specified in http://people.cs.georgetown.edu/~squier/Teaching/HardwareFundamentals/LC3-trunk/docs/README-LC3tools.html

lc3pp.pl

#!/usr/bin/perl -w
#perl2exe_include strict
#perl2exe_include warnings
use strict;
use warnings;
#use feature "switch";
use Env qw($MAX_RECURSION_DEPTH $AUTOCOMPILE);
use Data::Dumper;

my %words = (
	# Files
	include => ".include",
	# Macros
	macro => ".macro",
	endm => ".endm",
	definition => ".define",
	undefine => ".undef",
	# Counters
	counter => ".set",
	increment => ".incr",
	decrement => ".decr",
);
my $max_recursion	= $MAX_RECURSION_DEPTH || 100;
my $autocompile		= $AUTOCOMPILE || 0;

my $cmacro;
my $out;
my $recursion;
my %defines;
my %macros;
my %counters;
my %seen;

sub trimmed {
	my $word = shift;
	$word =~ s/^\s+|\s+$//g;
	return $word;
}

sub expline {
	my $line = shift;
	my @tokens = split /\s+/, trimmed $line;
	if($#tokens < 0) {
		print $out $line;
		return;
	}
	my $word = shift @tokens;
	my %immsubs = (
		$words{include} => sub {
			process(shift @tokens) or die "$words{include} missing a name";
		},
		$words{macro} => sub {
			die "Can't define a macro within a macro" if $cmacro;
			$cmacro = '@' . shift @tokens or die "$words{macro} missing a name";
			$macros{$cmacro} = [];
		},
		$words{endm} => sub {
			die "Can't end a macro outside a macro" unless $cmacro;
			$cmacro = 0;
		},
		$words{undefine} => sub {
			my $token = shift @tokens or die "$words{undefine} missing a name";
			if($token =~ /^@/) {
				die "Attempting to undefine nonexistent macro $token" unless exists $macros{$token};
				delete $macros{$token};
			}
			elsif($token =~ /^&&/) {
				$token =~ s/^&&//;
				die "Attempting to undefine nonexistent counter $token" unless exists $counters{$token};
				delete $counters{$token};
			}
			else {
				die "Attempting to undefine nonexistent define'd $token" unless exists $defines{$token};
				delete $defines{$token};
			}
		}
	);
	my %defsubs = (
		$words{definition} => sub {
			my $name = shift @tokens or die "$words{definition} missing a name";
			$defines{$name} = join ' ', @tokens;
		},
		$words{counter} => sub {
			my $name = shift @tokens or die "$words{counter} missing a name";
			#warn "Counter $name defined already" if exists $counters{$name};
			$counters{$name} = (scalar @tokens) && (shift @tokens);
		},
		$words{increment} => sub {
			my $name = shift @tokens or die "$words{decrement} missing a name";
			die "Counter $name doesn't exist" unless exists $counters{$name};
			if(scalar @tokens) {
				$counters{$name} += shift @tokens;
			}
			else {
				  $counters{$name}++;
			}
		},
		$words{decrement} => sub {
			my $name = shift @tokens or die "$words{decrement} missing a name";
			die "Counter $name doesn't exist" unless exists $counters{$name};
			if(scalar @tokens) {
				$counters{$name} -= shift @tokens;
			}
			else {
				  $counters{$name}--;
			}
		}
	);
	if(exists $immsubs{$word}) {
		$immsubs{$word}();
	}
	elsif(not $cmacro and exists $defsubs{$word}) {
		$defsubs{$word}();
	}
	else {
		unshift @tokens, $word;
		if($cmacro) {
			push @{$macros{$cmacro}}, $line;
		}
		else {
			my $prefix = '';
			my $or = $recursion;
			for(;;) {
				my $rc = 0;
				$rc += ($line =~ s/&&(\w+)\b/$counters{$1}/eg);
				$rc += ($line =~ s/\b$_\b/$defines{$_}/g) for keys %defines;
				last if not $rc;
				$recursion += $rc;
				die "Recursion depth $max_recursion exceeded" if $recursion > $max_recursion;
			}
			$recursion = $or;
			$recursion++;
			for my $pos (0..$#tokens) {
				$word = $tokens[$pos];
				if($cmacro ne $word and
						exists $macros{$word}) {
					for my $ln (0..$#{$macros{$word}}) {
						my $exp = $macros{$word}[$ln];
						for my $i (1..$#tokens-$pos) {
							$tokens[$i+$pos] =~ s/,$//;
							$exp =~ s/&$i/$tokens[$i+$pos]/g;
						}
						expline(($ln ? '' : $prefix) . $exp);
					}
					return;
				}
				$prefix .= "$word ";
			}
			$recursion--;
			print $out $line;
		}
	}
}

sub process {
	my $fin = shift;
	die "Include loop detected ", join(", ", keys %seen) if (exists $seen{$fin});
	$seen{$fin} = undef;
	my $in;
	if($fin eq "-") {
		$in = *STDIN;
	}
	else {
		open($in, "<", $fin) or die "Can't open $fin for reading $!";
	}
	while(my $line = <$in>) {
		expline($line);
	}
	close $in;
	delete $seen{$fin};
}

unshift(@ARGV, "-") unless @ARGV;

for my $fname (@ARGV) {
	my $toread = $fname;
	$fname =~ s/\.[^.]+$//;
	
	if($fname eq "-") {
		$out = *STDOUT;
	}
	else {
		open($out, ">", "$fname.s") or die "Can't open $fname for writing $!";
	}
	$cmacro = 0;
	%seen = ();
	%defines = ();
	%macros = ();
	%counters = ();
	process($toread);
	#print Data::Dumper->new([\%defines, \%macros, \%counters], ['*defines', '*macros', '*counters'])->Dump;
	die "Dangling macro $cmacro at EOF" if $cmacro;
	close $out;
	if($autocompile) {
		print "Compiling '$fname.s'\n";
		system("lc3as", "$fname.s") == 0 or die "lc3as failed $!";
	}
}

mult.asm

.define	rsp	r6
.macro	push
.incr	fsp
	str	&1, rsp, #&&fsp
.endm
.macro	pop
	ldr	&1, rsp, #&&fsp
.decr	fsp
.endm
.macro	neg
	not	&1, &1
	add	&1, &1, x1
.endm
.macro	seti
	and	&1, &1, x0
	add	&1, &1, &2
.endm


.orig	x3000
	ld	r0, big
	jsr	putd
	ld	r0, nl
	out
	ld	r0, smol
	jsr	putd
	ld	r0, nl
	out
	lea	r0, str0
	puts
	jsr	getd
	st	r0, tmp
	lea	r0, str1
	puts
	jsr	getd
	add	r1, r0, x0
	ld	r0, tmp
	jsr	putd
	; mult
	lea	r0, str2
	puts
	add	r0, r1, x0
	jsr	putd
	lea	r0, str4
	puts
	ld	r0, tmp
	jsr	mult
	jsr	putd
	lea	r0, str6
	puts
	; div
	ld	r0, tmp
	jsr	putd
	lea	r0, str3
	puts
	add	r0, r1, x0
	jsr	putd
	lea	r0, str4
	puts
	ld	r0, tmp
	jsr	div
	st	r0, tmp
	add	r0, r1, x0
	jsr	putd
	lea	r0, str5
	puts
	ld	r0, tmp
	jsr	putd
	lea	r0, str6
	puts
	
	halt
str0:	.stringz	"First number: "
str1:	.stringz	"Second number: "
str2:	.stringz	" times "
str3:	.stringz	" divided by "
str4:	.stringz	" is "
str5:	.stringz	", remainder "
str6:	.stringz	".\n"
tmp:	.fill		x0
big:	.fill		x7fff
smol:	.fill		x8000
nl:	.fill		x0a

; Computes r0' = r0 % r1, r1' = r0 / r1.
div:	
	; Save state
	st	rsp, DD0
	@push	r2
	@push	r3
	@push	r4
	@push	r7
	; Ensure r0 negative
	and	r2, r2, x0	; r2 = quotient signbit
	and	r3, r3, x0	; r3 = remainder signbit
	; If negative r0, cope
	add	r0, r0, x0
	brn	D0
	@neg	r0
	not	r3, r3
	not	r2, r2
	; Ensure r1 positive
D0:	add	r1, r1, x0
	brz	DE
	brp	D1
	@neg	r1
	not	r2, r2
	; Prepare right-shifts
D1:	add	r0, r0, x-1
	st	r2, DD1
	st	r3, DD2
	lea	r2, DD4		; r2 = rightshift stack pointer
	@neg	r2
	st	r2, DD3
	lea	r2, DD4
	and	r3, r3, x0	; r3 = mask
	add	r3, r3, x1
D2:	; Push onto stack
	str	r1, r2, x0
	str	r3, r2, x1
	add	r2, r2, x2
	;
	add	r3, r3, r3	; left shift
	add	r1, r1, r1	; "
	brnz	D3		; move on on overflow
	add	r7, r1, r0	; r7 = trash
	brn	D2		; if r1 < -r0 keep moving up
D3:
	and	r1, r1, x0
	; Check if done
D4:	ld	r7, DD3
	add	r7, r2, r7
	brnz	D5
	; Pop rightshift
	add	r2, r2, x-2
	ldr	r4, r2, x0	; r4 = tested
	ldr	r3, r2, x1	; r3 = mask
	add	r7, r0, r4
	; If nonnegative
	brzp	D4
	add	r0, r7, x0	; Commit subtraction
	add	r1, r1, r3	; Apply mask
	br	D4
	; Put signs back
D5:	add	r0, r0, x0
	ld	r7, DD1
	brnp	D6
	@neg	r1
D6:	add	r0, r0, x1
	ld	r7, DD2
	brz	D7
	@neg	r0
	; Restore state
D7:	@pop	r7
	@pop	r4
	@pop	r3
	@pop	r2
	ld	rsp, DD0
	ret
	; Divide-by-0 handling
DE:	lea	r0, DD5
	puts
	halt
DD0:	.blkw		x5	; save state
DD1:	.fill		x0	; div sign
DD2:	.fill		x0	; mod sign
DD3:	.fill		x0	; -DD4
DD4:	.blkw		x20	; rightshift stack
DD5:	.stringz	"Divide by zero, halting."

; Outputs r0 as a base-10 signed int to stdout.
putd:
	st	rsp, PD0
	@push	r7
	@push	r2
	@push	r1
	@push	r0
	lea	r2, PD4		; string pointer
	add	r0, r0, x0
	brzp	P0
	@neg	r0
	brn	P3
	add	r1, r0, x0
	ld	r0, PD3
	out
	add	r0, r1, x0
P0:	ld	r1, PD1
	jsr	div
	ld	r7, PD2
	add	r7, r7, r0
	add	r2, r2, x-1
	str	r7, r2, x0
	add	r0, r1, x0
	brnp	P0
P1:	
	;and	r7, r7, x0
	;str	r7, r2, x0
	add	r0, r2, x0
P2:	puts
	@pop	r0
	@pop	r1
	@pop	r2
	@pop	r7
	ld	rsp, PD0
	ret
P3:	lea	r0, PD5
	br	P2
PD0:	.blkw		x5	; save state
PD1:	.fill		x0a	; base 10
PD2:	.fill		x30	; zero offset
PD3:	.fill		x2d	; negative sign
	.blkw		x7
PD4:	.fill		x0	; digit list
PD5:	.stringz	"-32768"

; Puts r0 * r1 into r0.
mult:
	; Save state
	st	rsp, MD0
	@push	r1
	@push	r2
	@push	r3
	@push	r4
	; Save signage
	and	r3, r3, x0	; r3 = signage
	add	r0, r0, x0
	brzp	M0
	not	r3, r3
	@neg	r0
M0:	add	r1, r1, x0
	brzp	M1
	not	r3, r3
	@neg	r1
	; Initialize counter
M1:	st	r3, MD1
	and	r2, r2, x0	; r2 = output
	and	r3, r3, x0
	add	r3, r3, x1	; r3 = mask
	; Mainloop
M2:	and	r4, r3, r0	; r4 = discard
	brz	M3
	add	r2, r2, r1
M3:	add	r1, r1, r1
	add	r3, r3, r3
	brnp	M2
	; Restore state
	add	r0, r2, x0
	ld	r3, MD1
	brz	M4
	@neg	r0
M4:	@pop	r4
	@pop	r3
	@pop	r2
	@pop	r1
	ld	rsp, MD0
	ret
MD0:	.fill		x4	; save state
MD1:	.fill		x0	; signed?

; Puts whether r0 is a ws char in r0. Also sets POSITIVE/ZERO for convenience.
is_ws:	st	rsp, ID0
	@push	r7
	@push	r1
	lea	r1, ID1
I0:	ldr	r7, r1, x0
	brz	I1
	add	r1, r1, x1
	@neg	r7
	add	r7, r0, r7
	brnp	I0
	and	r0, r0, x0
	add	r0, r0, x1
	br	I2
I1:	add	r0, r7, x0
I2:	@pop	r1
	@pop	r7
	ld	rsp, ID0
	add	r0, r0, x0
	ret
ID0:	.blkw		x3	; save state
ID1:	.stringz	" \t\n"

; Parses stdin as a base-10 signed int to r0, stopping at the first invalid char.
getd:	st	rsp, GD0
	@push	r7
	@push	r1
G0:	getc
	out
	add	r1, r0, x0
	jsr	is_ws
	brp	G0
	add	r0, r1, x0
	and	r1, r1, x0
.macro	cmpj
	ld	r7, &2
	add	r7, &1, r7
	brz	&3
.endm
	@cmpj	r0, GD2, G1
	@cmpj	r0, GD3, G2
.undef	@cmpj
	br	G3
G1:	not	r1, r1
G2:	add	r1, r1, x0
	getc
	out
G3:	st	r1, GD6
	and	r2, r2, x0
	add	r2, r2, x-6
	and	r1, r1, x0
	; end-of-parse check
G4:	st	r0, GD7
	jsr	is_ws
	brp	G5
	Ld	r0, GD7
	; bounds check
	ld	r7, GD4
	add	r0, r0, r7
	brzp	GE0
	ld	r7, GD5
	add	r0, r0, r7
	brn	GE0
	; ...and add
x:	st	r0, GD7
	ld	r0, GD1
	jsr	mult
	ld	r7, GD7
	add	r1, r0, r7
	getc
	out
	br	G4
G5:	ld	r0, GD6
	brz	G6
	@neg	r1
G6:	add	r0, r1, x0
	@pop	r1
	@pop	r7
	ld	rsp, GD0
	ret
GE0:	lea	r0, GD8
	puts
	halt
GD0:	.blkw		x3	; save state
GD1:	.fill		x0a	; base-10
GD2:	.fill		x-2d	; minus sign
GD3:	.fill		x-2b	; plus sign
GD4:	.fill		x-3a	; upper cap
GD5:	.fill		x0a	; lower cap adjust
GD6:	.fill		x0	; signage
GD7:	.fill		x0	; temp store
GD8:	.stringz	"\nRead illegal digit, halting."
	
.end