Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
32d8985e
Commit
32d8985e
authored
Oct 14, 2003
by
Diederik van Arkel
Browse files
Assorted fixes for alpha 1
parent
8f6d3c74
Changes
11
Hide whitespace changes
Inline
Side-by-side
Ed/EdTab.icl
View file @
32d8985e
...
...
@@ -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
...
...
Ed/syncol.icl
View file @
32d8985e
...
...
@@ -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
...
...
Ide/IDE.icl
View file @
32d8985e
...
...
@@ -59,10 +59,10 @@ Start world
=
abort
(
"Missing directory for preferences:
\n
"
+++
PrefsDir
+++
"
\n
Unable to create it.
\n
"
)
#
(
ok
,
world
)
=
ensureDirectory
EnvsDir
world
|
not
ok
=
abort
(
"Missing directory for
preference
s:
\n
"
+++
Pref
sDir
+++
"
\n
Unable to create it.
\n
"
)
=
abort
(
"Missing directory for
environment
s:
\n
"
+++
Env
sDir
+++
"
\n
Unable to create it.
\n
"
)
#
(
ok
,
world
)
=
ensureDirectory
TempDir
world
|
not
ok
=
abort
(
"Missing directory for
preferenc
es:
\n
"
+++
Prefs
Dir
+++
"
\n
Unable to create it.
\n
"
)
=
abort
(
"Missing directory for
temporary fil
es:
\n
"
+++
Temp
Dir
+++
"
\n
Unable to create it.
\n
"
)
#
prefspath
=
MakeFullPathname
PrefsDir
PrefsFileName
#!
(
prefs
,
world
)
=
openPrefs
prefspath
world
...
...
Ide/PmDialogues.icl
View file @
32d8985e
...
...
@@ -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
...
...
Ide/projwin.icl
View file @
32d8985e
...
...
@@ -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
def
path
emptySelection
ps
=
ed_open_path_sel
path
emptySelection
ps
#
imppath
=
MakeImpPathname
root
=
O
pen
Module
imppath
emptySelection
ps
=
o
pen
_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
def
path
ps
#
path
=
dirpath
+++
defpath
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
OpenModule
def
path
emptySelection
ps
=
ed_open_path_sel
path
emptySelection
ps
#
lhspath
=
RemoveSuffix
mod
+++
".lhs"
//
#
(exists,ps) = accFiles (FExists
lhspath
) ps
#
(
exists
,
ps
)
=
exists_module
lhs
path
ps
#
path
=
dirpath
+++
lhspath
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
OpenModule
lhs
path
emptySelection
ps
=
ed_open_path_sel
path
emptySelection
ps
#
hspath
=
RemoveSuffix
mod
+++
".hs"
//
#
(exists,ps) = accFiles (FExists
hspath
) ps
#
(
exists
,
ps
)
=
exists_module
hs
path
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
def
path
ps
#
path
=
dirpath
+++
defpath
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
OpenModule
def
path
emptySelection
ps
=
ed_open_path_sel
path
emptySelection
ps
#
lhspath
=
RemoveSuffix
mod
+++
".lhs"
//
#
(exists,ps) = accFiles (FExists
lhspath
) ps
#
(
exists
,
ps
)
=
exists_module
lhs
path
ps
#
path
=
dirpath
+++
lhspath
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
OpenModule
lhs
path
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
...
...
Mac/Platform.icl
View file @
32d8985e
...
...
@@ -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"
}
...
...
Mac/PmCleanSystem.icl
View file @
32d8985e
...
...
@@ -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
n
odebug
//
import
d
odebug
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
)
=
fopen
a
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
)
=
fopen
b
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
;
...
...
Mac/UtilIO.icl
View file @
32d8985e
...
...
@@ -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
)
...
...
Mac/linker_resources.icl
View file @
32d8985e
...
...
@@ -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
;
...
...
Pm/PmDriver.icl
View file @
32d8985e
...
...
@@ -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
...
...
Pm/PmPath.icl
View file @
32d8985e
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment