Unix version

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1082 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

11 files changed, 262 insertions, 0 deletions

diff --git a/main/Unix/CoclSystemDependent.dcl b/main/Unix/CoclSystemDependent.dcl
new file mode 100644
index 0000000..7469dd6
--- /dev/null
+++ b/main/Unix/CoclSystemDependent.dcl
@@ -0,0 +1,26 @@
+// this is for Windows
+definition module CoclSystemDependent
+
+//1.3
+from StdString import String
+from StdFile import Files
+//3.1
+/*2.0
+from StdFile import ::Files
+0.2*/
+
+// RWS split
+// from deltaIOSystem import DeviceSystem
+// from deltaEventIO import InitialIO, IOState
+
+PathSeparator
+	:==	':'
+DirectorySeparator
+	:== '/'
+
+SystemDependentDevices :: [a]
+SystemDependentInitialIO :: [a]
+
+ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
+
+set_compiler_id :: Int -> Int
diff --git a/main/Unix/CoclSystemDependent.icl b/main/Unix/CoclSystemDependent.icl
new file mode 100644
index 0000000..4c411e8
--- /dev/null
+++ b/main/Unix/CoclSystemDependent.icl
@@ -0,0 +1,30 @@
+// this is for Unix
+implementation module CoclSystemDependent
+
+import StdEnv
+
+// import for filesystem
+import code from "cDirectory.o" // Unix
+import code from "ipc.o"
+from filesystem import ensureDirectoryExists
+
+PathSeparator
+	:==	':'
+DirectorySeparator
+	:== '/'
+
+SystemDependentDevices :: [a]
+SystemDependentDevices
+		=	[]
+
+SystemDependentInitialIO :: [a]
+SystemDependentInitialIO
+		=	[]
+
+ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
+// returned bool: now there is such a subfolder
+ensureCleanSystemFilesExists path env
+	= ensureDirectoryExists path env
+
+set_compiler_id :: Int -> Int
+set_compiler_id compiler_id = compiler_id
diff --git a/main/Unix/cDirectory.o b/main/Unix/cDirectory.o
new file mode 100644
index 0000000..c65ac16
--- /dev/null
+++ b/main/Unix/cDirectory.o
diff --git a/main/Unix/ipc.c b/main/Unix/ipc.c
new file mode 100644
index 0000000..55cdffd
--- /dev/null
+++ b/main/Unix/ipc.c
@@ -0,0 +1,125 @@
+/*
+	Unix clm/cocl interface
+
+	Ronny Wichers Schreur
+
+*/
+# include <stdio.h>
+# include <stdlib.h>
+# include <stdarg.h>
+# include <strings.h>
+
+/*
+	Clean string
+	============
+*/
+typedef struct clean_string {int length; char chars [1]; } *CleanString;
+
+# define Clean(ignore)
+# include "ipc.h"
+
+static void
+log (char *format, ...)
+{
+#ifdef DEBUG
+	va_list ap;
+
+	va_start (ap, format);
+	(void) fputs("                        cocl: ", stderr);
+	(void) vfprintf(stderr, format, ap);
+	va_end(ap);
+#else /* ifndef DEBUG */
+#endif
+}
+
+static char *
+ConvertCleanString (CleanString string)
+{
+	int		length;
+	char	*copy;
+
+	length	= string->length;
+	copy	= malloc (length+1);
+	strncpy (copy, string->chars, length);
+	copy [length]	= '\0';
+
+	return (copy);
+} /* ConvertCleanString */
+
+static FILE *commands, *results;
+# define COMMAND_BUFFER_SIZE 1024
+static char command_buffer[COMMAND_BUFFER_SIZE];
+
+static void
+crash (void)
+{
+	int	*p;
+
+	p	= NULL;
+	log ("crashing\n");
+	*p	= 0;
+} /* crash */
+
+static void
+hang (void)
+{
+	log ("hanging\n");
+	for (;;)
+		;
+} /* hang */
+
+int open_pipes (CleanString commands_clean, CleanString results_clean)
+{
+	char *commands_name, *results_name;
+
+	commands_name	= ConvertCleanString (commands_clean);
+	results_name	= ConvertCleanString (results_clean);
+
+    if ((commands = fopen(commands_name, "r")) == NULL)
+    {
+		fprintf(stderr,"commands = %s\n",commands_name);
+		perror("fopen commands");
+		return -1;
+    }
+    if ((results = fopen(results_name, "w")) == NULL)
+    {
+		fprintf(stderr,"results = %s\n",results_name);
+		perror("fopen results");
+		return -1;
+    }
+	return 0;
+}
+
+int get_command_length (void)
+{
+	log ("reading command\n");
+	if (fgets (command_buffer, COMMAND_BUFFER_SIZE, commands) == NULL)
+		return -1;
+	else	
+	{
+		log ("command = %s", command_buffer);
+		return (strlen (command_buffer));
+	}
+}
+
+int get_command (CleanString cleanString)
+{
+	fprintf (stderr, "%s\n", command_buffer);
+	strncpy (cleanString->chars, command_buffer, cleanString->length);
+	cleanString->chars [cleanString->length]	= '\0';
+
+	return (0);
+}
+
+int send_result (int result)
+{
+	int	r;
+
+	if (fprintf (results, "%d\n", result) > 0)
+		r=0;
+	else
+		r=-1;
+	fflush (results);
+
+	return r;
+}
diff --git a/main/Unix/ipc.dcl b/main/Unix/ipc.dcl
new file mode 100644
index 0000000..ac7c696
--- /dev/null
+++ b/main/Unix/ipc.dcl
@@ -0,0 +1,12 @@
+definition module ipc;
+
+from StdString import String;
+
+open_pipes :: !String !String -> Int;
+// int open_pipes (CleanString commands_name,CleanString results_name);
+get_command_length :: Int;
+// int get_command_length ();
+get_command :: !String -> Int;
+// int get_command (CleanString cleanString);
+send_result :: !Int -> Int;
+// int send_result (int result);
diff --git a/main/Unix/ipc.h b/main/Unix/ipc.h
new file mode 100644
index 0000000..99a070e
--- /dev/null
+++ b/main/Unix/ipc.h
@@ -0,0 +1,8 @@
+int open_pipes (CleanString commands_name, CleanString results_name);
+Clean (open_pipes :: String String -> Int)
+int get_command_length (void);
+Clean (get_command_length :: Int)
+int get_command (CleanString cleanString);
+Clean (get_command :: String -> Int)
+int send_result (int result);
+Clean (send_result :: Int -> Int)
diff --git a/main/Unix/ipc.icl b/main/Unix/ipc.icl
new file mode 100644
index 0000000..2f30ecb
--- /dev/null
+++ b/main/Unix/ipc.icl
@@ -0,0 +1,28 @@
+implementation module ipc;
+
+from StdString import String;
+
+
+open_pipes :: !String !String -> Int;
+open_pipes a0 a1 = code {
+	ccall open_pipes "SS:I"
+}
+// int open_pipes (CleanString commands_name,CleanString results_name);
+
+get_command_length :: Int;
+get_command_length  = code {
+	ccall get_command_length ":I"
+}
+// int get_command_length ();
+
+get_command :: !String -> Int;
+get_command a0 = code {
+	ccall get_command "S:I"
+}
+// int get_command (CleanString cleanString);
+
+send_result :: !Int -> Int;
+send_result a0 = code {
+	ccall send_result "I:I"
+}
+// int send_result (int result);
diff --git a/main/Unix/ipc.o b/main/Unix/ipc.o
new file mode 100644
index 0000000..0003b9e
--- /dev/null
+++ b/main/Unix/ipc.o
diff --git a/main/Unix/set_return_code.dcl b/main/Unix/set_return_code.dcl
new file mode 100644
index 0000000..e8ed7f8
--- /dev/null
+++ b/main/Unix/set_return_code.dcl
@@ -0,0 +1,9 @@
+definition module set_return_code;
+
+//1.3
+from StdString import String;
+//3.1
+
+:: *UniqueWorld :== World;
+set_return_code :: !Int !UniqueWorld -> UniqueWorld;
+// void set_return_code (int return_code);
diff --git a/main/Unix/set_return_code.icl b/main/Unix/set_return_code.icl
new file mode 100644
index 0000000..1ec0d2f
--- /dev/null
+++ b/main/Unix/set_return_code.icl
@@ -0,0 +1,18 @@
+implementation module set_return_code;
+
+import code from "set_return_code.obj";
+
+import StdString;
+import StdDebug;
+
+:: *UniqueWorld :== World;
+
+set_return_code :: !Int !UniqueWorld -> UniqueWorld;
+set_return_code a0 a1 = code
+{
+	ccall set_return_code "I:V:A"
+	fill_a 0 1
+	pop_a 1
+}
+
+// void set_return_code (int return_code);
diff --git a/main/Unix/set_return_code_c.c b/main/Unix/set_return_code_c.c
new file mode 100644
index 0000000..a09e1ab
--- /dev/null
+++ b/main/Unix/set_return_code_c.c
@@ -0,0 +1,6 @@
+extern int return_code;
+
+void set_return_code (int code)
+{
+	return_code	=	code;
+}