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

#ifndef GENERATMODULA2CSOURCE_C
#define GENERATMODULA2CSOURCE_C

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

/*** FUNCTIONS ***********************************************************************/
__asm UBYTE *Upper(register __a0 UBYTE *string)
{
	register UBYTE	*c=string,
									*s=string;

	while(*c!='\0')
		*c++=ToUpper(*s++);

	return string;
}

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

#ifdef MYDEBUG_H
	DebugOut("GenerateCSource");
#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"
																"FROM   SYSTEM IMPORT ADDRESS, ADR;\n"
																"IMPORT EasyRexx, TagsUtils;\n"
																"IMPORT Libraries, RexxErrors, Tasks, Utility;\n\n";

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

		/*** Defines ********************************************************************/
		{
			register ULONG	i=0;
			register UBYTE	define[256];

			Write(fp, "CONST", 5);
			for(every_node)
			{
				if(node==list->lh_Head)
					sprintf(define, " AREXX%s=%ld;\n", node->ln_Name, ++i);
				else
					sprintf(define, "      AREXX%s=%ld;\n", node->ln_Name, ++i);
				Write(fp, define, strlen(define));
			}
			sprintf(define, "      AREXX%s=%ld;\n\n", "ENDTABLE", ++i);
			Write(fp, define, strlen(define));
		}

		/*** Context predefinition ******************************************************/
		{
			register UBYTE context[]="VAR commandTable :ARRAY[1..AREXXENDTABLE] OF EasyRexx.ARexxCommandTable;\n\n";

			Write(fp, context, strlen(context));
		}

		/*** MyReturn structure *********************************************************/
		if(code.handle==HANDLE_FUNCS)
		{
			register UBYTE retvals[]=	"TYPE ARexxRetValues =\n"
																"  RECORD\n"
																"    result,\n"
																"    resultlong  :LONGINT;\n"
																"    resultstring,\n"
																"    error       :EasyRexx.CharPointer;\n"
																"  END;\n"
																"VAR myreturn :ARexxRetValues;\n\n\n";
			Write(fp, retvals, strlen(retvals));
		}
		
		/*** 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 arexxfunc%s;\n\n",
													node->ln_Name,
													quit ? "1; (* Quit *)":"0;",
													node->ln_Name);
				Write(fp, template, strlen(template));
			}
		}

		/*** Code handler ***************************************************************/
		if(code.arexxhandler)
			switch(code.handle)
			{
				case HANDLE_IDS:
					{
						register UBYTE	start[]="PROCEDURE myHandleARexx(c:EasyRexx.ARexxContext):INTEGER;\n"
																		"VAR done         :INTEGER;\n"
																		"    result,\n"
																		"    resultlong   :LONGINT;\n"
																		"    resultstring,\n"
																		"    error        : EasyRexx.CharPointer;\n"
																		"    taglist      :ARRAY[0..5] OF Utility.TagItem;\n"
																		"BEGIN\n"
																		"  done         := 0;\n"
																		"  result       := RexxErrors.RCOk;\n"
																		"  resultstring := NIL;\n"
																		"  resultlong   := MAX(LONGINT);\n"
																		"  error        := NIL;\n\n"
																		"  WHILE CHAR(EasyRexx.GetARexxMsg(c)) # 0C DO\n"
																		"    CASE VAL(INTEGER, EasyRexx.Id(c)) OF\n",
														end[]=  "    END;\n"
																		"    TagsUtils.AsgTag(taglist, EasyRexx.ERReturnCode, result);\n"
																		"    IF error # NIL THEN\n"
																		"      TagsUtils.CatTag(taglist, EasyRexx.ERErrorMessage, ADDRESS(error));\n"
																		"    END;\n"
																		"    IF resultstring # NIL THEN\n"
																		"      TagsUtils.CatTag(taglist, EasyRexx.ERResultString, ADDRESS(resultstring));\n"
																		"    END;\n"
																		"    IF resultlong # MAX(LONGINT) THEN\n"
																		"      TagsUtils.CatTag(taglist, EasyRexx.ERResultLong, ADDRESS(resultlong));\n"
																		"    END;\n"
																		"    EasyRexx.ReplyARexxMsgA(c, ADR(taglist));\n"
																		"  END;\n"
																		"  RETURN done;\n"
																		"END myHandleARexx;\n\n",
													donestr[]="        done:=1;\n",
												breakstr[]=	"        |\n";

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

							sprintf(command,	"      AREXX%s:\n"
																"        (* insert own code here *)\n",
																node->ln_Name);
							Write(fp, command, strlen(command));
							if(done)
								Write(fp, donestr, strlen(donestr));
							Write(fp, breakstr, strlen(breakstr));
						}
						Write(fp, end, strlen(end));
					}
					break;

				case HANDLE_FUNCS:
					{
						UBYTE funchandler[]="PROCEDURE myHandleARexx(c:EasyRexx.ARexxContext):INTEGER;\n"
																"VAR  i       :INTEGER;\n"
																"     ctp     :EasyRexx.ARexxCommandTablePtr;\n"
																"     func    :EasyRexx.ARexxFunc;\n"
																"     idfound :BOOLEAN;\n"
																"     done    :INTEGER;\n"
																"     taglist :ARRAY[0..5] OF Utility.TagItem;\n"
																"BEGIN\n"
																"  done                  := 0;\n"
																"  myreturn.result       := RexxErrors.RCOk;\n"
																"  myreturn.resultstring := NIL;\n"
																"  myreturn.resultlong   := MAX(LONGINT);\n"
																"  myreturn.error        := NIL;\n\n"
																"  WHILE CHAR(EasyRexx.GetARexxMsg(c)) # 0C DO\n"
																"    i       := 0;\n"
																"    idfound := FALSE;\n"
																"    ctp     := EasyRexx.Table(c, i);\n"
																"    WHILE NOT idfound AND (ctp^.command # NIL) DO\n"
																"      IF ctp^.id = EasyRexx.Id(c) THEN\n"
																"        IF ctp^.userdata # (NIL) THEN\n"
																"          func := EasyRexx.ARexxFunc(ctp^.userdata);\n"
																"          done := func(c);\n"
																"        END;\n"
																"          idfound := TRUE;\n"
																"      ELSE\n"
																"        INC(i);\n"
																"        ctp := EasyRexx.Table(c, i);\n"
																"      END;\n"
																"    END;\n"
																"    TagsUtils.AsgTag(taglist, EasyRexx.ERReturnCode, myreturn.result);\n"
																"    IF myreturn.error # NIL THEN\n"
																"      TagsUtils.CatTag(taglist, EasyRexx.ERErrorMessage, ADDRESS(myreturn.error));\n"
																"    END;\n"
																"    IF myreturn.resultstring # NIL THEN\n"
																"      TagsUtils.CatTag(taglist, EasyRexx.ERResultString, ADDRESS(myreturn.resultstring));\n"
																"    END;\n"
																"    IF myreturn.resultlong # MAX(LONGINT) THEN\n"
																"      TagsUtils.CatTag(taglist, EasyRexx.ERResultLong, ADDRESS(myreturn.resultlong));\n"
																"    END;\n"
																"    EasyRexx.ReplyARexxMsgA(c, ADR(taglist));\n"
																"  END;\n"
																"  RETURN done;\n"
																"END myHandleARexx;\n\n";

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

		/*** Context ********************************************************************/
		{
			UBYTE start[]	=	"PROCEDURE InitCmdTable;\n"
											"BEGIN\n",
						init1[]	=	"  WITH commandTable[AREXX%s] DO\n"
											"    id          := AREXX%s;\n"
											"    command     := ADR(\"%s\");\n"
											"    cmdtemplate := ADR(",
						init2a[]=	");\n"
											"    userdata    := NIL;\n"
											"  END;\n",
						init2b[]=	");\n"
											"    userdata    := ADR(arexxfunc%s);\n"
											"  END;\n",
						end[]		=	"  EasyRexx.TableEnd(commandTable[AREXXENDTABLE]);\n"
											"END InitCmdTable;\n\n",
						command[MAXNAMELEN*3+100];

			Write(fp, start, strlen(start));
			for(every_node)
			{
				sprintf(command, init1, node->ln_Name, node->ln_Name, node->ln_Name);
				Write(fp, command, strlen(command));
				WriteCArguments(fp, ((struct CommandNode *)node)->argumentlist);
				switch(code.handle)
				{
					case HANDLE_IDS:
						sprintf(command, init2a, NULL);
						break;
					case HANDLE_FUNCS:
						sprintf(command, init2b, node->ln_Name);
						break;
				}
				Write(fp, command, strlen(command));
			}
			Write(fp, end, strlen(end));
		}

		/*** Main code ******************************************************************/
		if(code.main)
		{
			UBYTE	start[]=	"VAR done    :INTEGER;\n"
											"    context :EasyRexx.ARexxContext;\n"
											"    taglist :ARRAY[0..5] OF Utility.TagItem;\n"
											"    signals :Tasks.SignalSet;\n\n"
											"BEGIN\n"
											"  done    := 0;\n"
											"  context := EasyRexx.NULLARexxContext;\n"
											"  EasyRexx.EasyRexxBase := Libraries.OpenLibrary(ADR(EasyRexx.EasyRexxName), EasyRexx.EasyRexxVersion);\n"
											"  IF (EasyRexx.EasyRexxBase # NIL) THEN\n"
											"    InitCmdTable;\n"
											"    TagsUtils.AsgTags5(taglist, EasyRexx.ERCommandTable, ADR(commandTable),\n",
						contags[]="                                EasyRexx.ERAuthor,       ADR(\"%s\"),\n"
											"                                EasyRexx.ERCopyright,    ADR(\"%s\"),\n"
											"                                EasyRexx.ERVersion,      ADR(\"%s\"),\n"
											"                                EasyRexx.ERPortname,     ADR(\"%s\"));\n",
						end[]=		"    context := EasyRexx.AllocARexxContextA(ADR(taglist));\n"
											"  END;\n"
											"  WHILE NOT ((done = 1) AND EasyRexx.ERSafeToQuit(context)) DO\n"
											"    signals := Tasks.Wait(EasyRexx.ERSignals(context));\n"
											"    EasyRexx.ERSetSignals(context, signals);\n"
											"    IF (signals * EasyRexx.ERSignal(context) # Tasks.SignalSet{}) THEN\n"
											"      done := myHandleARexx(context);\n"
											"    END;\n"
											"  END;\n"
											"  IF EasyRexx.EasyRexxBase # NIL THEN\n"
											"    EasyRexx.FreeARexxContext(context);\n"
											"    Libraries.CloseLibrary(EasyRexx.EasyRexxBase^);\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