(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
program lsymgen;

const OutfileSuffix = '.lsym';

{$I 'platfile-types+.pas'}

var
    outfile:TextFile;
    infile:TextFile;
    lineno:integer;

procedure errorExit2(reason:string;arg:string); forward;

{$I 'platfile+.pas'}

procedure errorExit2(reason:string;arg:string);
begin
	writeln;
	writeln('Error: ', reason, ' ', arg);
	writeln('at ', lineno);
	halt;
end;

function rpos(c:char; var s:string):integer;
var i:integer;
begin
	for i := length(s) downto 1 do
		if s[i] = '.' then break;
	if i = 1 then
		rpos := 0
	else
		rpos := i;
end;

function strcontains(var s:string; c:char):boolean;
begin
	strcontains := pos(c, s) > 0;
end;

function getOutfileName(infileName:string):string;
var p:integer;
begin
	p := rpos('.', infileName);
	if p > 1 then
		getOutfileName := copy(infileName, 1, p - 1)
	else
		getOutfileName := infileName;

	getOutfileName := getOutfileName + OutfileSuffix;
end;

procedure splitLine(var line:string; var addr:string; var name:string;
		var clean:boolean);
var n,l:integer;
begin
	n := pos(' ', line);

	if n <= 1 then
		errorExit2('invalid syntax:', line);

	addr := copy(line, 1, n - 1);

	l := length(line);
	while (n < l) and (line[n] = ' ') do
		n := n + 1;

	name := copy(line, n, l - n + 1);


	(* symbols starting with '!' are explicitly exported *)
	if name[1] = '!' then
	begin
		clean := true;
		name := copy(name, 2, length(name) - 1);
	end
	else
		clean := (not strcontains( name, '_')) and (name[1] <> '=');
end;

procedure processFile(inpath,outpath:string);
var line:string;
    addr,name:string;
    clean:boolean;
begin
	lineno := 0;
	writeln('writing file ', outpath);

	openTextFile(infile, inpath);

	overwriteTextFile(outfile, outpath);

	while not eof(infile) do
	begin
		readln(infile, line);
		splitLine(line, addr, name, clean);
		if clean then
			writeln(outfile, #9, '.EQU ', name, ' $', addr);
	end;
	close(infile);
	close(outfile);
end;

begin
	if ParamCount > 0 then
	begin
		processFile(ParamStr(1), getOutfileName(ParamStr(1)));
	end
	else
		writeln('No file name given.');
end.
