/*
 *	File:					GenerateOberonSource.c
 *	Description:	
 *
 *	(C) 1995, Ketil Hunn
 *
 */

#ifndef GENERATOBERONCSOURCE_C
#define GENERATOBERONCSOURCE_C

/*** PRIVATE INCLUDES ****************************************************************/
#include "System.h"
#include "GenerateOberonSource.h"
#include "GenerateCSource.h"
#include "GenerateModula2Source.h"
#include "TASK_Code.h"

/*** FUNCTIONS ***********************************************************************/
void GenerateOberonSource(struct List *list, UBYTE *filename)
{
	BPTR fp;
	register struct Node *node;
	UBYTE module[109];

#ifdef MYDEBUG_H
	DebugOut("GenerateOberonSource");
#endif

	if(fp=Open(filename, MODE_NEWFILE))
	{
		/*** Get modulename *************************************************************/
		{
			register char *c;

			strcpy(module, FilePart(filename));
			if(c=strstr(Upper(module), ".MOD"))
				*c='\0';
		}

		/*** Intro **********************************************************************/
		{
			register UBYTE	intro1[]=	"(* Source machine generated by the ARexx Interface Designer for EasyRexx\n"
																"** which is (c) 1994, 1995 to Ketil Hunn\n"
																"*)\n\n"
																"MODULE ",
											intro2[]=	";\n\n"
																"IMPORT\n"
																"  ER  : EasyRexx,\n"
																"  E   : Exec,\n"
																"  R   : Rexx,\n"
																"  U   : Utility,\n"
																"  I   : Intuition,\n"
																"  sys : SYSTEM;\n\n";

			Write(fp, intro1, strlen(intro1));
			Write(fp, module, strlen(module));
			Write(fp, intro2, strlen(intro2));
		}

		/*** Defines ********************************************************************/
		{
			register ULONG	i=0;
			register UBYTE	start[]	=	"CONST\n",
											define[MAXNAMELEN+100];

			Write(fp, start, strlen(start));
			for(every_node)
			{
				sprintf(define, "  AREXX%s=%ld;\n", node->ln_Name, ++i);
				Write(fp, define, strlen(define));
			}
			Write(fp, "\n", 1);
		}

		/*** MyReturn structure *********************************************************/
		{
			register UBYTE retvals[]=	"VAR\n"
																"  table : ARRAY %ld OF ER.ARexxCommandTable;\n",
											string[100];
			sprintf(string, retvals, Count(list)+1);
			Write(fp, string, strlen(string));

			if(code.handle==HANDLE_FUNCS)
			{
				register UBYTE retvals[]=	"  ARexxRetValues :\n"
																	"    RECORD\n"
																	"      result,\n"
																	"      resultLong   :LONGINT;\n"
																	"      resultString,\n"
																	"      error        :UNTRACED POINTER TO CHAR;\n"
																	"    END;\n"
																	"  Func = PROCEDURE (c : ER.ARexxContextPtr) : INTEGER;\n\n"
																	"VAR myreturn : ARexxRetValues;\n\n\n";
				Write(fp, retvals, strlen(retvals));
			}
			else
				Write(fp, "\n", 1);
		}
		
		/*** Function templates *********************************************************/
		if(code.handle==HANDLE_FUNCS && code.templates)
		{
			for(every_node)
			{
				register UBYTE	template[MAXNAMELEN+200];
				register BYTE quit=(Stricmp(node->ln_Name, "QUIT")==0);

				sprintf(template, "PROCEDURE arexxfunc%s(c:EasyRexx.ARexxContext):INTEGER;\n"
													"BEGIN\n"
													"  (* insert own code here *)\n"
													"  RETURN %s\n"
													"END;\n\n",
													node->ln_Name,
													quit ? "1; (* Quit *)":"0;");
				Write(fp, template, strlen(template));
			}
		}

		/*** Code handler ***************************************************************/
		if(code.arexxhandler)
			switch(code.handle)
			{
				case HANDLE_IDS:
					{
						register UBYTE	start[]="PROCEDURE myHandleARexx(c : ER.ARexxContextPtr) : INTEGER;\n\n"
																		"VAR\n"
																		"  done          : INTEGER;\n"
																		"  errorTag,\n"
																		"  stringTag,\n"
																		"  longTag       : U.TagID;\n"
																		"  result,\n"
																		"  resultLong    : LONGINT;\n"
																		"  resultString,\n"
																		"  error         : E.STRPTR;\n\n"
																		"BEGIN\n"
																		"  done            := 0;\n"
																		"  result          := R.ok;\n"
																		"  resultString    := NIL;\n"
																		"  error           := NIL;\n"
																		"  resultLong      := MAX(LONGINT);\n\n"
																		"  IF ER.GetARexxMsg(c) THEN\n"
																		"    CASE c.id OF\n",
														case1[]="       AREXX%s	: (* insert own code here *)\n",
														case2[]="      |AREXX%s	: (* insert own code here *)\n",
													donestr[]="             	   done:=1;\n",
														end[]=	"    END;\n"
																		"    IF error # NIL THEN\n"
																		"      errorTag:=ER.ErrorMessage;\n"
																		"    ELSE\n"
																		"      errorTag:=U.ignore;\n"
																		"    END;\n"
																		"    IF resultString # NIL THEN\n"
																		"      stringTag:=ER.ResultString;\n"
																		"    ELSE\n"
																		"      stringTag:=U.ignore;\n"
																		"    END;\n"
																		"    IF resultLong # MAX(LONGINT) THEN\n"
																		"      longTag:=ER.ResultLong;\n"
																		"    ELSE\n"
																		"      longTag:=U.ignore;\n"
																		"    END;\n"
																		"    ER.ReplyARexxMsg(c,ER.ReturnCode, result,\n"
																		"                       errorTag,      error,\n"
																		"                       stringTag,     resultString,\n"
																		"                       longTag,       resultLong,\n"
																		"                       U.done);\n"
																		"  END;\n"
																		"  RETURN done;\n"
																		"END myHandleARexx;\n\n";

						Write(fp, start, strlen(start));
						for(every_node)
						{
							register UBYTE	command[MAXNAMELEN+100],
															done=(0==Stricmp(node->ln_Name, "QUIT"));

							if(node==list->lh_Head)
								sprintf(command,	case1, node->ln_Name);
							else
								sprintf(command,	case2, node->ln_Name);
							Write(fp, command, strlen(command));
							if(done)
								Write(fp, donestr, strlen(donestr));
						}
						Write(fp, end, strlen(end));
					}
					break;

				case HANDLE_FUNCS:
					{
						UBYTE funchandler[]="PROCEDURE myHandleARexx(c:EasyRexx.ARexxContext):INTEGER;\n"
																"VAR done       :INTEGER;\n"
																"    i          :INTEGER;\n"
																"    func       :Func;\n"
																"    idfound    :BOOLEAN;\n"
																"    errorTag,\n"
																"    stringTag,\n"
																"    longTag    : U.TagID;\n"
																"    res        : SHORTINT;\n"
																"BEGIN\n"
																"  done                  := 0;\n"
																"  idfound               := FALSE;\n"
																"  myreturn.result       := R.ok;\n"
																"  myreturn.resultString := NIL;\n"
																"  myreturn.error        := NIL;\n"
																"  myreturn.resultLong   := MAX(LONGINT);\n\n"
																"  WHILE (c.table[i].command # NIL) AND ~idfound DO\n"
																"    IF c.table[i].id = c.id THEN\n"
																"      func:=sys.VAL(Func,c.table[i].userData);\n"
																"      IF func # NIL THEN\n"
																"        res:=func(c);\n"
																"        done:=LONG(LONG(res));\n"
																"        idfound:=TRUE;\n"
																"      END;\n"
																"    ELSE\n"
																"      INC(i);\n"
																"    END;\n"
																"    IF error # NIL THEN\n"
																"      errorTag:=ER.ErrorMessage;\n"
																"    ELSE\n"
																"      errorTag:=U.ignore;\n"
																"    END;\n"
																"    IF myreturn.resultString # NIL THEN\n"
																"      stringTag:=ER.ResultString;\n"
																"    ELSE\n"
																"      stringTag:=U.ignore;\n"
																"    END;\n"
																"    IF myreturn.resultLong # MAX(LONGINT) THEN\n"
																"      longTag:=ER.ResultLong;\n"
																"    ELSE\n"
																"      longTag:=U.ignore;\n"
																"    END;\n"
																"    ER.ReplyARexxMsg(c,ER.ReturnCode, result,\n"
																"                       errorTag,      error,\n"
																"                       stringTag,     myreturn.resultString,\n"
																"                       longTag,       myreturn.resultLong,\n"
																"                       U.done);\n"
																"  END;\n"
																"  RETURN done;\n"
																"END myHandleARexx;\n\n";

						Write(fp, funchandler, strlen(funchandler));
					}
					break;
			}

		/*** Context ********************************************************************/
		{
			register UBYTE start[] ="PROCEDURE initCommandTable();\n"
															"BEGIN\n",
											init1[]="  table[%ld].id         :=AREXX%s;\n"
															"  table[%ld].command    :=sys.ADR(\"%s\");\n"
															"  table[%ld].cmdTemplate:=sys.ADR(",
											init2[]=");\n"
															"  table[%ld].userData   :=",
											init3[]="sys.VAL(E.APTR, arexxfunc%s);\n\n",
											end[]=	"  table[%ld].id         :=NIL;\n"
															"  table[%ld].command    :=NIL;\n"
															"  table[%ld].cmdTemplate:=NIL;\n"
															"  table[%ld].userData   :=NIL;\n"
															"END initCommandTable;\n\n",
											string[MAXNAMELEN*2+100];
			register ULONG i=0L;

			Write(fp, start, strlen(start));
			for(every_node)
			{
				sprintf(string, init1, i, node->ln_Name, i, node->ln_Name, i);
				Write(fp, string, strlen(string));

				WriteCArguments(fp, ((struct CommandNode *)node)->argumentlist);

				sprintf(string, init2, i);
				Write(fp, string, strlen(string));

				switch(code.handle)
				{
					case HANDLE_IDS:
						sprintf(string, "NIL;\n\n", NULL);
						break;
					case HANDLE_FUNCS:
						sprintf(string, init3, node->ln_Name);
						break;
				}
				Write(fp, string, strlen(string));
				++i;
			}
			sprintf(string, end, i,i,i,i);
			Write(fp, string, strlen(string));
		}
		/*** Main code ******************************************************************/
		if(code.main)
		{
			UBYTE	start[]=	"VAR\n"
											"  context : ER.ARexxContextPtr;\n"
											"  signals : LONGSET;\n"
											"  done    : INTEGER;\n"
											"BEGIN\n"
											"  context:=NIL;\n"
											"  IF ER.base # NIL THEN\n"
											"    initCommandTable;\n"
											"    context:=ER.AllocARexxContext(ER.CommandTable, sys.ADR(table),\n",
					contags[]=	"                                  ER.Author,       sys.ADR(\"%s\"),\n"
											"                                  ER.Copyright,    sys.ADR(\"%s\"),\n"
											"                                  ER.Version,      sys.ADR(\"%s\"),\n"
											"                                  ER.PortName,     sys.ADR(\"%s\"),\n"
											"                                  U.done);\n",
						end[]=		"  END;\n"
											"  REPEAT\n"
											"    signals:=E.Wait(ER.Signal(context));\n"
											"    ER.SetSignals(context,signals);\n"
											"    IF (signals * ER.Signal(context)#LONGSET{}) THEN\n"
											"      done:=myHandleARexx(context);\n"
											"    END;\n"
											"  UNTIL (done # 0) & ER.SafeToQuit(context);\n"
											"  IF context # NIL THEN\n"
											"    ER.FreeARexxContext(context);\n"
											"  END;\n"
											"END ",
						tags[MAXDATALEN+250];

			Write(fp, start, strlen(start));
			sprintf(tags, contags, code.author, code.copyright, code.version, code.portname);
			Write(fp, tags, strlen(tags));
			Write(fp, end, strlen(end));
			Write(fp, module, strlen(module));
			Write(fp, ".\n", 2);
		}
		Close(fp);
	}
}

#endif