Commit 32d8985e authored by Diederik van Arkel's avatar Diederik van Arkel

Assorted fixes for alpha 1

parent 8f6d3c74
......@@ -260,6 +260,9 @@ where
# pic = setPenColour commentColour pic
# pic = optDrawS "/*" pic
# cl = inc_comment cl
| in_comment cl
= dL cl (inc i`) pic
# pic = setPenColour (non_comment_colour cl) pic
= dL /*False*/ cl (inc i`) pic
// # (cl,pic) = normalise ini i cl pic
# pic = optDrawC '/' pic
......
......@@ -6,8 +6,9 @@ import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StrictList
import StdMisc
import nodebug
//import dodebug
//import nodebug
//import dodebug // StdDebug
trace_n` _ f :== f
//slFromList` :: ![a] -> StrictList a
slFromList` [] r = r
......@@ -71,6 +72,7 @@ quickParse :: !Int !Int !(StrictList (!Info,!String)) -> (Int,Int,StrictList (!I
// = (0,slLength text - 1,firstParse (slMap snd text))
quickParse beg end lines
# (s,f,l) = before 0 slFromList iniState [] lines
// # l` = firstParse (slMap snd text)
= trace_n` ("qP",beg,end,s,f) (s,f,l)
where
before idx res state acc SNil
......
......@@ -59,10 +59,10 @@ Start world
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
# (ok,world) = ensureDirectory EnvsDir world
| not ok
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
= abort ("Missing directory for environments:\n" +++ EnvsDir +++ "\nUnable to create it.\n")
# (ok,world) = ensureDirectory TempDir world
| not ok
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
= abort ("Missing directory for temporary files:\n" +++ TempDir +++ "\nUnable to create it.\n")
# prefspath = MakeFullPathname PrefsDir PrefsFileName
#! (prefs,world) = openPrefs prefspath world
......
......@@ -166,7 +166,7 @@ where
setexe (ls,ps)
# (prjPath,ps) = getPath ps
# prjName = RemovePath prjPath
# prjName = RemoveSuffix (RemovePath prjPath)
# prjPath = RemoveFilename prjPath
# (exename,ps) = PlatformDependant
(selectOutputFile` "Executable" "*.exe" "Set" ps) // win
......
......@@ -11,7 +11,7 @@ import PmCleanSystem
import flextextcontrol
import ioutil, morecontrols, colorpickcontrol
import projmen, menubar, colourclip
from IDE import OpenModule
//from IDE import OpenModule
import Platform, IdePlatform
//-- Project Window Options...
......@@ -499,11 +499,12 @@ where
# mods = StrictListToList modules
| isEmpty mods
= []
# [(root,_,_,_):mods] = mods
# [(root,rootdir,_,_):mods] = mods
# mods = filter isInPaths mods
# mods = sortBy (\(a,b,_,_) (c,d,_,_) -> less a b c d) mods
# moditems = makenice True "" mods
# rootitem = (GetModuleName root, OpenModule (MakeImpPathname root) emptySelection, openif root)
// # rootitem = (GetModuleName root, OpenModule (MakeImpPathname root) emptySelection, openif root)
# rootitem = (GetModuleName root, open_imp rootdir (MakeImpPathname root), openif rootdir root)
= [rootitem:moditems]
where
isInPaths (_,p,_,_) = any p srcpaths
......@@ -513,13 +514,14 @@ where
any p ((_,b) :! tl)
= p == b || any p tl
openif root ps
openif rootdir root ps
# defpath = MakeDefPathname root
# (exists,ps) = accFiles (FExists defpath) ps
# path = rootdir +++ defpath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule defpath emptySelection ps
= ed_open_path_sel path emptySelection ps
# imppath = MakeImpPathname root
= OpenModule imppath emptySelection ps
= open_imp rootdir imppath ps
less a b c d
| before b d = True // use < -ordening of searchpaths...
| b == d
......@@ -546,51 +548,78 @@ where
= makenice u s r
where
f mod = if shift
(open_def mod) //(OpenModule (MakeDefPathname mod) emptySelection)
(open_imp mod) //(OpenModule (MakeImpPathname mod) emptySelection)
(open_def b mod) //(OpenModule (MakeDefPathname mod) emptySelection)
(open_imp b mod) //(OpenModule (MakeImpPathname mod) emptySelection)
f` mod = if shift
(open_imp mod) //(OpenModule (MakeImpPathname mod) emptySelection)
(open_def mod) //(OpenModule (MakeDefPathname mod) emptySelection)
(open_imp b mod) //(OpenModule (MakeImpPathname mod) emptySelection)
(open_def b mod) //(OpenModule (MakeDefPathname mod) emptySelection)
isUnfoldedDir d Nil = False
isUnfoldedDir d ((u,d`):!ds)
| d == d` = u
= isUnfoldedDir d ds
open_def mod ps
open_def dirpath mod ps
# defpath = MakeDefPathname mod
// # (exists,ps) = accFiles (FExists defpath) ps
# (exists,ps) = exists_module defpath ps
# path = dirpath +++ defpath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule defpath emptySelection ps
= ed_open_path_sel path emptySelection ps
# lhspath = RemoveSuffix mod +++ ".lhs"
// # (exists,ps) = accFiles (FExists lhspath) ps
# (exists,ps) = exists_module lhspath ps
# path = dirpath +++ lhspath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule lhspath emptySelection ps
= ed_open_path_sel path emptySelection ps
# hspath = RemoveSuffix mod +++ ".hs"
// # (exists,ps) = accFiles (FExists hspath) ps
# (exists,ps) = exists_module hspath ps
# path = dirpath +++ hspath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule hspath emptySelection ps
= OpenModule defpath emptySelection ps
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module defpath ps
| exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module lhspath ps
| exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module hspath ps
| exists
= ed_open_path_sel path emptySelection ps
= okNotice
[ "Clean Project Manager"
, "Could not find file:"
, defpath
] ps
open_imp mod ps
open_imp dirpath mod ps
# defpath = MakeImpPathname mod
// # (exists,ps) = accFiles (FExists defpath) ps
# (exists,ps) = exists_module defpath ps
# path = dirpath +++ defpath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule defpath emptySelection ps
= ed_open_path_sel path emptySelection ps
# lhspath = RemoveSuffix mod +++ ".lhs"
// # (exists,ps) = accFiles (FExists lhspath) ps
# (exists,ps) = exists_module lhspath ps
# path = dirpath +++ lhspath
# (exists,ps) = accFiles (FExists path) ps
| exists
= OpenModule lhspath emptySelection ps
= ed_open_path_sel path emptySelection ps
# hspath = RemoveSuffix mod +++ ".hs"
// # (exists,ps) = accFiles (FExists hspath) ps
# (exists,ps) = exists_module hspath ps
# path = dirpath +++ hspath
# (exists,ps) = accFiles (FExists path) ps
| exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module defpath ps
| exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module lhspath ps
| exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module hspath ps
| exists
= OpenModule hspath emptySelection ps
= OpenModule defpath emptySelection ps
= ed_open_path_sel path emptySelection ps
= okNotice
[ "Clean Project Manager"
, "Could not find file:"
, defpath
] ps
exists_module pathname ps
# (syspaths,ps) = getCurrentPaths ps
......@@ -601,7 +630,7 @@ exists_module pathname ps
True -> Map MakeSystemPathname srcpaths
_ -> srcpaths
# ((ok,fullpath),ps) = accFiles (SearchDisk False pathname srcpaths) ps
= (ok,ps)
= (ok,GetLongPathName fullpath,ps)
// pm_set: set main module
pm_set :: !*(PSt *General) -> *PSt *General
......
......@@ -87,9 +87,9 @@ getWindowModified id ioState
where
getWindowModified wsH=:{wshIds={wPtr}} ioState
# (mod,ioState) = accIOToolbox (IsWindowModified wPtr) ioState
= trace_n` ("getWindowModified",wPtr,mod) (mod,wsH,ioState)
= trace_n` ("getWindowModified",wPtr,mod) (mod<>0,wsH,ioState)
IsWindowModified :: !OSWindowPtr !*OSToolbox -> (!Bool,!*OSToolbox)
IsWindowModified :: !OSWindowPtr !*OSToolbox -> (!Int,!*OSToolbox)
IsWindowModified wPtr ioState = code {
ccall IsWindowModified "PI:I:I"
}
......
......@@ -8,7 +8,8 @@ import StdArray, StdBool, StdChar, StdFunc, StdInt, StdList
import StdSystem, StdPStClass, StdMisc
import Directory
import PmCompilerOptions, UtilStrictLists, PmPath, PmProject
import PmCompilerOptions, PmPath, PmProject
from UtilStrictLists import :: List(..), RemoveDup, StrictListToList
import UtilNewlinesFile
import WriteOptionsFile
......@@ -16,6 +17,7 @@ from PmParse import IsTypeSpec, IsImportError13, IsImportError20
from linkargs import ReadLinkErrors,WriteLinkOpts,:: LinkInfo`(..),:: LPathname
import xcoff_linker
import mach_o_linker
import ostoolbox
from files import LaunchApplicationFSSpec, FSMakeFSSpec
......@@ -26,20 +28,9 @@ KAEQueueReply :== 2
//import StdDebug,dodebug
//import nodebug
import nodebug
//import dodebug
trace_n _ f :== f
fopena :== fopen
fopenb :== fopen
/*
fopena :: {#.Char} .Int *a -> *(Bool,.File,*a) | FileSystem a;
fopena s i f
= fopen s i f
fopenb :: {#.Char} .Int *a -> *(Bool,.File,*a) | FileSystem a;
fopenb s i f
= fopen s i f
*/
//ifWindows w o :== o
trace_n` _ f :== f
// For testing update speed...
send_command_to_clean_compiler_cc a b c
......@@ -56,12 +47,15 @@ standardStaticLibraries :: !Processor !LinkMethod -> List String
standardStaticLibraries processor method
| ProcessorSuffix processor == ".cxo" // PowerPC Classic
= case method of
LM_Static -> ("cxo_library0" :! "cxo_library1" :! "cxo_library2" :! Nil)
LM_Dynamic -> ("cxo_library0" :! "cxo_library1" :! "cxo_library2" :! Nil)
= case method of
LM_Static -> ("library0" :! "library1" :! "library2" :! Nil)
// LM_Eager -> ("library0" :! "library1" :! "library2" :! Nil)
LM_Dynamic -> ("library0" :! "library1" :! "library2" :! Nil)
LM_Static -> ("Interface_library" :! "StdC_library" :! "Math_library" :! Nil)
LM_Dynamic -> ("Interface_library" :! "StdC_library" :! "Math_library" :! Nil)
| ProcessorSuffix processor == ".xo" // PowerPC CFM/PEF
= case method of
LM_Static -> ("Carbon_library" :! "StdC_library" :! Nil)
LM_Dynamic -> ("Carbon_library" :! "StdC_library" :! Nil)
= case method of // PowerPC dyld/MachO
LM_Static -> (Nil)
LM_Dynamic -> (Nil)
standardObjectFiles :: !Bool !Bool !Processor -> List String
standardObjectFiles stack_traces profiling processor
......@@ -267,7 +261,7 @@ ReadTypesInfo :: !Bool !Pathname !*Files -> ((!Bool,!(List String)),!*Files)
ReadTypesInfo readtypes path env
| not readtypes
= ((False,Nil),env)
# (opened,file,env) = fopena path FReadText env
# (opened,file,env) = fopen path FReadText env
| not opened
= ((False,Nil),env)
# (typelist,types_read,file`) = ReadTypeMsg file
......@@ -296,7 +290,7 @@ Strip s
ReadErrorsAndWarnings :: !Pathname !*Files -> ((!CompilerMsg, !Bool, !(List String)), !*Files)
ReadErrorsAndWarnings path env
# (opened,file,env) = fopenb path FReadText env
# (opened,file,env) = fopen path FReadText env
| not opened
= ((SyntaxError,False,Nil),env)
# (errors,errors_and_warnings_read,errlist,file`) = ReadErrorAndWarningMessages file
......@@ -430,14 +424,14 @@ CodeGen cgen` wf genAsmOrCode path timeprofile cgo tp ao startupdir ps
_
# assembly_file_name = to_unix_path (RemoveSuffix objpath+++".a");
# object_file_name = to_unix_path objpath;
# (r1,r2) = send_command_to_application False "EXEC"
# (r1,r2,ps) = send_command_to_application False "EXEC"
( "/usr/bin/as '"
+++ assembly_file_name
+++ "' -o '"
+++ object_file_name
+++ "'"
+++ " -g" // for symbolic debugging info...
)
) out_file_name ps
-> (ps,objpath,r1==r1)
)
(ps,objpath,True)
......@@ -536,29 +530,45 @@ Link linker` winfun path
| isJust err
= (winfun (fromJust err) ps,False)
# objectFileNames = StrictListToList (RemoveDup object_file_names)
# libraryFileNames = StrictListToList (RemoveDup library_file_names)
# objectFileNames = StrictListToList (RemoveDup object_file_names)
# libraryFileNames = StrictListToList (RemoveDup library_file_names)
# staticFileNames = StrictListToList (RemoveDup static_libraries)
| isEmpty objectFileNames
= (winfun ["Linker error: No objects to link."] ps,False)
// | isMachOObject (hd objectFileNames)
| ProcessorSuffix processor == ".o"
# (r1,r2) = send_command_to_application False "EXEC"
# ((ok,errs),ps) = accFiles (link_mach_o_files` (objectFileNames ++ staticFileNames) path) ps
# command =
( "/usr/bin/cc "
/*
+++ concat_object_file_names objectFileNames
+++ concat_object_file_names staticFileNames
*/
+++ "'" +++ to_unix_path path +++ "'"
+++ " -framework Carbon"
+++ " -o '"
+++ to_unix_path path
+++ "'"
// +++ " -g" // for debugging syms
+++ if (ss > standard_mosx_stack) (" -stack-size " +++ stack_size) ""
)(to_unix_path linkerrspath/*startupdir +++ "/linker_out"*/);
+++ linker`
// +++ " -L/sw/lib -lgtk-x11-2.0 -lgdk-x11-2.0 -latk-1.0 -lgdk_pixbuf-2.0" //
// +++ " -lm -lpangoxft-1.0 -lpangox-1.0 -lpango-1.0 -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl -liconv "
// +++ " -lpangoft2-1.0 "
)
# (r1,r2,ps) = send_command_to_application False "EXEC"
command (to_unix_path linkerrspath/*startupdir +++ "/linker_out"*/) ps;
| r1==(-1)
= (winfun ["Linker error: Could not start the linker (/usr/bin/cc)."] ps,False)
| r2<>0
# ((errtext_not_empty,errtext),ps) = accFiles (ReadLinkInfo linkerrspath) ps;
= (winfun ["Linker error: Linker returned with error code." : StrictListToList errtext] ps, False)
= (winfun
[ "Linker error: Linker returned with error code: " +++toString r2
, command
: StrictListToList errtext
] ps, False)
// otherwise
# application_existed = False;
# (resources_ok,ps) = accFiles (create_application_resource path MachO application_existed (fs,fn) hs heap_size_multiple ss flags
......@@ -577,6 +587,10 @@ where
stack_size = hex_int (roundup_to_multiple ss 4096)
standard_mosx_stack = 0x080000 // 512K
link_mach_o_files` o_files app_path files
# (ok,errs,files) = link_mach_o_files o_files app_path files
= ((ok,errs),files)
// from ExtInt module in pc linker
roundup_to_multiple s m :== (s + (dec m)) bitand (~m);
......@@ -677,14 +691,14 @@ fork_execv_waitpid s stdout_file_name
ccall fork_execv_waitpid "ss:II"
};
send_command_to_application :: !Bool !String !String !String -> (!Int,!Int);
send_command_to_application _ _ s stdout_file_name
send_command_to_application :: !Bool !String !String !String !*env -> (!Int,!Int,!*env);
send_command_to_application _ _ s stdout_file_name env
# (r,status)=fork_execv_waitpid (s+++"\0") (stdout_file_name+++"\0");
| r==(-1)
= (-1,-1);
= (-1,-1,env);
| status bitand 0177<>0
= (-1,status);
= (0,status>>8);
= (-1,status,env);
= (0,status>>8,env);
/*
Link_ppc winfun path u_system_file_name paths defs
......@@ -777,7 +791,7 @@ QuitCleanCompiler :: !*(IOSt .l) -> *(IOSt .l)
// want to quit all launched Compilers in any env...???
// means we need to keep track of these somehow.
QuitCleanCompiler io
# signature = CleanCompilerSignature // XOXOXOX
# signature = "C2Co"//CleanCompilerSignature // XOXOXOX
| send_quit_event_to_clean_compiler signature == 0
= io;
= io;
......
......@@ -197,7 +197,9 @@ isWindow wId ps
= (isMember wId s, ps)
/////////////////////
import nodebug
//import nodebug
trace_n` _ f :== f
import code from "cUtilSystem."
LaunchTheDocument :: !String !String !Int !*a -> (!Int,!*a)
......
......@@ -10,14 +10,75 @@ import pointer;
(THEN) a f :== f a;
import StdMisc;
//import dodebug;
trace_n` _ f :== f;
create_application_resource :: !{#Char} !ResourceClass !Bool (!Int, !{#Char}) !Int !Int !Int !Int !Int !Int !Int !*Files -> (!Bool,!*Files);
create_application_resource file_name r_class application_existed font_info heap_size heap_size_multiple stack_size flags application_and_extra_memory_size initial_heap_size memory_profile_minimum_heap_size files
| trace_n` ("car",file_name) False//True
= (False,files);
# (error_n,t1)= if application_existed
(SetFileType "APPL" file_name NewToolbox)
(SetFileTypeAndCreator "APPL" "\0\0\0\0" file_name NewToolbox);
| trace_n` ("car0",application_existed,file_name) error_n<>0
= (False,files);
# (ref_num,t2)=open_resource_file t1;
| trace_n` ("car1",error_n,ref_num) ref_num==(-1)
= (False,files);
# (ok1,t4)=case r_class of {
Classic -> add_cfrg_resource file_name stack_size t2;
Carbon -> add_cfrg_resource file_name stack_size t2;
MachO -> (True,t2);
};
# t4 = trace_n` ("car2",ok1) t4;
# (ok2,t5)=add_sthp_resource heap_size heap_size_multiple stack_size flags initial_heap_size t4;
# t5 = trace_n` ("car3",ok2) t5;
# (ok3,t6)=case r_class of {
Classic -> change_size_resource (heap_size+stack_size+application_and_extra_memory_size) t5;
Carbon -> change_size_resource (heap_size+stack_size+application_and_extra_memory_size) t5;
MachO -> (True,t5);
};
# t6 = trace_n` ("car4",ok3) t6;
# (ok4,t7)=add_prfl_resource memory_profile_minimum_heap_size t6;
# t7 = trace_n` ("car5",ok4) t7;
# (ok5,t8)=add_font_resource font_info t7;
# t8 = trace_n` ("car6",ok5) t8;
# (ok6,t9)=case r_class of {
Classic -> (True,t8);
Carbon -> add_carb_resource t8;
MachO -> add_carb_resource t8;//(True,t8);
};
# t9 = trace_n` ("car7",ok6) t9;
# (res_error,_)=ResError (CloseResFile ref_num t9);
| trace_n` ("car8",res_error) res_error<>0 /* || not ok0 */ || not ok1 || not ok2 || not ok3 || not ok4 || not ok5 || not ok6
= (False,files);
= (True,files);
{}{
open_resource_file t0
| ref_num0<>(-1)
= (ref_num0,t2); {
t2 = t1
THEN remove_resource "PRFL" 128
THEN remove_resource "Font" 128
THEN remove_resource "SIZE" 0
THEN remove_resource "SIZE" 1
THEN remove_resource "STHP" 0
THEN remove_resource "cfrg" 0
THEN remove_resource "carb" 0;
}
= (HOpenResFile 0 0 file_name 3 (HCreateResFile 0 0 file_name t1));
{}{
(ref_num0,t1)=HOpenResFile 0 0 file_name 3 t0;
}
}
/*
create_application_resource :: !{#Char} !ResourceClass /* RWS ... */ !Bool /* ... RWS */ (!Int, !{#Char}) !Int !Int !Int !Int !Int !Int !Int !*Files -> (!Bool,!*Files);
create_application_resource file_name r_class /* RWS ... */ application_existed /* ... RWS */ font_info heap_size heap_size_multiple stack_size flags application_and_extra_memory_size initial_heap_size memory_profile_minimum_heap_size files
| error_n<>0
= (False,files);
| ref_num==(-1)
= (False,files);
| res_error<>0 /* || not ok0 */ || not ok1 || not ok2 || not ok3 || not ok4
| res_error<>0 /* || not ok0 */ || not ok1 || not ok2 || not ok3 || not ok4 || not ok5
= (False,files);
= (True,files);
{}{
......@@ -89,7 +150,7 @@ create_application_resource file_name r_class /* RWS ... */ application_existed
(ref_num0,t1)=HOpenResFile 0 0 file_name 3 t0;
}
}
*/
remove_resource resource_name n t0
| handle==0
= t1;
......
......@@ -26,10 +26,11 @@ import interrupt,Platform
from Directory import :: Date`(..), :: Time`(..)
//from dodebug import trace_n`
import nodebug
//import nodebug
//import dodebug
trace_n _ g :== g
trace_n` _ g :== g
//from StdDebug import trace_r
//--
verboseInfo verbose info ps :== verbi verbose info ps
......
......@@ -185,7 +185,11 @@ fulPath :: !Pathname !Pathname !Pathname -> Pathname
fulPath ap pp l
# l = replace_prefix_path "{Application}" ap l
l = replace_prefix_path "{Project}" pp l
= l
// ensure full pathname is just that...
| IsFullPathname l
= l
// if not put it in the project directory...
= MakeFullPathname pp l
symPaths :: !Pathname !Pathname !(List Pathname) -> List Pathname
symPaths ap pp l = Map (symPath ap pp) l
......
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