Commit a92f252a authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏢
Browse files

Initial import

parent 8e76170d
#define Clean(a)
typedef struct clean_string *CleanString;
/* a string in Clean is:
struct clean_string {
int clean_string_length;
char clean_string_characters[clean_string_length];
};
The string does not end with a '\0' !
*/
/* CleanStringLength(clean_string) returns the length of the clean_string in characters */
#define CleanStringLength(clean_string) (*(unsigned int *)(clean_string))
/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */
#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned int *)(clean_string)))
/* CleanStringSizeInts(string_length) return size of *CleanString in integers */
#define CleanStringSizeInts(string_length) (1+(((unsigned int)(string_length)+3)>>2))
/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,
before using the clean_string variable, cast to CleanString, except for the macros above */
#define CleanStringVariable(clean_string,string_length) unsigned int clean_string[CleanStringSizeInts(string_length)]
/* CleanStringSizeBytes(string_length) return size of *CleanString in bytes */
#define CleanStringSizeBytes(string_length) (4+(((unsigned int)(string_length)+3) & -4))
typedef int *CleanIntArray;
/* CleanIntArraySize(clean_array) returns the size (number of elements) of the clean_int_array */
#define CleanIntArraySize(clean_int_array) (((unsigned int *)(clean_int_array))[-2])
typedef double *CleanRealArray;
/* CleanRealArraySize(clean_real_array) returns the size (number of elements) of the clean_real_array */
#define CleanRealArraySize(clean_real_array) (((unsigned int *)(clean_real_array))[-2])
typedef unsigned char *CleanCharArray;
/* CleanCharArraySize(clean_char_array) returns the size (number of elements) of the clean_char_array */
#define CleanCharArraySize(clean_char_array) (((unsigned int *)(clean_char_array))[-1])
CC=gcc
CFLAGS=-pedantic -Wall -W
CPPFLAGS=-DGNU_C -DSOLARIS
clm: clm.o cachingcompiler.o
gcc clm.o cachingcompiler.o -o clm
./patch_bin clm CLEANLIB $(HOME)/Clean2/exe
./patch_bin clm CLEANPATH .:$(HOME)/Clean2/stdenv:$(HOME)/Clean2/iolib
cachingcompiler.o: cachingcompiler.c cachingcompiler.h
clm.o: clm.c cachingcompiler.h
# gcc -pedantic -Wall -c -DGNU_C -DSOLARIS -O clm.c # -mcpu=ppc603 clm.c
/*
File: cachingcompiler.c
Written by: Ronny Wichers Schreur
At: University of Nijmegen
*/
#include "Clean.h"
#include "cachingcompiler.h"
#include <stdlib.h>
#include <stdarg.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#if defined(I486) || defined (SOLARIS) || defined (LINUX)
# include <unistd.h>
#endif
#include <signal.h>
#include <sys/types.h>
#include <sys/wait.h>
#include <sys/stat.h>
static int wait_for_child (pid_t pid, char *child_name, int *status_p)
{
int result, stat;
(void) waitpid (pid, &stat, 0);
result = WEXITSTATUS (stat);
if (WIFSIGNALED(stat))
fprintf (stderr,"%s signaled (%d, %d)\n",child_name,
WTERMSIG(stat), stat&255);
else if (WIFEXITED (stat))
fprintf (stderr,"%s exited normally (%d, %d)\n", child_name,
WEXITSTATUS(stat),stat&255);
else
fprintf (stderr,"%s exited abnormally (%d, %d)\n",child_name,
result, stat&255);
*status_p=stat;
return result;
}
static void error (char *error_string)
{
fprintf (stderr,"%s\n",error_string);
}
static void log (char *format, ...)
{
va_list ap;
va_start(ap, format);
(void) vfprintf(stderr, format, ap);
va_end(ap);
fflush (stderr);
}
static int compiler_initialised=0;
static pid_t compiler_pid=0;
static char *compiler_commands_name=NULL, *compiler_results_name=NULL;
static FILE *compiler_commands, *compiler_results;
int stop_caching_compiler (void)
{
int r,status;
log ("stop_caching_compiler\n");
if (compiler_pid != 0) {
pid_t pid;
pid = compiler_pid;
compiler_pid = 0;
log ("stop_caching_compiler: compiler running\n");
fputs ("quit\n", compiler_commands);
fflush (compiler_commands);
r=wait_for_child (pid, "Clean compiler",&status);
if (status!=0) {
fprintf (stderr, "r=%d status=%xd\n", r, status);
error ("clm: error after stopping compiler");
exit (1);
}
}
return 0;
}
static void cleanup_compiler (void)
{
log ("cleanup_compiler\n");
stop_caching_compiler ();
if (compiler_commands_name != NULL)
{
log ("cleanup_compiler: unlink commands\n");
if (unlink (compiler_commands_name) != 0)
perror ("clm: unlink compiler commands pipe");
compiler_commands_name = NULL;
}
if (compiler_results_name != NULL)
{
log ("cleanup_compiler: unlink results\n");
if (unlink (compiler_results_name) != 0)
perror ("clm: unlink compiler results pipe");
compiler_results_name = NULL;
}
}
static void cleanup_compiler_at_exit (void)
{
log ("cleanup_compiler_on_exit\n");
cleanup_compiler ();
}
static void cleanup_compiler_on_signal (int signal_no)
{
log ("cleanup_compiler_on_signal\n");
cleanup_compiler ();
}
static void child_died (int signal_no)
{
log ("child_died\n");
if (compiler_pid != 0)
{
fprintf (stderr,"cocl exited abnormally\n");
compiler_pid=0;
}
}
static void init_caching_compiler(void)
{
log ("init_caching_compiler\n");
if (atexit (cleanup_compiler_at_exit) != 0)
{
perror("clm: atexit install cleanup routine");
exit(1);
}
/*
if (signal (SIGCHLD, child_died) == SIG_ERR)
{
perror("clm: signal install child died routine");
exit(1);
}
if (signal (SIGINT, cleanup_compiler_on_signal) == SIG_ERR)
{
perror("clm: signal install cleanup routine");
exit(1);
}
*/
compiler_initialised=1;
}
int start_caching_compiler (CleanCharArray cocl_path)
{
log ("start_caching_compiler\n");
if (compiler_pid != 0)
return 0;
if (!compiler_initialised)
init_caching_compiler ();
umask(0);
if (compiler_commands_name == NULL)
{
compiler_commands_name=tempnam (NULL, "com");
if (mkfifo(compiler_commands_name, S_IRUSR | S_IWUSR)) {
perror("clm: mkfifo compiler commands pipe");
compiler_commands_name=NULL;
exit(1);
}
}
if (compiler_results_name == NULL)
{
compiler_results_name=tempnam (NULL, "res");
if (mkfifo(compiler_results_name, S_IRUSR | S_IWUSR)) {
perror("clm: mkfifo compiler results pipe");
compiler_results_name=NULL;
exit(1);
}
}
compiler_pid=fork();
if (compiler_pid<0)
error ("Fork failed");
if (compiler_pid==0){
execlp ((char *)cocl_path, "cocl", "--pipe", compiler_commands_name,
compiler_results_name, (char *) 0);
fprintf (stderr, "cocl path = %s\n", cocl_path);
perror ("clm: can't start the clean compiler");
exit(1);
}
if ((compiler_commands=fopen(compiler_commands_name, "w")) == NULL)
{
perror("clm: fopen compiler commands pipe");
exit(1);
}
if ((compiler_results=fopen(compiler_results_name, "r")) == NULL)
{
perror("clm: fopen compiler commands pipe");
exit(1);
}
return (0);
}
#define RESULT_SIZE (sizeof (int)+2)
int call_caching_compiler (CleanCharArray args)
{
int r;
char result_string[RESULT_SIZE], *end;
log ("call_caching_compiler\n");
if (compiler_pid == 0)
error ("call_compiler: compiler not running");
fputs ((const char *) args,compiler_commands);
fputc ('\n',compiler_commands);
fflush (compiler_commands);
if (fgets(result_string,RESULT_SIZE,compiler_results) == NULL){
perror ("clm: reading compiler result failed");
/* exit (1); */
return 0;
}
r=(int)strtol (result_string,&end,0);
if (*end != '\n'){
perror ("clm: non integer compiler result");
exit (1);
}
/* FIXME, clm/CleanIDE don't correspond
return r>=0; */
return r;
}
definition module cachingcompiler;
//1.3
from StdString import String;
//3.1
:: *Thread :== Int;
start_caching_compiler :: !{#Char} !Thread -> (!Int,!Thread);
// int start_caching_compiler (CleanCharArray compiler_path);
call_caching_compiler :: !{#Char} !Thread -> (!Int,!Thread);
// int call_caching_compiler (CleanCharArray args);
stop_caching_compiler :: !Thread -> (!Int,!Thread);
// int stop_caching_compiler ();
Clean (:: *Thread :== Int)
int start_caching_compiler (CleanCharArray compiler_path);
Clean (start_caching_compiler :: {#Char} Thread -> (Int, Thread))
int call_caching_compiler (CleanCharArray args);
Clean (call_caching_compiler :: {#Char} Thread -> (Int, Thread))
int stop_caching_compiler (void);
Clean (stop_caching_compiler :: Thread -> (Int, Thread))
implementation module cachingcompiler;
//1.3
from StdString import String;
//3.1
:: *Thread :== Int;
start_caching_compiler :: !{#Char} !Thread -> (!Int,!Thread);
start_caching_compiler a0 a1 = code {
ccall start_caching_compiler "s:I:I"
}
// int start_caching_compiler (CleanCharArray compiler_path);
call_caching_compiler :: !{#Char} !Thread -> (!Int,!Thread);
call_caching_compiler a0 a1 = code {
ccall call_caching_compiler "s:I:I"
}
// int call_caching_compiler (CleanCharArray args);
stop_caching_compiler :: !Thread -> (!Int,!Thread);
stop_caching_compiler a0 = code {
ccall stop_caching_compiler ":I:I"
}
// int stop_caching_compiler ();
This diff is collapsed.
# include <stdio.h>
# include <stdlib.h>
typedef struct Deps *Deps;
typedef struct DepList *DepList;
struct Deps
{
char *name;
DepList depList;
int mark;
int top;
Deps next;
};
struct DepList
{
Deps mod;
int removed;
DepList next;
};
static Deps gDeps = NULL;
static void
fatal (char *message)
{
fprintf (stderr, "fatal error : %s\n", message);
} /* fatal */
static Deps
NewDep (char *name)
{
Deps dep;
for (dep = gDeps; dep != NULL; dep = dep->next)
if (strcmp (dep->name, name) == 0)
return (dep);
dep = malloc (sizeof (struct Deps));
dep->name = malloc (strlen (name) + 1);
strcpy (dep->name, name);
dep->depList = NULL;
dep->top = 0;
dep->mark = 0;
dep->next = gDeps;
gDeps = dep;
return (dep);
}
static void
AddDep (Deps mod, Deps dep)
{
DepList depList;
depList = malloc (sizeof (struct DepList));
depList->mod = dep;
depList->removed = 0;
depList->next = mod->depList;
mod->depList = depList;
}
static void
ReadDeps (void)
{
char line [80];
Deps mod = NULL;
while (fgets (line,80,stdin) != NULL)
{
int length;
length=strlen (line);
if (length>0 && line[length-1]=='\n'){
--length;
line[length]='\0';
}
if (line [0] == '\t')
{
Deps dep;
if (mod == NULL)
fatal ("ReadDeps");
if (strcmp (line+1,mod->name)!=0){
dep = NewDep (line+1);
AddDep (mod, dep);
}
}
else
{
mod = NewDep (line);
mod->top = 1;
}
}
} /* ReadDeps */
static void
WriteDeps (void)
{
Deps dep;
for (dep = gDeps; dep != NULL; dep = dep->next)
if (dep->top)
{
DepList depList;
int has_dep;
fprintf (stdout, "%s\n", dep->name);
has_dep=0;
for (depList = dep->depList; depList != NULL; depList = depList->next)
if (!depList->removed){
if (!has_dep){
fprintf (stdout,"\t(");
has_dep=1;
} else
fprintf (stdout," ");
fprintf (stdout,"%s",depList->mod->name);
}
if (has_dep)
fprintf (stdout,")\n");
}
} /* WriteDeps */
static char *gCurrent;
static DepList
RemoveOneDep (char *name, DepList depList)
{
for ( ; depList != NULL; depList = depList->next)
if (strcmp (depList->mod->name, name) == 0)
{
if (!depList->removed)
fprintf (stderr, "removing %s from %s\n", name, gCurrent);
depList->removed = 1;
}
}
static void
RemoveDep (Deps dep, DepList change)
{
DepList depList;
if (dep->mark)
return;
dep->mark = 1;
for (depList = dep->depList; depList != NULL; depList = depList->next)
{
if (!depList->removed)
{
if (!depList->mod->mark)
RemoveOneDep (depList->mod->name, change);
RemoveDep (depList->mod, change);
}
}
dep->mark = 0;
}
static void
MinDep (Deps dep)
{
DepList depList;
gCurrent = dep->name;
for (depList = dep->depList; depList != NULL; depList = depList->next)
if (!depList->removed)
RemoveDep (depList->mod, dep->depList);
}
static void
MinDeps (void)
{
Deps dep;
for (dep = gDeps; dep != NULL; dep = dep->next)
MinDep (dep);
}
int
main (void)
{
ReadDeps ();
MinDeps ();
WriteDeps ();
return 0;
}
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment