* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.14 $
- * $Date: 1999/10/19 23:51:57 $
+ * $Revision: 1.41 $
+ * $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
#include "prelude.h"
#include "storage.h"
-#include "command.h"
-#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "version.h"
-#include "link.h"
#include "Rts.h"
#include "RtsAPI.h"
#include "Schedule.h"
-
+#include "Assembler.h" /* DEBUG_LoadSymbols */
Bool haskell98 = TRUE; /* TRUE => Haskell 98 compatibility*/
static Void local setLastEdit Args((String,Int));
static Void local failed Args((Void));
static String local strCopy Args((String));
-static Void local browseit Args((Module,String));
+static Void local browseit Args((Module,String,Bool));
static Void local browse Args((Void));
/* --------------------------------------------------------------------------
* Machine dependent code for Hugs interpreter:
* ------------------------------------------------------------------------*/
+ Bool combined = TRUE;
+
#include "machdep.c"
#ifdef WANT_TIMER
#include "timer.c"
* Local data areas:
* ------------------------------------------------------------------------*/
-static Bool printing = FALSE; /* TRUE => currently printing value*/
-static Bool showStats = FALSE; /* TRUE => print stats after eval */
-static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
-static Bool addType = FALSE; /* TRUE => print type with value */
-static Bool useDots = RISCOS; /* TRUE => use dots in progress */
-static Bool quiet = FALSE; /* TRUE => don't show progress */
+static Bool printing = FALSE; /* TRUE => currently printing value*/
+static Bool showStats = FALSE; /* TRUE => print stats after eval */
+static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
+static Bool addType = FALSE; /* TRUE => print type with value */
+static Bool useDots = RISCOS; /* TRUE => use dots in progress */
+static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE;
Bool preludeLoaded = FALSE;
- Bool optimise = FALSE;
+ Bool debugSC = FALSE;
typedef
struct {
String hugsEdit = 0; /* String for editor command */
String hugsPath = 0; /* String for file search path */
+ List ifaces_outstanding = NIL;
+
#if REDIRECT_OUTPUT
static Bool disableOutput = FALSE; /* redirect output to buffer? */
#endif
scriptInfo[i].path
);
}
- // printf ( "\n" );
fflush(stdout);fflush(stderr);
-ppScripts();
-ppModules();
+ ppScripts();
+ ppModules();
printf ( "\n" );
}
CStackBase = &argc; /* Save stack base for use in gc */
- /* Try and figure out an absolute path to the executable, so
- we can make a reasonable guess about where the default
- libraries (Prelude etc) are.
- */
- setDefaultLibDir ( argv[0] );
-
/* If first arg is +Q or -Q, be entirely silent, and automatically run
main after loading scripts. Useful for running the nofib suite. */
if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
autoMain = TRUE;
- hugsEnableOutput(0);
+ if (strcmp(argv[1],"-Q") == 0) {
+ hugsEnableOutput(0);
+ }
}
Printf("__ __ __ __ ____ ___ _________________________________________\n");
- Printf("|| || || || || || ||__ Hugs 98: Based on the Haskell 98 standard\n");
+ Printf("|| || || || || || ||__ STGHugs: Based on the Haskell 98 standard\n");
Printf("||___|| ||__|| ||__|| __|| Copyright (c) 1994-1999\n");
Printf("||---|| ___|| World Wide Web: http://haskell.org/hugs\n");
Printf("|| || Report bugs to: hugs-bugs@haskell.org\n");
Printf("|| || Version: %s _________________________________________\n\n",HUGS_VERSION);
+ /* Get the absolute path to the directory containing the hugs
+ executable, so that we know where the Prelude and nHandle.so/.dll are.
+ We do this by reading env var STGHUGSDIR. This needs to succeed, so
+ setInstallDir won't return unless it succeeds.
+ */
+ setInstallDir ( argv[0] );
+
#if SYMANTEC_C
Printf(" Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
#endif
startupHaskell (argc,argv);
argc = prog_argc; argv = prog_argv;
- namesUpto = numScripts = 0;
- addStackEntry("Prelude");
+ namesUpto = numScripts = 0;
+
+ /* Pre-scan flags to see if -c or +c is present. This needs to
+ precede adding the stack entry for Prelude. On the other hand,
+ that stack entry needs to be made before the cmd line args are
+ properly examined. Hence the following pre-scan of them.
+ */
+ for (i=1; i < argc; ++i) {
+ if (strcmp(argv[i], "--")==0) break;
+ if (strcmp(argv[i], "-c")==0) combined = FALSE;
+ if (strcmp(argv[i], "+c")==0) combined = TRUE;
+ }
- for (i=1; i<argc; ++i) { /* process command line arguments */
+ addStackEntry("Prelude");
+ if (combined) addStackEntry("PrelHugs");
+
+ for (i=1; i < argc; ++i) { /* process command line arguments */
if (strcmp(argv[i], "--")==0) break;
if (strcmp(argv[i],"+")==0 && i+1<argc) {
if (proj) {
}
}
-#ifdef DEBUG
- DEBUG_LoadSymbols(argv_0_orig);
+#if DEBUG
+ {
+ char exe_name[N_INSTALLDIR + 6];
+ strcpy(exe_name, installDir);
+ strcat(exe_name, "hugs");
+ DEBUG_LoadSymbols(exe_name);
+ }
#endif
-
#if 0
if (!scriptName[0]) {
Printf("Prelude not found on current path: \"%s\"\n",
#endif
if (haskell98) {
- Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n\n");
+ Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n");
+ } else {
+ Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n");
+ }
+
+ if (combined) {
+ Printf("Combined mode: Restart with command line -c for standalone mode\n\n" );
} else {
- Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n\n");
+ Printf("Standalone mode: Restart with command line +c for combined mode\n\n" );
}
- everybody(INSTALL);
+ everybody(PREPREL);
+
evalModule = findText(""); /* evaluate wrt last module by default */
if (proj) {
if (namesUpto>1) {
case 'h' : setHeapSize(s+1);
return TRUE;
+ case 'c' : if (heapBuilt()) {
+ FPrintf(stderr,
+ "You can't enable/disable combined"
+ " operation inside Hugs\n" );
+ } else {
+ /* don't do anything, since pre-scan of args
+ will have got it already */
+ }
+ return TRUE;
+
case 'D' : /* hack */
{
extern void setRtsFlags( int x );
default : if (strcmp("98",s)==0) {
if (heapBuilt() && ((state && !haskell98) ||
(!state && haskell98))) {
- FPrintf(stderr,"Haskell 98 compatibility cannot be changed while the interpreter is running\n");
+ FPrintf(stderr,
+ "Haskell 98 compatibility cannot be changed"
+ " while the interpreter is running\n");
} else {
haskell98 = state;
}
#if USE_REGISTRY
FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
#else
- FPrintf(stderr,"Cannot change heap size\n");
+ FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
#endif
} else {
heapSize = hpSize;
{'w', 1, "Always show which modules are loaded", &listScripts},
{'k', 1, "Show kind errors in full", &kindExpert},
{'o', 0, "Allow overlapping instances", &allowOverlap},
- {'O', 1, "Optimise (improve?) generated code", &optimise},
-
-
-#if DEBUG_CODE
- {'D', 1, "Debug: show generated code", &debugCode},
-#endif
+ {'S', 1, "Debug: show generated SC code", &debugSC},
#if EXPLAIN_INSTANCE_RESOLUTION
{'x', 1, "Explain instance resolution", &showInstRes},
#endif
#if MULTI_INST
{'m', 0, "Use multi instance resolution", &multiInstRes},
#endif
-#if DEBUG_CODE
- {'D', 1, "Debug: show generated G code", &debugCode},
-#endif
-#if DEBUG_SHOWSC
- {'S', 1, "Debug: show generated SC code", &debugSC},
-#endif
-#if 0
- {'f', 1, "Terminate evaluation on first error", &failOnError},
- {'u', 1, "Use \"show\" to display results", &useShow},
- {'i', 1, "Chase imports while loading modules", &chaseImports},
-#endif
{0, 0, 0, 0}
};
currProject = s;
projInput(currProject);
scriptFile = currProject;
- forgetScriptsFrom(1);
+ forgetScriptsFrom(N_PRELUDE_SCRIPTS);
while ((s=readFilename())!=0)
addStackEntry(s);
if (namesUpto<=1) {
);
if (!ok) {
ERRMSG(0)
- /* "Can't file source or object+interface for module \"%s\"", */
- "Can't file source for module \"%s\"",
+ "Can't find source or object+interface for module \"%s\"",
+ /* "Can't find source for module \"%s\"", */
iname
EEND;
}
/* Load objects in preference to sources if both are available */
/* 11 Oct 99: disable object loading in the interim.
Will probably only reinstate when HEP becomes available.
- fromObj = sAvail
+ */
+ if (combined) {
+ fromObj = sAvail
? (oAvail && iAvail && timeEarlier(sTime,oTime))
: TRUE;
- */
- fromObj = FALSE;
+ } else {
+ fromObj = FALSE;
+ }
/* ToDo: namesUpto overflow */
ent->modName = strCopy(iname);
static Void nukeEnding( String s )
{
Int l = strlen(s);
- if (l > 2 && strncmp(s+l-2,".o" ,3)==0) s[l-2] = 0; else
- if (l > 3 && strncmp(s+l-3,".hi" ,3)==0) s[l-3] = 0; else
- if (l > 3 && strncmp(s+l-3,".hs" ,3)==0) s[l-3] = 0; else
- if (l > 4 && strncmp(s+l-4,".lhs",4)==0) s[l-4] = 0; else
- if (l > 4 && strncmp(s+l-4,".dll",4)==0) s[l-4] = 0; else
- if (l > 4 && strncmp(s+l-4,".DLL",4)==0) s[l-4] = 0;
+ if (l > 4 && strncmp(s+l-4,".u_o" ,4)==0) s[l-4] = 0; else
+ if (l > 5 && strncmp(s+l-5,".u_hi",5)==0) s[l-5] = 0; else
+ if (l > 3 && strncmp(s+l-3,".hs" ,3)==0) s[l-3] = 0; else
+ if (l > 4 && strncmp(s+l-4,".lhs" ,4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".dll" ,4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".DLL" ,4)==0) s[l-4] = 0;
}
static Void local addStackEntry(s) /* Add script to list of scripts */
/* Return TRUE if no imports were needed; FALSE otherwise. */
static Bool local addScript(stacknum) /* read single file */
Int stacknum; {
+ Bool didPrelude;
static char name[FILENAME_MAX+1];
Int len = scriptInfo[stacknum].size;
// setLastEdit(name,0);
- nameObj[0] = 0;
strcpy(name, scriptInfo[stacknum].path);
strcat(name, scriptInfo[stacknum].modName);
if (scriptInfo[stacknum].fromSource)
strcat(name, scriptInfo[stacknum].srcExt); else
- strcat(name, ".hi");
+ strcat(name, ".u_hi");
scriptFile = name;
if (scriptInfo[stacknum].fromSource) {
- if (lastWasObject) finishInterfaces();
+ if (lastWasObject) {
+ didPrelude = processInterfaces();
+ if (didPrelude) {
+ preludeLoaded = TRUE;
+ everybody(POSTPREL);
+ }
+ }
lastWasObject = FALSE;
Printf("Reading script \"%s\":\n",name);
needsImports = FALSE;
typeCheckDefns();
compileDefns();
} else {
+ Cell iface;
+ List imports;
+ ZTriple iface_info;
+ char nameObj[FILENAME_MAX+1];
+ Int sizeObj;
+
Printf("Reading iface \"%s\":\n", name);
scriptFile = name;
needsImports = FALSE;
strcat(nameObj, DLL_ENDING);
sizeObj = scriptInfo[stacknum].oSize;
- loadInterface(name,len);
+ iface = readInterface(name,len);
+ imports = zsnd(iface); iface = zfst(iface);
+
+ if (nonNull(imports)) chase(imports);
scriptFile = 0;
lastWasObject = TRUE;
+
+ iface_info = ztriple(iface, findText(nameObj), mkInt(sizeObj) );
+ ifaces_outstanding = cons(iface_info,ifaces_outstanding);
+
if (needsImports) return FALSE;
}
scriptFile = 0;
- preludeLoaded = TRUE;
+
return TRUE;
}
/* to be read */
while ((s=readFilename())!=0)
addStackEntry(s);
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local project() { /* read list of script names from */
EEND;
}
loadProject(s);
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local readScripts(n) /* Reread current list of scripts, */
Time timeStamp; /* including the first script which*/
Long fileSize; /* has been either changed or added*/
static char name[FILENAME_MAX+1];
+ Bool didPrelude;
lastWasObject = FALSE;
ppSmStack("readscripts-begin");
strcat(name, scriptInfo[n].modName);
if (scriptInfo[n].fromSource)
strcat(name, scriptInfo[n].srcExt); else
- strcat(name, ".hi"); //ToDo: should be .o
+ strcat(name, ".u_hi"); //ToDo: should be .o
getFileInfo(name,&timeStamp, &fileSize);
if (timeChanged(timeStamp,scriptInfo[n].lastChange)) {
dropScriptsFrom(n-1);
//numScripts = 0;
while (numScripts < namesUpto) {
-ppSmStack ( "readscripts-loop2" );
+ ppSmStack ( "readscripts-loop2" );
if (scriptInfo[numScripts].fromSource) {
nextNumScripts = NUM_SCRIPTS; //bogus initialisation
if (addScript(numScripts)) {
numScripts++;
-assert(nextNumScripts==NUM_SCRIPTS);
+ assert(nextNumScripts==NUM_SCRIPTS);
}
else
dropScriptsFrom(numScripts-1);
nextNumScripts = NUM_SCRIPTS;
if (addScript(numScripts)) {
numScripts++;
-assert(nextNumScripts==NUM_SCRIPTS);
+ assert(nextNumScripts==NUM_SCRIPTS);
} else {
//while (!scriptInfo[numScripts].fromSource && numScripts > 0)
// numScripts--;
//if (scriptInfo[numScripts].fromSource)
// numScripts++;
numScripts = nextNumScripts;
-assert(nextNumScripts<NUM_SCRIPTS);
+ assert(nextNumScripts<NUM_SCRIPTS);
}
}
}
-if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
+ if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
+ }
+
+ didPrelude = processInterfaces();
+ if (didPrelude) {
+ preludeLoaded = TRUE;
+ everybody(POSTPREL);
}
- finishInterfaces();
{ Int m = namesUpto-1;
Text mtext = findText(scriptInfo[m].modName);
+
+ /* Hack to avoid starting up in PrelHugs */
+ if (mtext == findText("PrelHugs")) mtext = findText("Prelude");
+
+
/* Commented out till we understand what
* this is trying to do.
* Problem, you cant find a module till later.
startNewScript(0);
if (nonNull(c=findTycon(t=findText(nm)))) {
if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
} else if (nonNull(c=findName(t))) {
if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
} else {
ERRMSG(0) "No current definition for name \"%s\"", nm
static Void local runEditor() { /* run editor on script lastEdit */
if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine */
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local setLastEdit(fname,line)/* keep name of last file to edit */
/* allocated during evaluation */
parseExp();
checkExp();
- defaultDefns = evalDefaults;
+ defaultDefns = combined ? stdDefaults : evalDefaults;
type = typeCheckExp(TRUE);
+
if (isPolyType(type)) {
ks = polySigOf(type);
bd = monotypeOf(type);
#endif
#if 1
- if (typeMatches(type,ap(typeIO,typeUnit))) {
- inputExpr = ap(nameRunIO,inputExpr);
+ if (isProgType(ks,bd)) {
+ inputExpr = ap(nameRunIO_toplevel,inputExpr);
evalExp();
Putchar('\n');
} else {
ERRTEXT "\n"
EEND;
}
- inputExpr = ap2(findName(findText("show")),d,inputExpr);
- inputExpr = ap(findName(findText("putStr")), inputExpr);
- inputExpr = ap(nameRunIO, inputExpr);
+ inputExpr = ap2(nameShow, d,inputExpr);
+ inputExpr = ap (namePutStr, inputExpr);
+ inputExpr = ap (nameRunIO_toplevel, inputExpr);
evalExp(); printf("\n");
if (addType) {
}
-static Void local browseit(mod,t)
+static Void local browseit(mod,t,all)
Module mod;
-String t; {
-#if 0
- /* AJG: DISABLED FOR NOW */
+String t;
+Bool all; {
if (nonNull(mod)) {
Cell cs;
- Printf("module %s where\n",textToStr(module(mod).text));
+ if (nonNull(t))
+ Printf("module %s where\n",textToStr(module(mod).text));
for (cs = module(mod).names; nonNull(cs); cs=tl(cs)) {
Name nm = hd(cs);
- /* only look at things defined in this module */
- if (name(nm).mod == mod) {
+ /* only look at things defined in this module,
+ unless `all' flag is set */
+ if (all || name(nm).mod == mod) {
/* unwanted artifacts, like lambda lifted values,
are in the list of names, but have no types */
if (nonNull(name(nm).type)) {
} else if (isSfun(nm)) {
Printf(" -- selector function");
}
- if (name(nm).primDef) {
- Printf(" -- primitive");
- }
Printf("\n");
}
}
Printf("Unknown module %s\n",t);
}
}
-#endif
}
static Void local browse() { /* browse modules */
Int count = 0; /* or give menu of commands */
String s;
+ Bool all = FALSE;
setCurrModule(findEvalModule());
startNewScript(0); /* for recovery of storage */
- for (; (s=readFilename())!=0; count++) {
- browseit(findModule(findText(s)),s);
- }
+ for (; (s=readFilename())!=0; count++)
+ if (strcmp(s,"all") == 0) {
+ all = TRUE;
+ --count;
+ } else
+ browseit(findModule(findText(s)),s,all);
if (count == 0) {
- whatScripts();
+ browseit(findEvalModule(),NULL,all);
}
}
#if EXPLAIN_INSTANCE_RESOLUTION
static Void local xplain() { /* print type of expression (if any)*/
- Cell type;
Cell d;
Bool sir = showInstRes;
extern Name nameHw;
+static Void dumpStg ( void )
+{
+ String s;
+ Int i;
+ setCurrModule(findEvalModule());
+ startNewScript(0);
+ s = readFilename();
+
+ /* request to locate a symbol by name */
+ if (s && (*s == '?')) {
+ Text t = findText(s+1);
+ locateSymbolByName(t);
+ return;
+ }
+
+ /* request to dump a bit of the heap */
+ if (s && (*s == '-' || isdigit(*s))) {
+ int i = atoi(s);
+ print(i,100);
+ printf("\n");
+ return;
+ }
+
+ /* request to dump a symbol table entry */
+ if (!s
+ || !(*s == 't' || *s == 'n' || *s == 'c' || *s == 'i')
+ || !isdigit(s[1])) {
+ fprintf(stderr, ":d -- bad request `%s'\n", s );
+ return;
+ }
+ i = atoi(s+1);
+ switch (*s) {
+ case 't': dumpTycon(i); break;
+ case 'n': dumpName(i); break;
+ case 'c': dumpClass(i); break;
+ case 'i': dumpInst(i); break;
+ default: fprintf(stderr, ":d -- `%c' not implemented\n", *s );
+ }
+}
+
+
+#if 0
static Void local dumpStg( void ) { /* print STG stuff */
String s;
Text t;
if (isNull(n) && whatIs(v)==STGVAR) {
Printf ( "\n{- `%s' has no nametable entry -}\n", s );
- Printf ( "{- stgSize of body is %d -}\n\n", stgSize(stgVarBody(v)));
printStg(stderr, v );
} else
if (isNull(n)) {
Printf ( "Doesn't have a STG tree: %s\n", s );
} else {
Printf ( "\n{- stgVar of `%s' is id%d -}\n", s, -name(n).stgVar);
- Printf ( "{- stgSize of body is %d -}\n\n",
- stgSize(stgVarBody(name(n).stgVar)));
printStg(stderr, name(n).stgVar);
}
}
}
+#endif
static Void local info() { /* describe objects */
Int count = 0; /* or give menu of commands */
Printf(" => ");
}
printPred(stdout,cclass(cl).head);
-#if 0
- /* AJG: commented out for now */
+
if (nonNull(cclass(cl).fds)) {
List fds = cclass(cl).fds;
String pre = " | ";
pre = ", ";
}
}
-#endif
+
if (nonNull(cclass(cl).members)) {
List ms = cclass(cl).members;
Printf(" where");
do {
- Type t = monotypeOf(name(hd(ms)).type);
+ Type t = name(hd(ms)).type;
+ if (isPolyType(t)) {
+ t = monotypeOf(t);
+ }
Printf("\n ");
printExp(stdout,hd(ms));
Printf(" :: ");
} else {
Printf("<unknown type>");
}
-
if (isCfun(nm)) {
Printf(" -- data constructor");
} else if (isMfun(nm)) {
forHelp();
}
+ /* initialize calls startupHaskell, which trashes our signal handlers */
+ breakOn(TRUE);
+
for (;;) {
Command cmd;
everybody(RESET); /* reset to sensible initial state */
case FIND : find();
break;
case LOAD : clearProject();
- forgetScriptsFrom(1);
+ forgetScriptsFrom(N_PRELUDE_SCRIPTS);
load();
break;
case ALSO : clearProject();
forgetScriptsFrom(numScripts);
load();
break;
- case RELOAD : readScripts(1);
+ case RELOAD : readScripts(N_PRELUDE_SCRIPTS);
break;
case PROJECT: project();
break;
Void setGoal(what, t) /* Set goal for what to be t */
String what;
Target t; {
- if (quiet) return;
+ if (quiet)
+ return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+ if (showInstRes)
+ return;
+#endif
currTarget = (t?t:1);
aiming = TRUE;
if (useDots) {
Void soFar(t) /* Indicate progress towards goal */
Target t; { /* has now reached t */
- if (quiet) return;
+ if (quiet)
+ return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+ if (showInstRes)
+ return;
+#endif
if (useDots) {
Int newPos = (Int)((maxPos * ((long)t))/currTarget);
}
Void done() { /* Goal has now been achieved */
- if (quiet) return;
+ if (quiet)
+ return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+ if (showInstRes)
+ return;
+#endif
if (useDots) {
while (maxPos>currPos++)
Putchar('.');
Void everybody(what) /* send command `what' to each component of*/
Int what; { /* system to respond as appropriate ... */
+#if 0
+ fprintf ( stderr, "EVERYBODY %d\n", what );
+#endif
machdep(what); /* The order of calling each component is */
- storage(what); /* important for the INSTALL command */
+ storage(what); /* important for the PREPREL command */
substitution(what);
input(what);
translateControl(what);
typeChecker(what);
compiler(what);
codegen(what);
- optimiser(what);
}
/* --------------------------------------------------------------------------