Commit 4d012655 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

removed CleanIDE's own version of Directory and ArgEnvWindows

use the standard modules instead
parent 715f234c
......@@ -4,7 +4,7 @@ import StdFile, StdMaybe
import UtilStrictLists, StdPathname
from UtilDate import :: DATE
from PmTypes import :: LinkObjFileName, :: LinkLibraryName, :: Modulename
from Directory import :: DateTime, :: Date`, :: Time`
from Directory import :: DateTime, :: Date, :: Time
from PmDirCache import :: DirCache
// Compiler options that are stored in the abc file
......
......@@ -12,7 +12,7 @@ import UtilNewlinesFile
import PmDirCache
from PmTypes import :: LinkObjFileName, :: LinkLibraryName
from Directory import :: Date`(..), :: Time`(..)
from StdLibMisc import :: Date{..}, :: Time{..}
//import RWSDebug
(->>) l r :== l
......@@ -310,7 +310,7 @@ where
= ((modnames, Just moddate, depdates, objnames, libnames), False)
= ((modnames, mmoddate, depdates, objnames, libnames), False)
where
emptydate = ({year`=0,month`=0,day`=0,dayNr`=0},{hours`=0,minutes`=0,seconds`=0})
emptydate = ({year=0,month=0,day=0,dayNr=0},{hours=0,minutes=0,seconds=0})
len_str = size str
start = SkipSpaces 0 len_str str
stop_endinfo = start + 7; // dec (size ".endinfo")
......@@ -369,13 +369,13 @@ DT2S :: !DateTime -> String
DT2S (date,time) = "\"" +++ yyyymmddnhhmmss +++"\""
where
yyyymmddnhhmmss = yyyy +++ mm +++ dd /*+++ nn*/ +++ hs +++ ms +++ ss
yyyy = pad 4 date.year`
mm = pad 2 date.month`
dd = pad 2 date.day`
// nn = pad 1 date.dayNr`
hs = pad 2 time.hours`
ms = pad 2 time.minutes`
ss = pad 2 time.seconds`
yyyy = pad 4 date.year
mm = pad 2 date.month
dd = pad 2 date.day
// nn = pad 1 date.dayNr
hs = pad 2 time.hours
ms = pad 2 time.minutes
ss = pad 2 time.seconds
pad n x
# s = toString x
# l = size s
......@@ -385,8 +385,8 @@ where
S2DT :: !String -> DateTime
S2DT s = (date,time)
where
date = {year`=yy,month`=mm,day`=dd,dayNr`=nn}
time = {hours`=hs,minutes`=ms,seconds`=ss}
date = {year=yy,month=mm,day=dd,dayNr=nn}
time = {hours=hs,minutes=ms,seconds=ss}
yy = toInt (s%(0,3))
mm = toInt (s%(4,5))
dd = toInt (s%(6,7))
......
......@@ -5,7 +5,7 @@ from StdFile import :: Files
from UtilStrictLists import :: List
from PmTypes import :: Modulename
from StdPathname import :: Pathname
from Directory import :: DateTime, :: Date`, :: Time`
from Directory import :: DateTime, :: Date{..}, :: Time{..}
:: DirCache
......
......@@ -4,14 +4,16 @@ implementation module PmDirCache
import StdArray, StdBool, StdEnum, StdList, StdOrdList
import StdFile, StdMaybe
from StdLibMisc import :: Date{..}, :: Time{..}
import Directory
import UtilStrictLists, PmPath, UtilIO
import Platform
:: DirCache :== {(String,String,DateTime)} // module name, module path, module modified
emptyDateTime :== ({year`=0,month`=0,day`=0,dayNr`=0},{hours`=0,minutes`=0,seconds`=0})
emptyDateTime :== ({year=0,month=0,day=0,dayNr=0},{hours=0,minutes=0,seconds=0})
:: Warn = Warn String String [(String,String,DateTime)]
......
......@@ -23,7 +23,7 @@ import PmFileInfo
import PmDirCache
import interrupt,Platform
from Directory import :: Date`(..), :: Time`(..)
from StdLibMisc import :: Date{..}, :: Time{..}
//from dodebug import trace_n`
//import nodebug
......@@ -890,7 +890,7 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
where
DATEtoDateTime :: !DATE -> DateTime
DATEtoDateTime {DATE | yy,mm,dd,h,m,s}
= ({year`=yy,month`=mm,day`=dd,dayNr`=0},{hours`=h,minutes`=m,seconds`=s})
= ({year=yy,month=mm,day=dd,dayNr=0},{hours=h,minutes=m,seconds=s})
step intr DDone ps
= stop (DDone,ps)
......@@ -1359,12 +1359,12 @@ where
moretricks _ _ _ _ = abort "driver.icl: Fooling Clean warnings"
eqDate (ld,lt) (rd,rt)
| lt.seconds` <> rt.seconds` = False
| lt.minutes` <> rt.minutes` = False
| lt.hours` <> rt.hours` = False
| ld.day` <> rd.day` = False
| ld.month` <> rd.month` = False
| ld.year` <> rd.year` = False
| lt.seconds <> rt.seconds = False
| lt.minutes <> rt.minutes = False
| lt.hours <> rt.hours = False
| ld.day <> rd.day = False
| ld.month <> rd.month = False
| ld.year <> rd.year = False
= True
check_module_options :: !String !.FileInfo !.CompilerOptions !.Bool !.Bool !.Bool !.Int -> (.Bool,{#Char});
......
/*
Version 1.0.1
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
definition module ArgEnv
:: EnvironmentVariable
= EnvironmentVariableUndefined
| EnvironmentVariable !.{#Char}
// get the value of an environment variable
getEnvironmentVariable :: !{#Char} -> *EnvironmentVariable
// get the command line, first element is the command name,
// arguments that are interpreted by the run-time system
// (for example to set the heap size) are excluded
// Clean 1.1: getCommandLine :: {{#Char}}
getCommandLine :: {.{#Char}}
implementation module ArgEnv
import code from "ArgEnvC.obj" // DvA
/*2.0
import StdEnv
0.2*/
//1.3
import StdArray, StdBool, StdString, StdEnum
//3.1
:: CString :== Int
NULL :== 0
:: EnvironmentVariable
= EnvironmentVariableUndefined
| EnvironmentVariable !.{#Char}
getEnvSize :: !{#Char} -> Int
getEnvSize _
= code {
.inline getEnv
ccall ArgEnvGetEnvironmentVariableSizeC "S-I"
.end
}
copyEnv :: !Int !{#Char} -> {#.Char}
copyEnv _ _
= code {
.inline getEnv
| Clean 1.1: use create_array
| pushC '?'
| push_b 1
| update_b 1 2
| update_b 0 1
| pop_b 1
| create_array CHAR 0 1
| Clean 1.2 and later: use create_array_
create_array_ CHAR 0 1
push_a 1
push_a 1
ccall ArgEnvGetEnvironmentVariableCharsC "SS-I"
pop_b 1
update_a 0 1
pop_a 1
.end
}
getEnvironmentVariable :: !{#Char} -> *EnvironmentVariable
getEnvironmentVariable name
| size == 0
= EnvironmentVariableUndefined
| otherwise
= EnvironmentVariable (copyEnv size name`)
where
size
= getEnvSize name`
name`
= name +++ "\0"
copy :: !Int !CString -> {#.Char}
copy length cString
= code {
.inline copy
| Clean 1.1: use create_array
| pushC '\000'
| push_b 1
| update_b 1 2
| update_b 0 1
| pop_b 1
| create_array CHAR 0 1
| Clean 1.2 and later: use create_array_
create_array_ CHAR 0 1
push_a 0
ccall ArgEnvCopyCStringToCleanStringC "IS-I"
pop_b 1
.end
}
getCommandLineCount :: Int
getCommandLineCount
= code {
.inline getCommandLineCount
ccall ArgEnvGetCommandLineCountC "-I"
.end
}
getCommandLineArgument :: !Int -> (!Int, !Int)
getCommandLineArgument _
= code {
.inline getCommandLineArgument
ccall ArgEnvGetCommandLineArgumentC "I-II"
.end
}
getArg :: !Int -> {#.Char}
getArg i
= copy size cString
where
(size, cString)
= getCommandLineArgument i
// Clean 1.1: getCommandLine :: {{#Char}}
getCommandLine :: {.{#Char}}
getCommandLine
= {getArg i \\ i <- [0 .. getCommandLineCount-1]}
/*
Version 1.0.1
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
# define kVariableSize 1
# ifndef NULL
# define NULL ((void *) 0)
# endif
/* defined by the Clean run-time system */
extern int global_argc;
extern char **global_argv;
# ifndef _WINDOWS_
# include <stdlib.h>
# endif
typedef struct
{
int length;
char characters [kVariableSize];
} *CleanString;
static int
CStringLength (char *s)
{
char *begin;
begin = s;
while (*s != '\0')
s++;
return (s - begin);
} /* CStringLength */
# ifdef _WINDOWS_
/* return size of environment variable's value (including null-terminator)
zero if variable doesn't exist */
int
ArgEnvGetEnvironmentVariableSizeC (CleanString name)
{
char smallBuffer;
/* Assume that name has been null-terminated in Clean */
return (GetEnvironmentVariableA (name->characters, &smallBuffer, 0));
} /* ArgEnvGetEnvironmentVariableSizeC */
/* copy value of environment variable to Clean string
return False if value had to be truncated */
int
ArgEnvGetEnvironmentVariableCharsC (CleanString value, CleanString name)
{
int size, length;
length = value->length;
/* Assume that name has been null-terminated in Clean */
size = GetEnvironmentVariableA (name->characters, value->characters, length);
if (size <= length)
{
size = CStringLength (value->characters);
if (size <= length)
value->length = size;
}
return (size >= value->length);
} /* ArgEnvGetEnvironmentVariableCharsC */
# else /* ifndef _WINDOWS_ */
void
ArgEnvGetEnvironmentVariableC (CleanString name, int *sizeP, char **stringP)
{
char *value;
/* Assume that name has been null-terminated in Clean */
value = getenv (name->characters);
if (value == NULL)
*sizeP = 0;
else
*sizeP = CStringLength (value);
*stringP = value;
} /* ArgEnvGetEnvironmentVariableCharsC */
# endif /* _WINDOWS_ */
int
ArgEnvGetCommandLineCountC (void)
{
return (global_argc);
} /* ArgEnvGetCommandLineCountC */
void
ArgEnvGetCommandLineArgumentC (int i, int *sizeP, char **stringP)
{
char *arg;
/* Assume that i is within bounds */
arg = global_argv [i];
*sizeP = CStringLength (arg);
*stringP = arg;
} /* ArgEnvGetCommandLineArgumentC */
/* copy C string to Clean string
return False if string had to be truncated */
int
ArgEnvCopyCStringToCleanStringC (char *cString, CleanString cleanString)
{
int i, length;
char *to;
length = cleanString->length;
to = cleanString->characters;
i = 0;
while (*cString != '\0' && i < length)
{
i++;
*to++ = *cString++;
}
cleanString->length = i;
return (i <= length);
} /* ArgEnvCopyCStringToCleanStringC */
ArgEnv
Version 1.0.1
Ronny Wichers Schreur
ronny@cs.kun.nl
The ArgEnv package provides a Clean interface to the command line
arguments and the environment variables.
This is the README for the Windows version. The Windows version has
been tested on Windows NT client 4.0 with Clean 1.2 & 1.3, but it
should work with all Windows versions with Clean 1.2 or better. To
use the package with Clean version 1.1 you will have to make a few
changes, which are documented in the source.
FILES
README
This file
ArgEnv.dcl
Definition of the interface
ArgEnv.icl
Implementation of the interface
ArgEnvC.c
Implementation of the C side of the interface
(You do not have to compile this file, it is included
in the modified cdebug.obj)
cdebug.obj
A modified version of cdebug.obj that includes the
C side of the ArgEnv interface
kernel_library
A modified version of kernel_library that defines
some extra symbols from kernel32.dll
printenv.icl
An example program that prints the value of an environment
variable
printenv.prj
Project file for the example program
USAGE
To use the ArgEnv interface you have to link the object module that
is created from the module ArgEnvC.c.
There is no easy way to link additional object files with the older
CleanIDEs (version 1.2 and before). Therefore I have made a new
cdebug.obj that contains the object code from ArgEnvC.c. You should
replace cdebug.obj in the Clean System Files of the StdEnv with the
cdebug.obj that comes with this release.
If you use CleanIDE 1.3 or later you can just add this extra object
file to the Object Modules section in the Options->Link Options dialogue.
If you forget this, you will get the link error:
Undefined symbols:
_ArgEnvGetEnvironmentVariableSizeC
_ArgEnvGetEnvironmentVariableCharsC
_ArgEnvCopyCStringToCleanStringC
_ArgEnvGetCommandLineCountC
_ArgEnvGetCommandLineArgumentC
The ArgEnv interface also uses two additional symbols from kernel32.dll.
You should replace kernel_library in the Clean System Files of the StdEnv
with the kernel_library that comes with this release. If you forget this,
you will get the link error:
Undefined symbols:
__imp__GetEnvironmentVariableA@12
BUGS
There is no way to stop the Clean run-time system from interpreting
some of the command-line arguments.
If you start a Clean program from the command-line prompt, you still
have to "press any key" before the program quits.
kernel32.dll
CloseHandle@4
CreateFileA@28
ExitProcess@4
GetCommandLineA@0
GetFileSize@8
GetLastError@0
GetStdHandle@4
GetTickCount@0
GlobalAlloc@8
GlobalFree@4
ReadFile@20
SetFilePointer@16
WriteFile@20
GetCurrentThreadId@0
WaitForSingleObject@8
CreateThread@24
CreateEventA@16
SetEvent@4
LocalFree@4
LocalHandle@4
Sleep@4
GetModuleFileNameA@12
lstrlenA@4
GetLocalTime@4
FileTimeToSystemTime@8
GetFileTime@16
GetExitCodeProcess@8
CreateProcessA@40
SetStdHandle@8
FindFirstFileA@8
FindClose@4
GlobalUnlock@4
lstrcpynA@1
GlobalLock@4
GlobalSize@4
GlobalDeleteAtom@4
GlobalAddAtomA@4
GlobalGetAtomNameA@12
lstrcmpA@8
lstrcpyA@8
AllocConsole@0
SetConsoleTitleA@4
GetConsoleMode@8
SetConsoleMode@8
GetStartupInfoA@4
TerminateThread@8
GetEnvironmentVariableA@12
lstrcpynA@12
\ No newline at end of file
/*
Version 1.0.1
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
module printenv
import StdEnv, ArgEnv
Start
| argc == 1
= format (getEnvironmentVariable argv.[1])
| otherwise
= "usage: " +++ argv.[0] +++ " <variable>\n"
where
argc
= size argv - 1
argv
= getCommandLine
format EnvironmentVariableUndefined
= ""
format (EnvironmentVariable value)
= value +++ "\n"
This diff is collapsed.
kernel32.dll
CreateDirectoryA@8
RemoveDirectoryA@4
DeleteFileA@4
GetCurrentDirectoryA@8
SetCurrentDirectoryA@4
GetLogicalDrives@0
MoveFileA@8
definition module Directory
// version 1.1
from StdFile import class FileSystem
from StdOverloaded import class toInt, class ==
// shorthands: PI="platform independent", PD="platform dependent"
getDirectoryContents :: !Path !*env -> (!(!DirError, [DirEntry]), !*env) | FileSystem env
/* error codes: NoDirError, DoesntExist, BadName, NoPermission, OtherErro
The returned list is only valid, if the error code is NoDirError */
isHidden :: !DirEntry -> Bool
/* unix: whether the filename's first character is '.'
windows/mac: the win(mac)IsHidden flag from the pd_fileInfo field */
getFileInfo :: !Path !*env -> (!(!DirError, FileInfo), !*env) | FileSystem env
/* get information about a given file/directory.
error codes: NoDirError, DoesntExist, BadName, NoPermission, OtherDirError
The returned FileInfo is only valid, if the error code is NoDirError */
createDirectory :: !Path !*env -> (!DirError, !*env) | FileSystem env
/* error codes: NoDirError, DoesntExist, BadName, NotEnoughSpace, AlreadyExists, NoPermission,
OtherDirError */
fmove :: !MoveMode !Path !Path !*env -> (!DirError, !*env) | FileSystem env
/* (fmove mode src dest) moves a file or directory src to another location dst. dst also contains
the possibly new name of the moved object. Iff (dst already exists and dst is not a directory
and mode is OverwriteFile) then dst will be replaced by src.
error codes: NoDirError, DoesntExist, BadName, NotEnoughSpace, AlreadyExists, NoPermission,
MoveIntoOffspring, MoveAcrossDisks, OtherDirError */
fremove :: !Path !*env -> (!DirError, !*env) | FileSystem env
/* removes files and empty directories.
error codes: NoDirError, DoesntExist, BadName, NoPermission, NotYetRemovable, OtherDirError */
getCurrentDirectory :: !*env -> (!Path, !*env) | FileSystem env
setCurrentDirectory :: !Path !*env -> (!DirError, !*env) | FileSystem env
/* error codes: NoDirError, DoesntExist, BadName, NoPermission, OtherDirError */
getDiskNames :: !*env -> ([DiskName], !*env) | FileSystem env
pd_StringToPath :: !String !*env -> (!(!Bool, Path), !*env) | FileSystem env
/* converts a platform dependent string representation of a path into a Path which
is only valid, if the returned Bool is True */
pathToPD_String :: !Path !*env -> (!String, !*env) | FileSystem env
// converts a Path into a platform dependent string representation of a path
encodeUnixModeBits :: !UnixModeBitsField -> UnixAccessRights
instance == DirError
:: Path
= RelativePath [PathStep]
| AbsolutePath DiskName [PathStep]
:: PathStep = PathUp | PathDown String
:: DiskName :== String
/* on UNI//Name is ignored, on DOS/Windows/MacOS the ":" is omitted,
Windows network paths are specified as an AbsolutePath whose DiskName begins with two
backslashes (\\) */
:: DirError = NoDirError | DoesntExist | BadName | NotEnoughSpace | AlreadyExists | NoPermission
| MoveIntoOffspring | MoveAcrossDisks | NotYetRemovable | OtherDirError
/* NotYetRemovable: a file can't be removed because it has not been closed yet or
a directory can't be removed because it is not empty */
:: DirEntry