#drinc:exec/miscellaneous.g
#drinc:exec/memory.g
#drinc:libraries/dos.g
#drinc:util.g
#toy.g
#externs.g

/*
 * system.d: contains routines for Amiga-specific system interface.
 */

uint
    FILE_NAME_LENGTH_MAX = 256,
    CODE_BUFFER_SIZE = 512,
    RUN_TIME_VAR_SIZE = 256 + 5 * 4;

/* constants needed for AmigaDOS object file output */

ulong
    HUNK_CODE	 = 1001,
    HUNK_BSS	 = 1003,
    HUNK_RELOC32 = 1004,
    HUNK_END	 = 1010,
    HUNK_HEADER  = 1011;

type

    /* type for a linked lists of offsets within a hunk */

    OffsetList_t = struct {
	*OffsetList_t ol_next;
	uint ol_offset; 	/* offset in hunk where reference is */
    },

    /* type for a list of external reference sets from one hunk to others */

    Reference_t = struct {
	*Reference_t r_next;
	*OffsetList_t r_offsets;/* the list of references to this other */
	uint r_offsetCount;	/* how many references there are */
	uint r_whichHunk;	/* which hunk we are referencing */
    },

    /* type for all the information for an AmigaDOS code hunk */

    HunkList_t = struct {
	*HunkList_t hl_next;
	*byte hl_code;		/* the machine code of the hunk */
	uint hl_codeLength;	/* how long it is */
	*Reference_t hl_references;	/* its references to other hunks */
    };

Handle_t
    StandardOutput,		/* standard output handle for messages */
    SourceInput,		/* the input source file */
    CodeOutput; 		/* the output object-code file */

uint ErrorCount;		/* count of number of errors encountered */

[FILE_NAME_LENGTH_MAX] char InputFileName;

*HunkList_t HunkList;		/* list of hunks compiled so far */
*HunkList_t HunkCurrent;	/* the one for the current proc */
**HunkList_t HunkTail;		/* pointer to pointer to last hunk */
*HunkList_t MainCallHunk;	/* the hunk which calls main */
uint MainCallOffset;		/* offset in that hunk of the call */
uint HunkCount; 		/* count of hunks compiled so far */
uint CodeBufferPos;		/* current position in code buffer */
[CODE_BUFFER_SIZE]byte CodeBuffer;
bool MainDefined;		/* we have seen a 'main' */


/* SOME ERROR PRINTING ROUTINES */

/*
 * printString - print a null-terminated string.
 */

proc printString(*char st)void:
    register *char p;

    p := st;
    while p* ~= '\e' do
	p := p + sizeof(char);
    od;
    ignore Write(StandardOutput, st, p - st);
corp;

/*
 * printInt - print an integer.
 */

proc printInt(register int n)void:
    [7] char buffer;
    register *char p;
    bool isNegative;

    if n < 0 then
	n := -n;
	isNegative := true;
    else
	isNegative := false;
    fi;
    buffer[6] := '\e';
    p := &buffer[5];
    while
	p* := n % 10 + '0';
	n := n / 10;
	n ~= 0
    do
	p := p - sizeof(char);
    od;
    if isNegative then
	p := p - sizeof(char);
	p* := '-';
    fi;
    ignore Write(StandardOutput, p, &buffer[7] - p);
corp;

/*
 * errorPosition - print the position header for an error message.
 */

proc errorPosition(uint line, column)void:

    printString(&InputFileName[0]);
    printString("(");
    printInt(line);
    printString(",");
    printInt(column);
    printString(") - ");
    ErrorCount := ErrorCount + 1;
corp;

/* UTILITY SYSTEM INTERFACE ROUTINES */

/*
 * abort - something has gone wrong - print a message, close up, exit.
 */

proc abort(*char message)void:
    register *HunkList_t hl;
    register *Reference_t r;
    register *OffsetList_t ol;
    *HunkList_t hlTemp;
    *Reference_t rTemp;
    *OffsetList_t olTemp;

    printString(&InputFileName[0]);
    printString(": ");
    printString(message);
    printString(" - aborting\n");
    hl := HunkList;
    while hl ~= nil do
	if hl*.hl_code ~= nil then
	    memFree(hl*.hl_code, hl*.hl_codeLength);
	fi;
	r := hl*.hl_references;
	while r ~= nil do
	    ol := r*.r_offsets;
	    while ol ~= nil do
		olTemp := ol;
		ol := ol*.ol_next;
		memFree(olTemp, sizeof(OffsetList_t));
	    od;
	    rTemp := r;
	    r := r*.r_next;
	    memFree(rTemp, sizeof(Reference_t));
	od;
	hlTemp := hl;
	hl := hl*.hl_next;
	memFree(hlTemp, sizeof(HunkList_t));
    od;
    lexTerm();
    symbolTerm();
    Close(CodeOutput);
    Close(SourceInput);
    Exit(RETURN_FAIL);
corp;

/*
 * memAlloc - allocate some memory.
 */

proc memAlloc(ulong length)arbptr:
    arbptr p;

    p := AllocMem(length, 0);
    if p = nil then
	abort("cannot allocate memory");
    fi;
    p
