Commit 820f09b2 authored by sewardj's avatar sewardj
Browse files

[project @ 1999-06-07 17:22:31 by sewardj]

Many changes needed to support loading of GHC compiled code.  The main
changes are to parser.y and interface.c to load .hi files and create
appropriate symbol table entries.  Also, interface.c has the
beginnings of and ELF loader/linker in it.
parent c6b12cd9
# ----------------------------------------------------------------------------- #
# $Id: Makefile,v 1.8 1999/04/27 10:59:29 sewardj Exp $ #
# $Id: Makefile,v 1.9 1999/06/07 17:22:54 sewardj Exp $ #
# ----------------------------------------------------------------------------- #
TOP = ../..
......@@ -17,6 +17,7 @@ YACC = bison -y
%.c: %.y
-$(YACC) $<
mv y.tab.c $@
rm -f input.o
HS_SRCS =
......@@ -24,9 +25,9 @@ HS_SRCS =
Y_SRCS = parser.y
C_SRCS = link.c type.c static.c storage.c derive.c input.c compiler.c subst.c \
translate.c codegen.c lift.c free.c stgSubst.c optimise.c output.c \
hugs.c dynamic.c stg.c sainteger.c
hugs.c dynamic.c stg.c sainteger.c interface.c
SRC_CC_OPTS = -O2 -g -I$(GHC_DIR)/interpreter -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -DCOMPILING_RTS -Wall -Wstrict-prototypes -Wno-unused
SRC_CC_OPTS = -g -I$(GHC_DIR)/interpreter -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -DCOMPILING_RTS -Wall -Wstrict-prototypes -Wno-unused
GHC_LIBS_NEEDED = $(TOP)/ghc/rts/libHSrts.a
......@@ -49,7 +50,7 @@ cleanish:
snapshot:
/bin/rm -f snapshot.tar
tar cvf snapshot.tar Makefile *.[chy] *-ORIG-* \
tar cvf snapshot.tar Makefile *.[chy] \
../rts/Assembler.c ../rts/Evaluator.c ../rts/Disassembler.c \
../rts/ForeignCall.c ../rts/Printer.c ../rts/QueueTemplate.h \
../includes/options.h ../includes/Assembler.h nHandle.c \
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: codegen.c,v $
* $Revision: 1.6 $
* $Date: 1999/04/27 10:06:48 $
* $Revision: 1.7 $
* $Date: 1999/06/07 17:22:53 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -106,15 +106,21 @@ static void cgBind( AsmBCO bco, StgVar v )
static Void pushVar( AsmBCO bco, StgVar v )
{
Cell info = stgVarInfo(v);
Cell info;
assert(isStgVar(v));
if (isPtr(info)) {
asmClosure(bco,ptrOf(info));
} else if (isInt(info)) {
asmVar(bco,intOf(info),repOf(v));
if (isCPtr(v)) {
fprintf ( stderr, "push cptr %p\n", (void*)cptrOf(v) );
} else {
internal("pushVar");
}
info = stgVarInfo(v);
if (isPtr(info)) {
asmClosure(bco,ptrOf(info));
} else if (isInt(info)) {
asmVar(bco,intOf(info),repOf(v));
} else {
internal("pushVar");
}
}
}
static Void pushAtom( AsmBCO bco, StgAtom e )
......@@ -154,6 +160,9 @@ static Void pushAtom( AsmBCO bco, StgAtom e )
asmClosure(bco,asmStringObj(textToStr(textOf(e))));
#endif
break;
case CPTRCELL:
asmConstWord(bco,cptrOf(e));
break;
case PTRCELL:
asmConstAddr(bco,ptrOf(e));
break;
......@@ -483,9 +492,13 @@ static Void build( AsmBCO bco, StgVar v )
if (isName(fun)) {
fun = name(fun).stgVar;
}
if (nonNull(stgVarBody(fun))
&& whatIs(stgVarBody(fun)) == LAMBDA
&& length(stgLambdaArgs(stgVarBody(fun))) > length(args)) {
if (isCPtr(fun)
||
(nonNull(stgVarBody(fun))
&& whatIs(stgVarBody(fun)) == LAMBDA
&& length(stgLambdaArgs(stgVarBody(fun))) > length(args)
)
) {
AsmSp start = asmBeginMkPAP(bco);
map1Proc(pushAtom,bco,reverse(args));
pushAtom(bco,fun);
......
......@@ -10,8 +10,8 @@
* in the distribution for details.
*
* $RCSfile: compiler.c,v $
* $Revision: 1.6 $
* $Date: 1999/04/27 10:06:48 $
* $Revision: 1.7 $
* $Date: 1999/06/07 17:22:46 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -181,7 +181,7 @@ Cell e; {
nv));
}
default : internal("translate");
default : fprintf(stderr, "stuff=%d\n",whatIs(e));internal("translate");
}
return e;
}
......
......@@ -7,8 +7,8 @@
* in the distribution for details.
*
* $RCSfile: connect.h,v $
* $Revision: 1.6 $
* $Date: 1999/04/27 10:06:50 $
* $Revision: 1.7 $
* $Date: 1999/06/07 17:22:45 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -497,4 +497,35 @@ extern List offsetTyvarsIn Args((Type,List));
extern Void optimiseTopBinds Args((List));
extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
extern Void interface Args((Int));
extern List typeVarsIn Args((Cell,List,List));
extern Void getFileSize Args((String, Long *));
extern Void loadInterface Args((String,Long));
extern Void openGHCIface Args((Text));
extern Void loadSharedLib Args((String));
extern Void addGHCImports Args((Int,Text,List));
extern Void addGHCExports Args((Cell,List));
extern Void addGHCVar Args((Int,Text,Type));
extern Void addGHCSynonym Args((Int,Cell,List,Type));
extern Void addGHCDataDecl Args((Int,List,Cell,List,List));
extern Void addGHCNewType Args((Int,List,Cell,List,Cell));
extern Void addGHCClass Args((Int,List,Cell,List,List));
extern Void addGHCInstance Args((Int,List,Pair,Text));
extern Void finishInterfaces Args((Void));
extern Void hi_o_namesFromSrcName Args((String,String*,String* oName));
extern Void parseInterface Args((String,Long));
#define SMALL_INLINE_SIZE 9
// nasty hack, but seems an easy to convey the object name
// and size to openGHCIface
char nameObj[FILENAME_MAX+1];
int sizeObj;
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: dynamic.c,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:45 $
* $Revision: 1.5 $
* $Date: 1999/06/07 17:22:31 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -21,7 +21,6 @@
#include <stdio.h>
#include <dlfcn.h>
#if 0 /* apparently unused */
ObjectFile loadLibrary(fn)
String fn; {
return dlopen(fn,RTLD_NOW | RTLD_GLOBAL);
......@@ -32,7 +31,6 @@ ObjectFile file;
String symbol; {
return dlsym(file,symbol);
}
#endif
void* getDLLSymbol(dll,symbol) /* load dll and lookup symbol */
String dll;
......
This diff is collapsed.
......@@ -8,8 +8,8 @@
* in the distribution for details.
*
* $RCSfile: input.c,v $
* $Revision: 1.5 $
* $Date: 1999/04/27 10:06:53 $
* $Revision: 1.6 $
* $Date: 1999/06/07 17:22:32 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -18,6 +18,7 @@
#include "connect.h"
#include "command.h"
#include "errors.h"
#include "link.h"
#include <ctype.h>
#if HAVE_GETDELIM_H
#include "getdelim.h"
......@@ -48,6 +49,7 @@ List evalDefaults = NIL; /* defaults for evaluator */
Cell inputExpr = NIL; /* input expression */
Bool literateScripts = FALSE; /* TRUE => default to lit scripts */
Bool literateErrors = TRUE; /* TRUE => report errs in lit scrs */
Bool offsideON = TRUE; /* TRUE => implement offside rule */
String repeatStr = 0; /* Repeat last expr */
......@@ -120,9 +122,9 @@ static Text textBar, textMinus, textFrom, textArrow, textLazy;
static Text textBang, textDot, textAll, textImplies;
static Text textWildcard;
static Text textModule, textImport;
static Text textModule, textImport, textInterface, textInstImport;
static Text textHiding, textQualified, textAsMod;
static Text textExport, textUnsafe;
static Text textExport, textUnsafe, text__All;
Text textNum; /* Num */
Text textPrelude; /* Prelude */
......@@ -249,7 +251,8 @@ static String nextStringChar; /* next char in string buffer */
#if USE_READLINE /* for command line editors */
static String currentLine; /* editline or GNU readline */
static String nextChar;
#define nextConsoleChar() (unsigned char)(*nextChar=='\0' ? '\n' : *nextChar++)
#define nextConsoleChar() \
(unsigned char)(*nextChar=='\0' ? '\n' : *nextChar++)
extern Void add_history Args((String));
extern String readline Args((String));
#else
......@@ -398,6 +401,35 @@ String nm; {
}
Void hi_o_namesFromSrcName ( String srcName, String* hiName, String* oName )
{
Int len;
String dot;
len = 1 + strlen ( srcName );
*hiName = malloc(len);
*oName = malloc(len);
if (!(*hiName && *oName)) internal("hi_o_namesFromSource");
(*hiName)[0] = (*oName)[0] = 0;
dot = strrchr(srcName, '.');
if (!dot) return;
if (filenamecmp(dot+1, "hs")==0 &&
filenamecmp(dot+1, "lhs")==0 &&
filenamecmp(dot+1, "verb")==0) return;
strcpy(*hiName, srcName);
dot = strrchr(*hiName, '.');
dot[1] = 'h';
dot[2] = 'i';
dot[3] = 0;
strcpy(*oName, srcName);
dot = strrchr(*oName, '.');
dot[1] = 'o';
dot[2] = 0;
}
/* This code originally came from Sigbjorn Finne (sof@dcs.gla.ac.uk).
* I've removed the loop (since newLineSkip contains a loop too) and
* replaced the warnings with errors. ADR
......@@ -449,7 +481,8 @@ static Int local nextLine()
if (lineLength <= 0) { /* EOF / IO error, who knows.. */
return lineLength;
}
else if (lineLength >= 2 && lineBuffer[0] == '#' && lineBuffer[1] == '!') {
else if (lineLength >= 2 && lineBuffer[0] == '#' &&
lineBuffer[1] == '!') {
lineBuffer[0]='\n'; /* pretend it's a blank line */
lineBuffer[1]='\0';
lineLength=1;
......@@ -1215,6 +1248,7 @@ static Int indentDepth = (-1); /* current indentation nesting */
static Void local goOffside(col) /* insert offside marker */
Int col; { /* for specified column */
assert(offsideON);
if (indentDepth>=MAXINDENT) {
ERRMSG(row) "Too many levels of program nesting"
EEND;
......@@ -1223,10 +1257,12 @@ Int col; { /* for specified column */
}
static Void local unOffside() { /* leave layout rule area */
assert(offsideON);
indentDepth--;
}
static Bool local canUnOffside() { /* Decide if unoffside permitted */
assert(offsideON);
return indentDepth>=0 && layout[indentDepth]!=HARD;
}
......@@ -1298,7 +1334,7 @@ static Int local yylex() { /* Read next input token ... */
return firstTokenIs;
}
if (insertOpen) { /* insert `soft' opening brace */
if (offsideON && insertOpen) { /* insert `soft' opening brace */
insertOpen = FALSE;
insertedToken = TRUE;
goOffside(column);
......@@ -1319,7 +1355,7 @@ static Int local yylex() { /* Read next input token ... */
if (insertedToken) /* avoid inserting multiple `;'s */
insertedToken = FALSE; /* or putting `;' after `{' */
else
if (layout[indentDepth]!=HARD) {
if (offsideON && layout[indentDepth]!=HARD) {
if (column<layout[indentDepth]) {
unOffside();
return '}';
......@@ -1346,16 +1382,17 @@ static Int local yylex() { /* Read next input token ... */
case '[' : skip(); return '[';
case ']' : skip(); return ']';
case '`' : skip(); return '`';
case '{' : goOffside(HARD);
case '{' : if (offsideON) goOffside(HARD);
skip();
return '{';
case '}' : if (indentDepth<0) {
case '}' : if (offsideON && indentDepth<0) {
ERRMSG(row) "Misplaced `}'"
EEND;
}
if (layout[indentDepth]==HARD) /* skip over hard }*/
skip();
unOffside(); /* otherwise, we have to insert a }*/
if (!(offsideON && layout[indentDepth]!=HARD))
skip(); /* skip over hard }*/
if (offsideON)
unOffside(); /* otherwise, we have to insert a }*/
return '}'; /* to (try to) avoid an error... */
/* Character and string literals */
......@@ -1429,6 +1466,8 @@ static Int local yylex() { /* Read next input token ... */
if (it==textClass) return TCLASS;
if (it==textInstance) return TINSTANCE;
if (it==textModule) return TMODULE;
if (it==textInterface) return INTERFACE;
if (it==textInstImport) return INSTIMPORT;
if (it==textImport) return IMPORT;
if (it==textExport) return EXPORT;
if (it==textHiding) return HIDING;
......@@ -1436,6 +1475,7 @@ static Int local yylex() { /* Read next input token ... */
if (it==textAsMod) return ASMOD;
if (it==textWildcard) return '_';
if (it==textAll && !haskell98) return ALL;
if (it==text__All) return ALL;
if (it==textRepeat && reading==KEYBOARD)
return repeatLast();
......@@ -1472,7 +1512,8 @@ static Int local yylex() { /* Read next input token ... */
return NUMLIT;
}
ERRMSG(row) "Unrecognised character `\\%d' in column %d", ((int)c0), column
ERRMSG(row) "Unrecognised character `\\%d' in column %d",
((int)c0), column
EEND;
return 0; /*NOTREACHED*/
}
......@@ -1506,6 +1547,9 @@ static Void local parseInput(startWith)/* Parse input with given first tok,*/
Int startWith; { /* determining whether to read a */
firstToken = TRUE; /* script or an expression */
firstTokenIs = startWith;
if (startWith==INTERFACE)
offsideON = FALSE; else
offsideON = TRUE;
clearStack();
if (yyparse()) { /* This can only be parser overflow */
......@@ -1570,6 +1614,15 @@ Void parseExp() { /* Read an expression to evaluate */
setLastExpr(inputExpr);
}
Void parseInterface(nm,len) /* Read a GHC interface file */
String nm;
Long len; { /* Used to set a target for reading */
input(RESET);
fileInput(nm,len);
parseInput(INTERFACE);
}
/* --------------------------------------------------------------------------
* Input control:
* ------------------------------------------------------------------------*/
......@@ -1616,12 +1669,16 @@ Int what; {
textPrelude = findText("Prelude");
textNum = findText("Num");
textModule = findText("module");
textInterface = findText("__interface");
textInstImport = findText("__instimport");
textExport = findText("__export");
textImport = findText("import");
textHiding = findText("hiding");
textQualified = findText("qualified");
textAsMod = findText("as");
textWildcard = findText("_");
textAll = findText("forall");
text__All = findText("__forall");
varMinus = mkVar(textMinus);
varPlus = mkVar(textPlus);
varBang = mkVar(textBang);
......
This diff is collapsed.
......@@ -130,3 +130,5 @@ extern Cell predFractional;; /* Fractional (mkOffset(0))
extern Cell predIntegral;; /* Integral (mkOffset(0)) */
extern Kind starToStar;; /* Type -> Type */
extern Cell predMonad;; /* Monad (mkOffset(0)) */
......@@ -12,8 +12,8 @@
* in the distribution for details.
*
* $RCSfile: machdep.c,v $
* $Revision: 1.5 $
* $Date: 1999/04/27 10:06:55 $
* $Revision: 1.6 $
* $Date: 1999/06/07 17:22:37 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
......@@ -133,14 +133,16 @@ static String local readRegChildStrings Args((HKEY, String, String, Char, String
typedef struct { unsigned hi, lo; } Time;
#define timeChanged(now,thn) (now.hi!=thn.hi || now.lo!=thn.lo)
#define timeSet(var,tm) var.hi = tm.hi; var.lo = tm.lo
error timeEarlier not defined
#else
typedef time_t Time;
#define timeChanged(now,thn) (now!=thn)
#define timeSet(var,tm) var = tm
#define timeChanged(now,thn) (now!=thn)
#define timeSet(var,tm) var = tm
#define timeEarlier(earlier,now) (earlier < now)
#endif
static Void local getFileInfo Args((String, Time *, Long *));
static Bool local readable Args((String));
static Void local getFileInfo Args((String, Time *, Long *));
static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/
String f;
......@@ -149,10 +151,10 @@ Long *sz; {
#if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
struct stat scbuf;
if (!stat(f,&scbuf)) {
*tm = scbuf.st_mtime;
if (tm) *tm = scbuf.st_mtime;
*sz = (Long)(scbuf.st_size);
} else {
*tm = 0;
if (tm) *tm = 0;
*sz = 0;
}
#else /* normally just use stat() */
......@@ -161,15 +163,20 @@ Long *sz; {
r.r[1] = (int)s;
os_swi(OS_File, &r);
if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
if (tm) tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
} else { /* Not found, or not time-stamped */
tm->hi = tm->lo = 0;
if (tm) tm->hi = tm->lo = 0;
}
*sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
#endif
}
Void getFileSize ( String f, Long* sz )
{
getFileInfo ( f, NULL, sz );
}
#if defined HAVE_GETFINFO /* Mac971031 */
/* --------------------------------------------------------------------------
* Define a MacOS version of access():
......@@ -210,6 +217,7 @@ String f; {
return (0 == access(f,4));
#elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
struct stat scbuf;
//fprintf(stderr, "readable: %s\n", f );
return ( !stat(f,&scbuf)
&& (scbuf.st_mode & S_IREAD) /* readable */
&& (scbuf.st_mode & S_IFREG) /* regular file */
......@@ -255,7 +263,7 @@ static Bool local tryEndings Args((String));
# define SLASH '/'
# define isSLASH(c) ((c)==SLASH)
# define PATHSEP ':'
# define DLL_ENDING ".so"
# define DLL_ENDING ".o"
#endif
static String local hugsdir() { /* directory containing lib/Prelude.hs */
......@@ -367,9 +375,9 @@ String s; { /* a pathname in some appropriate manner. */
}
#if HSCRIPT
static String endings[] = { "", ".hs", ".lhs", ".hsx", ".hash", 0 };
static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
#else
static String endings[] = { "", ".hs", ".lhs", 0 };
static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
#endif
static char searchBuf[FILENAME_MAX+1];
static Int searchPos;
......@@ -413,9 +421,9 @@ String s; {
searches the base directory and its direct subdirectories for a file
input: searchbuf contains SLASH terminated base directory
argument s contains the (base) filename
argument s contains the (base) filename
output: TRUE: searchBuf contains the full filename
FALSE: searchBuf is garbage, file not found
FALSE: searchBuf is garbage, file not found
*/
......@@ -587,6 +595,124 @@ String path; {
return (tryEndings(nm) ? normPath(searchBuf) : 0);
}
/* --------------------------------------------------------------------------
* New path handling stuff for the Combined System (tm)
* ------------------------------------------------------------------------*/
Bool findFilesForModule (
String modName,
String* path,
String* sExt,
Bool* sAvail, Time* sTime, Long* sSize,
Bool* iAvail, Time* iTime, Long* iSize,
Bool* oAvail, Time* oTime, Long* oSize
)
{
/* Let the module name given be M.
For each path entry P,
a s(rc) file will be P/M.hs or P/M.lhs
an i(nterface) file will be P/M.hi
an o(bject) file will be P/M.o
If there is a s file or (both i and o files)
use P to fill in the path names.
Otherwise, move on to the next path entry.
If all path entries are exhausted, return False.
*/
Int nPath;
Bool literate;
String peStart, peEnd;
String augdPath; /* . and then hugsPath */
*path = *sExt = NULL;
*sAvail = *iAvail = *oAvail = FALSE;
*sSize = *iSize = *oSize = 0;
augdPath = malloc(3+strlen(hugsPath));
if (!augdPath)
internal("moduleNameToFileNames: malloc failed(2)");
augdPath[0] = '.';
augdPath[1] = PATHSEP;
augdPath[2] = 0;
strcat(augdPath,hugsPath);
peEnd = augdPath-1;
while (1) {
/* Advance peStart and peEnd very paranoically, giving up at
the first sign of mutancy in the path string.
*/
if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
peStart = peEnd+1;
peEnd = peStart;
while (*peEnd && *peEnd != PATHSEP) peEnd++;
/* Now peStart .. peEnd-1 bracket the next path element. */
nPath = peEnd-peStart;
if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
hugsPath
EEND;
free(augdPath);
return FALSE;
}
strncpy(searchBuf, peStart, nPath);
searchBuf[nPath] = 0;
if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
searchBuf[nPath++] = SLASH;
strcpy(searchBuf+nPath, modName);
nPath += strlen(modName);
/* searchBuf now holds 'P/M'. Try out the various endings. */
*path = *sExt = NULL;
*sAvail = *iAvail = *oAvail = FALSE;
*sSize = *iSize = *oSize = 0;
strcpy(searchBuf+nPath, DLL_ENDING);
if (readable(searchBuf)) {
*oAvail = TRUE;
getFileInfo(searchBuf, oTime, oSize);
}
strcpy(searchBuf+nPath, ".hi");
if (readable(searchBuf)) {
*iAvail = TRUE;
getFileInfo(searchBuf, iTime, iSize);
}