Commit 8bbaacf1 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏘
Browse files

Moved system dependent code from coclmain to CoclSystemDependent

parent 0773c0f5
......@@ -22,5 +22,10 @@ SystemDependentDevices :: [a]
SystemDependentInitialIO :: [a]
ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
set_compiler_id :: Int -> Int
:: CompileFun st
:== ([{#Char}] st -> (Bool, st))
compiler_loop :: (CompileFun *st) *st -> (!Bool, !*st)
......@@ -2,11 +2,13 @@
implementation module CoclSystemDependent
import StdEnv
import StdDebug
import ArgEnv
import ipc
from filesystem import ensureDirectoryExists
// import for filesystem
import code from "cDirectory.o" // Unix
import code from "cDirectory.o"
import code from "ipc.o"
from filesystem import ensureDirectoryExists
PathSeparator
:== ':'
......@@ -21,10 +23,102 @@ SystemDependentInitialIO :: [a]
SystemDependentInitialIO
= []
set_compiler_id :: Int -> Int
set_compiler_id compiler_id = compiler_id
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
:: CompileFun st
:== ([{#Char}] st -> (Bool, st))
compiler_loop :: (CompileFun *st) *st -> (!Bool, !*st)
compiler_loop compile compile_state
| length commandArgs==3 && commandArgs!!0=="--pipe"
# commands_name= (commandArgs!!1);
# results_name= (commandArgs!!2);
= (True,compile_loop compile commands_name results_name compile_state)
# (r,compile_state)=compile commandArgs compile_state
= (r,compile_state)
where
commandArgs
= tl [arg \\ arg <-: getCommandLine]
// ... Unix
string_to_args string
= string_to_args 0;
where
l=size string;
string_to_args i
# end_spaces_i=skip_spaces i;
| end_spaces_i==l
= []
| string.[end_spaces_i]=='"'
# next_double_quote_i=skip_to_double_quote (end_spaces_i+1)
| next_double_quote_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i+1,next_double_quote_i-1);
= [arg : string_to_args (next_double_quote_i+1)];
# space_i=skip_to_space (end_spaces_i+1)
| space_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i,space_i-1);
= [arg : string_to_args (space_i+1)];
skip_spaces i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= skip_spaces (i+1);
= i;
skip_to_space i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= i;
= skip_to_space (i+1);
skip_to_double_quote i
| i>=l
= l;
# c=string.[i];
| c=='"'
= i;
= skip_to_double_quote (i+1);
compile_loop :: (CompileFun *st) {#Char} {#Char} *st -> *st
compile_loop compile commands results compile_state
# r=open_pipes commands results;
| r<>0
= abort ("compile_loop\n");
= compile_files compile compile_state
compile_files :: (CompileFun *st) *st -> *st
compile_files compile compile_state
# n = get_command_length;
| n==(-1)
= abort "compile_files 1";
# string=createArray n '\0';
# r=get_command string;
| r<>0
= abort ("compile_files 2 ");
# args=string_to_args (string % (0,size string-2))
= case args of
["cocl":cocl_args]
# (ok,compile_state)=compile cocl_args compile_state
# result=if ok 0(-1);
# r=send_result result
| r<>0
-> abort "compile_files 3";
-> compile_files compile compile_state
["quit"]
-> trace_n "quiting" compile_state;
_
-> abort "compile_files 4"
......@@ -7,6 +7,7 @@ import StdEnv
import StdDebug
import ArgEnv
import set_return_code
import CoclSystemDependent
import compile
......@@ -78,131 +79,14 @@ coclMain testArgs world
CoclArgsFile :== "coclargs.txt"
/*
import thread_message;
import code from "thread_message.obj";
*/
// compiler driver
/* Windows
compiler symbol_table files
# dcl_cache = empty_cache symbol_table
| length commandArgs==2 && commandArgs!!0=="-ide"
# wm_number=get_message_number;
# thread_id=hex_to_int (commandArgs!!1);
= (True,compile_files compile dcl_cache thread_id wm_number files)
# (r,dcl_cache,files)=compile commandArgs dcl_cache files
= (r,files)
where
commandArgs
= tl [arg \\ arg <-: getCommandLine]
*/
// Unix
compile2 args (cache, files)
# (r, cache, files)
= compile args cache files
= (r, (cache, files))
compiler symbol_table files
# dcl_cache = empty_cache symbol_table
| length commandArgs==3 && commandArgs!!0=="--pipe"
# commands_name= (commandArgs!!1);
# results_name= (commandArgs!!2);
= (True,compile_loop compile dcl_cache commands_name results_name files)
# (r,dcl_cache,files)=compile commandArgs dcl_cache files
= (r,files)
where
commandArgs
= tl [arg \\ arg <-: getCommandLine]
// ... Unix
hex_to_int :: {#Char} -> Int
hex_to_int s
= hex_to_int 0 0;
where
l=size s;
hex_to_int i n
| i==l
= n;
# c=s.[i];
# i=i+1;
# n=n<<4;
| c<='9'
= hex_to_int i (n bitor (toInt c-toInt '0'));
= hex_to_int i (n bitor (toInt c-(toInt 'A'-10)));
string_to_args string
= string_to_args 0;
where
l=size string;
string_to_args i
# end_spaces_i=skip_spaces i;
| end_spaces_i==l
= []
| string.[end_spaces_i]=='"'
# next_double_quote_i=skip_to_double_quote (end_spaces_i+1)
| next_double_quote_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i+1,next_double_quote_i-1);
= [arg : string_to_args (next_double_quote_i+1)];
# space_i=skip_to_space (end_spaces_i+1)
| space_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i,space_i-1);
= [arg : string_to_args (space_i+1)];
skip_spaces i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= skip_spaces (i+1);
= i;
skip_to_space i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= i;
= skip_to_space (i+1);
skip_to_double_quote i
| i>=l
= l;
# c=string.[i];
| c=='"'
= i;
= skip_to_double_quote (i+1);
// Unix
import ipc
import code from "ipc.o"
compile_loop compile cache commands results files
# r=open_pipes commands results;
| r<>0
= abort ("compile_loop\n");
= compile_files compile cache files
compile_files compile cache files
# n = get_command_length;
| n==(-1)
= abort "compile_files 1";
# string=createArray n '\0';
# r=get_command string;
| r<>0
= abort ("compile_files 2 ");
# args=string_to_args (string % (0,size string-2))
= case args of
["cocl":cocl_args]
# (ok,cache,files)=compile cocl_args cache files
# result=if ok 0(-1);
# r=send_result result
| r<>0
-> abort "compile_files 3";
-> compile_files compile cache files
["quit"]
-> trace_n "quiting" files;
_
-> abort "compile_files 4"
# (r,(_,files))
= compiler_loop compile2 (dcl_cache, files)
= (r, files)
......@@ -91,6 +91,9 @@ parseCommandLine [arg1=:"-RE", errorPath : args] options
parseCommandLine [arg1=:"-RAE", errorPath : args] options
# (args,modules,options)= parseCommandLine args {options & errorPath = stripQuotes errorPath, errorMode = FAppendText}
= ([arg1,errorPath:args],modules,options)
/* RWS FIXME: "-id" option is only used for the Mac version
and should be moved elsewhere
*/
parseCommandLine ["-id",compiler_id_string : args] options
# compiler_id=toInt compiler_id_string
| set_compiler_id compiler_id==compiler_id
......
Markdown is supported
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