corp;

/*
 * memFree - free some memory.
 */

proc memFree(arbptr p; ulong length)void:

    FreeMem(p, length);
corp;

/* SOURCE AND CODE INPUT/OUTPUT ROUTINES */

/*
 * readSource - read a bufferfull of data from the source file.
 */

proc readSource(*char buffer; ulong length)uint:

    Read(SourceInput, buffer, length * sizeof(char))
corp;

/*
 * codeStartProc - setup for a new proc.
 */

proc codeStartProc(*SymbolEntry_t se)void:
    register *HunkList_t hl;

    if se ~= nil then
	se*.se_value := HunkCount;
    fi;
    hl := memAlloc(sizeof(HunkList_t));
    hl*.hl_next := nil;
    hl*.hl_references := nil;
    hl*.hl_code := nil;
    HunkCurrent := hl;
    HunkTail* := hl;
    HunkTail := &hl*.hl_next;
corp;

/*
 * codeReference - the current proc is referencing another one or referencing
 *	the global variables.
 */

proc codeReference(RelocCode_t rc; *SymbolEntry_t se; uint offset)void:
    register *HunkList_t hl;
    register *Reference_t r;
    register *OffsetList_t ol;
    register uint hunkNumber;

    if rc = rc_main then
	MainCallHunk := HunkCurrent;
	MainCallOffset := offset;
    else
	hunkNumber :=
	    if rc = rc_globalVariable then
		/* reference a global variable */
		1
	    elif rc = rc_none then
		/* reference a user proc */
		se*.se_value
	    else
		/* reference a run-time procedure */
		rc - rc_printString + 2   /* 0 = startup, 1 = globals */
	    fi;
	hl := HunkCurrent;
	r := hl*.hl_references;
	while r ~= nil and r*.r_whichHunk ~= hunkNumber do
	    r := r*.r_next;
	od;
	if r = nil then
	    r := memAlloc(sizeof(Reference_t));
	    r*.r_next := hl*.hl_references;
	    r*.r_whichHunk := hunkNumber;
	    r*.r_offsets := nil;
	    r*.r_offsetCount := 0;
	    hl*.hl_references := r;
	fi;
	ol := memAlloc(sizeof(OffsetList_t));
	ol*.ol_next := r*.r_offsets;
	ol*.ol_offset := offset;
	r*.r_offsets := ol;
	r*.r_offsetCount := r*.r_offsetCount + 1;
    fi;
corp;

/*
 * codeEndProc - finish processing the current proc.
 */

proc codeEndProc(*SymbolEntry_t se; *byte codePtr; uint codeLength)void:

    HunkCurrent*.hl_code := memAlloc(codeLength);
    BlockCopy(HunkCurrent*.hl_code, codePtr, codeLength);
    HunkCurrent*.hl_codeLength := codeLength;
    if se ~= nil and CharsEqual(se*.se_name, "main") then
	if MainCallHunk = nil then
	    abort("conCheck - MainCallHunk = nil");
	fi;
	HunkCurrent := MainCallHunk;
	codeReference(rc_none, se, MainCallOffset);
	MainDefined := true;
    fi;
    HunkCount := HunkCount + 1;
corp;

/*
 * codeWrite - write the given amount to the code file.
 */

proc codeWrite(arbptr buffer; uint length)void:

    if Write(CodeOutput, buffer, length) ~= length then
	abort("error on write to output file");
    fi;
corp;

/*
 * codeFlush - flush the current contents of the code buffer.
 */

proc codeFlush()void:

    codeWrite(&CodeBuffer[0], CodeBufferPos);
    CodeBufferPos := 0;
corp;

/*
 * emitLong - emit a 4 byte value into the output code stream.
 */

proc emitLong(register ulong n)void:
    register *byte p;
    register uint i;

    if CodeBufferPos >= CODE_BUFFER_SIZE - 4 then
	codeFlush();
    fi;
    p := &CodeBuffer[CodeBufferPos];
    p* := n >> 24;
    p := p + 1;
    p* := n >> 16;
    p := p + 1;
    p* := n >> 8;
    p := p + 1;
    p* := n;
    CodeBufferPos := CodeBufferPos + 4;
corp;

/* TOP-LEVEL OF COMPILATION PROCESS */

/*
 * emitCode - emit the object code for the current input file.
 */

proc emitCode()void:
    register *HunkList_t hl;
    register *Reference_t r;
    register *OffsetList_t ol;
    *HunkList_t hlTemp;
    *Reference_t rTemp;
    *OffsetList_t olTemp;
    int globalSize;
    bool doneBss;

    if not MainDefined then
	errorHere("no 'main' defined");
    fi;
    globalSize := getGlobalSize();
    CodeBufferPos := 0;

    /* first, the header, which describes the hunks to follow */

    emitLong(HUNK_HEADER);
    emitLong(0);
    emitLong(HunkCount);
    emitLong(0);
    emitLong(HunkCount - 1);
    doneBss := false;
    hl := HunkList;
    while hl ~= nil do
	emitLong((hl*.hl_codeLength + 3) / 4);
	if not doneBss then
	    doneBss := true;
	    emitLong((globalSize + 3) / 4);
	fi;
	hl := hl*.hl_next;
    od;

    /* and then the hunks for the proc's. Each has the proc's code in a
       code hunk, followed by that proc's references to the global variables,
       the run-time routines, and other proc's, in a reloc32 hunk. */

    doneBss := false;
    hl := HunkList;
    while hl ~= nil do
	emitLong(HUNK_CODE);
	emitLong((hl*.hl_codeLength + 3) / 4);
	codeFlush();
	codeWrite(hl*.hl_code, (hl*.hl_codeLength + 3) / 4 * 4);
	memFree(hl*.hl_code, hl*.hl_codeLength);
	r := hl*.hl_references;
	if r ~= nil then
	    emitLong(HUNK_RELOC32);
	    while r ~= nil do
		emitLong(r*.r_offsetCount);
		emitLong(r*.r_whichHunk);
		ol := r*.r_offsets;
		while ol ~= nil do
		    emitLong(ol*.ol_offset);
		    olTemp := ol;
		    ol := ol*.ol_next;
		    memFree(olTemp, sizeof(OffsetList_t));
		od;
		rTemp := r;
		r := r*.r_next;
		memFree(rTemp, sizeof(Reference_t));
	    od;
	    emitLong(0);
	fi;
	hlTemp := hl;
	hl := hl*.hl_next;
	memFree(hlTemp, sizeof(HunkList_t));
	emitLong(HUNK_END);
	if not doneBss then
	    doneBss := true;
	    emitLong(HUNK_BSS);
	    emitLong((globalSize + 3) / 4);
	    emitLong(HUNK_END);
	fi;
    od;
    codeFlush();
corp;

/*
 * objectSetup - initialization for object code output.
 */

proc objectSetup()void:

    MainDefined := false;
    MainCallHunk := nil;
    HunkList := nil;
    HunkTail := &HunkList;
    HunkCount := 1;
    outputRunTime();
    setGlobalSize(RUN_TIME_VAR_SIZE);
corp;

/*
 * compileFile - all the motions to compile the current input file.
 */

proc compileFile()void:
    register TokenKind_t tk;

    objectSetup();

    ErrorCount := 0;
    symbolInit();
    lexInit();
    declareVariables(sk_globalVariable);
    while
	tk := getSimpleToken();
	tk ~= tk_eof
    do
	if tk = tk_proc then
	    defineProc();
	else
	    errorHere("expecting proc definition");
	    while tk ~= tk_proc and tk ~= tk_eof do
		skipToken();
		tk := getSimpleToken();
	    od;
	fi;
    od;
    lexTerm();
    symbolTerm();

    emitCode();
corp;

/*
 * main - the whole thing starts here.
 */

proc main()void:
    extern _d_pars_initialize()void;
    register uint totalErrorCount;
    register *char parameter, p, q;
    bool doneOne;

    if OpenExecLibrary(0) ~= nil then
	if OpenDosLibrary(0) ~= nil then
	    _d_pars_initialize();
	    StandardOutput := Output();
	    printString(
		"Toy compiler version 1.0, Copyright 1988 by Chris Gray\n");
	    doneOne := false;
	    while
		parameter := GetPar();
		parameter ~= nil
	    do
		doneOne := true;
		p := parameter;
		while p* ~= '\e' do
		    p := p + sizeof(char);
		od;
		q := p;
		while p ~= parameter and p* ~= '.' do
		    p := p - sizeof(char);
		od;
		if p = parameter then
		    p := q;
		fi;
		q := &InputFileName[0];
		while parameter ~= p do
		    q* := parameter*;
		    q := q + sizeof(char);
		    parameter := parameter + sizeof(char);
		od;
		q* := '.';
		(q + sizeof(char))* := 't';
		(q + 2 * sizeof(char))* := '\e';
		SourceInput := Open(&InputFileName[0], MODE_OLDFILE);
		if SourceInput = 0 then
		    printString(&InputFileName[0]);
		    printString(": can't open input file\n");
		else
		    q* := '\e';
		    DeleteFile(&InputFileName[0]);
		    CodeOutput := Open(&InputFileName[0], MODE_NEWFILE);
		    if CodeOutput = 0 then
			printString(&InputFileName[0]);
			printString(": can't create output file\n");
		    else
			q* := '.';
			printString(&InputFileName[0]);
			printString(":\n");
			compileFile();
			Close(CodeOutput);
			if ErrorCount ~= 0 then
			    q* := '\e';
			    DeleteFile(&InputFileName[0]);
			    printInt(ErrorCount);
			    printString(" errors - output file '");
			    printString(&InputFileName[0]);
			    printString("' deleted.\n");
			    totalErrorCount := totalErrorCount + ErrorCount;
			fi;
		    fi;
		    Close(SourceInput);
		fi;
	    od;
	    if not doneOne then
		printString("Use is: toyc file[.t]\n");
		Exit(RETURN_WARN);
	    else
		Exit(
		    if totalErrorCount = 0 then
			RETURN_OK
		    else
			RETURN_ERROR
		    fi);
	    fi;
	fi;
	CloseExecLibrary();
    fi;
corp;