Author: housel
Date: Thu Nov 11 21:11:22 2004
New Revision: 9577
Added:
trunk/fundev/Sources/lib/build-system/build-system.xhtml (props changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/build-system/build-system.xhtml
trunk/fundev/Sources/lib/build-system/jam-build.dylan (props changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/build-system/jam-build.dylan
trunk/fundev/Sources/lib/jam/
- copied from r9576, branches/fundev-2-1-jam/fundev/Sources/lib/jam/
trunk/fundev/Sources/lib/run-time/mini-jambase.jam (props changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/run-time/mini-jambase.jam
trunk/fundev/Sources/lib/run-time/pentium-linux/x86-linux-build.jam (props
changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/run-time/pentium-linux/x86-linux-build.jam
trunk/fundev/Sources/lib/run-time/pentium-win32/x86-win32-pellesc-build.jam
(props changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/run-time/pentium-win32/x86-win32-pellesc-build.jam
trunk/fundev/Sources/lib/run-time/pentium-win32/x86-win32-vc6-build.jam
(props changed)
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/lib/run-time/pentium-win32/x86-win32-vc6-build.jam
trunk/fundev/Sources/registry/generic/jam
- copied unchanged from r9576,
branches/fundev-2-1-jam/fundev/Sources/registry/generic/jam
Removed:
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-scripts.dylan
trunk/fundev/Sources/lib/build-system/build/
trunk/fundev/Sources/lib/build-system/build-library.dylan
trunk/fundev/Sources/lib/build-system/build.bat
trunk/fundev/Sources/lib/build-system/build.lid
trunk/fundev/Sources/lib/build-system/convert.bat
trunk/fundev/Sources/lib/build-system/emulator-build-system.lid
trunk/fundev/Sources/lib/build-system/emulator-build.dylan
trunk/fundev/Sources/lib/build-system/emulator-library.dylan
trunk/fundev/Sources/lib/build-system/generic/
trunk/fundev/Sources/lib/build-system/gnubuild.bat
trunk/fundev/Sources/lib/build-system/path-utilities.dylan
trunk/fundev/Sources/lib/build-system/ppc-build-library.dylan
trunk/fundev/Sources/lib/build-system/ppc-build.lid
trunk/fundev/Sources/lib/build-system/run.dylan
trunk/fundev/Sources/lib/build-system/targets.dylan
trunk/fundev/Sources/lib/build-system/utilities.dylan
trunk/fundev/Sources/lib/linker-support/
trunk/fundev/Sources/registry/generic/ccl-linker
trunk/fundev/Sources/registry/generic/elf-linker
trunk/fundev/Sources/registry/generic/gnu-linker
trunk/fundev/Sources/registry/generic/linker-support
trunk/fundev/Sources/registry/generic/powerpc-elf-linker
Modified:
trunk/fundev/Makefile.in
trunk/fundev/Sources/Library-Packs/Compiler/compiler.dlp
trunk/fundev/Sources/app/dw/basic-pentium-library.dylan
trunk/fundev/Sources/app/dw/basic-powerpc-library.dylan
trunk/fundev/Sources/app/dw/enhanced-pentium-library.dylan
trunk/fundev/Sources/app/dw/minimal-pentium-library.dylan
trunk/fundev/Sources/app/dw/pentium-library.dylan
trunk/fundev/Sources/dfmc/execution/execution-library.dylan
trunk/fundev/Sources/dfmc/file-compiler/c-file-compiler-library.dylan
trunk/fundev/Sources/dfmc/file-compiler/interpreter-file-compiler-library.dylan
trunk/fundev/Sources/dfmc/file-compiler/pentium-file-compiler-library.dylan
trunk/fundev/Sources/dfmc/file-compiler/powerpc-file-compiler-library.dylan
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-gluefile.dylan
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-link-object.dylan
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker-library.dylan
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.dylan
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.lid
trunk/fundev/Sources/dfmc/harp-cg-linker/harp-makefile.dylan
trunk/fundev/Sources/dfmc/harp-cg/harp-emit.dylan
trunk/fundev/Sources/dfmc/shell/hd2c-library.dylan
trunk/fundev/Sources/dfmc/shell/interpreter-shell-library.dylan
trunk/fundev/Sources/dfmc/shell/library.dylan
trunk/fundev/Sources/dfmc/shell/module.dylan
trunk/fundev/Sources/dfmc/shell/powerpc-library.dylan
trunk/fundev/Sources/duim/win32/win32-duim.lid
trunk/fundev/Sources/dylan/dylan.lid
trunk/fundev/Sources/environment/commands/build.dylan
trunk/fundev/Sources/environment/commands/general.dylan
trunk/fundev/Sources/environment/commands/internal/module.dylan
trunk/fundev/Sources/environment/console/command-line.dylan
trunk/fundev/Sources/environment/console/compiler-command-line.dylan
trunk/fundev/Sources/environment/console/environment-command-line.dylan
trunk/fundev/Sources/environment/core/library.dylan
trunk/fundev/Sources/environment/dfmc/application/library.dylan
trunk/fundev/Sources/environment/dfmc/database/library.dylan
trunk/fundev/Sources/environment/dfmc/database/module.dylan
trunk/fundev/Sources/environment/dfmc/exe-projects.dylan
trunk/fundev/Sources/environment/dfmc/module.dylan
trunk/fundev/Sources/environment/dfmc/projects/library.dylan
trunk/fundev/Sources/environment/dfmc/projects/projects.dylan
trunk/fundev/Sources/environment/protocols/module.dylan
trunk/fundev/Sources/environment/protocols/project-objects.dylan
trunk/fundev/Sources/environment/tools/environment-options.dylan
trunk/fundev/Sources/environment/tools/utilities.dylan
trunk/fundev/Sources/lib/build-system/build-system.lid
trunk/fundev/Sources/lib/build-system/library.dylan
trunk/fundev/Sources/lib/build-system/paths.dylan
trunk/fundev/Sources/lib/build-system/variables.dylan
trunk/fundev/Sources/lib/jam/jam-build.lid (props changed)
trunk/fundev/Sources/lib/jam/jam-evaluator.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-glob.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-grist.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-header-scan.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-ir.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-parser.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-parser.dylgram (props changed)
trunk/fundev/Sources/lib/jam/jam-reader.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-regular-expression.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-state.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-target-build.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam-target.dylan (props changed)
trunk/fundev/Sources/lib/jam/jam.lid (props changed)
trunk/fundev/Sources/lib/jam/library.dylan (props changed)
trunk/fundev/Sources/lib/jam/regular-expression.dylan (props changed)
trunk/fundev/Sources/lib/jam/tests/jam-test-suite.lid (props changed)
trunk/fundev/Sources/lib/jam/tests/jam-test.dylan (props changed)
trunk/fundev/Sources/lib/jam/tests/library.dylan (props changed)
trunk/fundev/Sources/lib/release-info/libraries.dylan
trunk/fundev/Sources/lib/release-info/module.dylan
trunk/fundev/Sources/lib/run-time/pentium-linux/GNUmakefile
trunk/fundev/Sources/project-manager/dfmc-projects/compiler.dylan
trunk/fundev/Sources/project-manager/dfmc-projects/module.dylan
trunk/fundev/Sources/project-manager/projects-protocol/module.dylan
trunk/fundev/Sources/project-manager/projects/compilation.dylan
trunk/fundev/Sources/project-manager/projects/implementation.dylan
trunk/fundev/Sources/project-manager/projects/projects-library.dylan
trunk/fundev/Sources/project-manager/registry-projects/registry-projects-library.dylan
trunk/fundev/Sources/project-manager/user-projects/library.dylan
trunk/fundev/admin/builds/Makefile
trunk/fundev/admin/builds/fdmake.pl
trunk/fundev/configure.ac
Log:
Bug: 7003
Merge the fundev-2-1-jam branch back to trunk.
Modified: trunk/fundev/Makefile.in
==============================================================================
--- trunk/fundev/Makefile.in (original)
+++ trunk/fundev/Makefile.in Thu Nov 11 21:11:22 2004
@@ -1,7 +1,7 @@
prefix = @prefix@
install_root = $(prefix)/lib/functional-developer
-srcdir = @srcdir@
+srcdir = @abs_srcdir@
abs_srcdir = @abs_srcdir@
abs_builddir = @abs_builddir@
@@ -21,18 +21,20 @@
2-stage-bootstrap: stage-1-bootstrap
FUNCTIONAL_DEVELOPER_RELEASE_ROOT=$(abs_builddir)/Bootstrap.1 \
- $(MAKE)
FDCOMPILE=$(abs_builddir)/Bootstrap.1/bin/minimal-console-compiler
final-bootstrap
+ $(MAKE)
FDCOMPILE="$(abs_builddir)/Bootstrap.1/bin/minimal-console-compiler -build
-save" final-bootstrap
3-stage-bootstrap: stage-1-bootstrap stage-2-bootstrap
FUNCTIONAL_DEVELOPER_RELEASE_ROOT=$(abs_builddir)/Bootstrap.2 \
- $(MAKE)
FDCOMPILE=$(abs_builddir)/Bootstrap.2/bin/minimal-console-compiler
final-bootstrap
+ $(MAKE)
FDCOMPILE="$(abs_builddir)/Bootstrap.2/bin/minimal-console-compiler -build
-save" final-bootstrap
4-stage-bootstrap: stage-1-bootstrap stage-2-bootstrap stage-3-bootstrap
FUNCTIONAL_DEVELOPER_RELEASE_ROOT=$(abs_builddir)/Bootstrap.3 \
- $(MAKE)
FDCOMPILE=$(abs_builddir)/Bootstrap.3/bin/minimal-console-compiler
final-bootstrap
+ $(MAKE)
FDCOMPILE="$(abs_builddir)/Bootstrap.3/bin/minimal-console-compiler -build
-save" final-bootstrap
stage-1-bootstrap: \
- Bootstrap.1 $(srcdir)/Sources/bootstrap1-registry \
+ Bootstrap.1 \
+ Bootstrap.1/lib/$(fd_build)-build.jam \
+ $(srcdir)/Sources/bootstrap1-registry \
Bootstrap.1/bin/minimal-console-compiler
Bootstrap.1:
@@ -40,6 +42,11 @@
mkdir Bootstrap.1/Build
mkdir Bootstrap.1/logs
mkdir Bootstrap.1/bin
+ mkdir Bootstrap.1/lib
+
+Bootstrap.1/lib/$(fd_build)-build.jam: Bootstrap.1
$(srcdir)/Sources/lib/run-time/pentium-linux/$(fd_build)-build.jam
+ cp $(srcdir)/Sources/lib/run-time/pentium-linux/$(fd_build)-build.jam \
+ Bootstrap.1/lib/$(fd_build)-build.jam
BOOTSTRAP1_REGISTRY = $(srcdir)/Sources/bootstrap1-registry
BOOTSTRAP1_LIBS = \
@@ -80,7 +87,7 @@
FUNCTIONAL_DEVELOPER_USER_REGISTRIES=$(BOOTSTRAP1_REGISTRY) \
FUNCTIONAL_DEVELOPER_USER_SOURCES=$(abs_srcdir)/Sources \
FUNCTIONAL_DEVELOPER_USER_BUILD=$(abs_builddir)/Bootstrap.1/Build \
- $(FDCOMPILE)
$(abs_srcdir)/Sources/environment/console/minimal-console-compiler.lid
>Bootstrap.1/logs/compile-minimal-console-compiler.txt
+ $(fdmake) --compiler="$(FDCOMPILE)" minimal-console-compiler
stage-2-bootstrap: Bootstrap.2 Bootstrap.2/bin/minimal-console-compiler
@@ -97,14 +104,15 @@
FUNCTIONAL_DEVELOPER_USER_INSTALL=$(abs_builddir)/Bootstrap.2 \
$(MAKE) -C $(abs_srcdir)/Sources/lib/run-time/pentium-linux install
@FUNCTIONAL_DEVELOPER_PLATFORM_NAME=$(fd_build) \
- FUNCTIONAL_DEVELOPER_RELEASE_ROOT=$(abs_builddir)/Bootstrap.1 \
+ FUNCTIONAL_DEVELOPER_RELEASE_ROOT=$(abs_builddir)/Bootstrap.2 \
+ FUNCTIONAL_DEVELOPER_RELEASE_INSTALL=$(abs_builddir)/Bootstrap.2 \
FUNCTIONAL_DEVELOPER_BUILD_LOGS=$(abs_builddir)/Bootstrap.2/logs \
FUNCTIONAL_DEVELOPER_USER_ROOT=$(abs_builddir)/Bootstrap.2 \
FUNCTIONAL_DEVELOPER_USER_INSTALL=$(abs_builddir)/Bootstrap.2 \
FUNCTIONAL_DEVELOPER_USER_REGISTRIES=$(abs_srcdir)/Sources/registry \
FUNCTIONAL_DEVELOPER_USER_SOURCES=$(abs_srcdir)/Sources \
FUNCTIONAL_DEVELOPER_USER_BUILD=$(abs_builddir)/Bootstrap.2/Build \
- $(fdmake) --compiler=Bootstrap.1/bin/minimal-console-compiler \
+ $(fdmake) --compiler="Bootstrap.1/bin/minimal-console-compiler -build
-save" \
minimal-console-compiler
stage-3-bootstrap: Bootstrap.3 Bootstrap.3/bin/minimal-console-compiler
@@ -129,7 +137,7 @@
FUNCTIONAL_DEVELOPER_USER_REGISTRIES=$(abs_srcdir)/Sources/registry \
FUNCTIONAL_DEVELOPER_USER_SOURCES=$(abs_srcdir)/Sources \
FUNCTIONAL_DEVELOPER_USER_BUILD=$(abs_builddir)/Bootstrap.3/Build \
- $(fdmake) --compiler=Bootstrap.2/bin/minimal-console-compiler \
+ $(fdmake) --compiler="Bootstrap.2/bin/minimal-console-compiler -build
-save" \
minimal-console-compiler
Bootstrap.final:
@@ -157,7 +165,7 @@
@echo Building final stage bootstrap...
FUNCTIONAL_DEVELOPER_USER_INSTALL=$(abs_builddir)/Bootstrap.final \
$(MAKE) -C $(abs_srcdir)/Sources/lib/run-time/pentium-linux install
- @$(FINAL_ENV) $(fdmake) --compiler=$(FDCOMPILE) \
+ @$(FINAL_ENV) $(fdmake) --compiler="$(FDCOMPILE)" \
$(FINAL_LIBRARIES) --library-packs="$(LIBRARY_PACKS)"
install: all
Modified: trunk/fundev/Sources/Library-Packs/Compiler/compiler.dlp
==============================================================================
--- trunk/fundev/Sources/Library-Packs/Compiler/compiler.dlp (original)
+++ trunk/fundev/Sources/Library-Packs/Compiler/compiler.dlp Thu Nov 11
21:11:22 2004
@@ -233,22 +233,6 @@
</sources>
<release product="Functional Developer" version="2.1"
platform="x86-win32"/>
</library>
- <library name="gnu-linker">
- <sources location="lib/linker-support">
- <project>gnu-linker.lid</project>
- </sources>
- <release product="Functional Developer" version="2.1"
platform="x86-win32">
- <binary file="gnu-linker.dll">
- <merge>linker-support</merge>
- </binary>
- </release>
- </library>
- <library name="linker-support">
- <sources location="lib/linker-support">
- <project>linker-support.lid</project>
- </sources>
- <release product="Functional Developer" version="2.1"
platform="x86-win32"/>
- </library>
<library name="user-projects">
<sources location="project-manager/user-projects">
<project>user-projects.lid</project>
Modified: trunk/fundev/Sources/app/dw/basic-pentium-library.dylan
==============================================================================
--- trunk/fundev/Sources/app/dw/basic-pentium-library.dylan (original)
+++ trunk/fundev/Sources/app/dw/basic-pentium-library.dylan Thu Nov 11
21:11:22 2004
@@ -33,11 +33,6 @@
use dfmc-debug-back-end;
use dfmc-pentium-file-compiler;
- // Load the GNU linker
- use gnu-linker;
- // Load the ELF linker
- use elf-linker;
-
use dfmc-shell;
export dw;
Modified: trunk/fundev/Sources/app/dw/basic-powerpc-library.dylan
==============================================================================
--- trunk/fundev/Sources/app/dw/basic-powerpc-library.dylan (original)
+++ trunk/fundev/Sources/app/dw/basic-powerpc-library.dylan Thu Nov 11
21:11:22 2004
@@ -33,11 +33,6 @@
use dfmc-debug-back-end;
use dfmc-powerpc-file-compiler;
- // Load the GNU linker
- use gnu-linker;
- // Load the ELF linker
- use powerpc-elf-linker;
-
use powerpc-dfmc-shell;
export dw;
Modified: trunk/fundev/Sources/app/dw/enhanced-pentium-library.dylan
==============================================================================
--- trunk/fundev/Sources/app/dw/enhanced-pentium-library.dylan (original)
+++ trunk/fundev/Sources/app/dw/enhanced-pentium-library.dylan Thu Nov 11
21:11:22 2004
@@ -33,11 +33,6 @@
use dfmc-debug-back-end;
use dfmc-pentium-file-compiler;
- // Load the GNU linker
- use gnu-linker;
- // Load the ELF linker
- use elf-linker;
-
// Load the tool interfaces
use motley;
use tool-scepter;
Modified: trunk/fundev/Sources/app/dw/minimal-pentium-library.dylan
==============================================================================
--- trunk/fundev/Sources/app/dw/minimal-pentium-library.dylan (original)
+++ trunk/fundev/Sources/app/dw/minimal-pentium-library.dylan Thu Nov 11
21:11:22 2004
@@ -33,11 +33,6 @@
use dfmc-debug-back-end;
use dfmc-pentium-file-compiler;
- // Load the GNU linker
- use gnu-linker;
- // Load the ELF linker
- use elf-linker;
-
use dfmc-shell;
export dw;
Modified: trunk/fundev/Sources/app/dw/pentium-library.dylan
==============================================================================
--- trunk/fundev/Sources/app/dw/pentium-library.dylan (original)
+++ trunk/fundev/Sources/app/dw/pentium-library.dylan Thu Nov 11 21:11:22 2004
@@ -33,11 +33,6 @@
use dfmc-debug-back-end;
use dfmc-pentium-file-compiler;
- // Load the GNU linker
- use gnu-linker;
- // Load the ELF linker
- use elf-linker;
-
// Load the tool interfaces
use motley;
use tool-scepter;
Modified: trunk/fundev/Sources/dfmc/execution/execution-library.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/execution/execution-library.dylan (original)
+++ trunk/fundev/Sources/dfmc/execution/execution-library.dylan Thu Nov 11
21:11:22 2004
@@ -9,7 +9,7 @@
use functional-dylan;
use variable-search;
use system;
- use build-system;
+ use release-info;
use dfmc-core;
use dfmc-back-end;
use dfmc-optimization;
@@ -46,7 +46,7 @@
use dylan-hygiene-glitches;
use dylan-primitives;
use operating-system;
- use build-system;
+ use release-info;
use threads;
use variable-search;
use dfmc-core,
Modified: trunk/fundev/Sources/dfmc/file-compiler/c-file-compiler-library.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/file-compiler/c-file-compiler-library.dylan
(original)
+++ trunk/fundev/Sources/dfmc/file-compiler/c-file-compiler-library.dylan
Thu Nov 11 21:11:22 2004
@@ -69,7 +69,6 @@
use file-source-records;
use source-records-implementation;
use build-system, rename: { <linker> => build/<linker> };
- use path-utilities;
export
unify-project,
Modified:
trunk/fundev/Sources/dfmc/file-compiler/interpreter-file-compiler-library.dylan
==============================================================================
---
trunk/fundev/Sources/dfmc/file-compiler/interpreter-file-compiler-library.dylan
(original)
+++
trunk/fundev/Sources/dfmc/file-compiler/interpreter-file-compiler-library.dylan
Thu Nov 11 21:11:22 2004
@@ -69,7 +69,6 @@
use file-source-records;
use source-records-implementation;
// use build-system, rename: { <linker> => build/<linker> };
- // use path-utilities;
export
unify-project,
Modified:
trunk/fundev/Sources/dfmc/file-compiler/pentium-file-compiler-library.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/file-compiler/pentium-file-compiler-library.dylan
(original)
+++ trunk/fundev/Sources/dfmc/file-compiler/pentium-file-compiler-library.dylan
Thu Nov 11 21:11:22 2004
@@ -72,7 +72,6 @@
use file-source-records;
use source-records-implementation;
use build-system, rename: { <linker> => build/<linker> };
- use path-utilities;
export
unify-project,
Modified:
trunk/fundev/Sources/dfmc/file-compiler/powerpc-file-compiler-library.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/file-compiler/powerpc-file-compiler-library.dylan
(original)
+++ trunk/fundev/Sources/dfmc/file-compiler/powerpc-file-compiler-library.dylan
Thu Nov 11 21:11:22 2004
@@ -72,7 +72,6 @@
use file-source-records;
use source-records-implementation;
use build-system, rename: { <linker> => build/<linker> };
- use path-utilities;
export
unify-project,
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-gluefile.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-gluefile.dylan
(original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-gluefile.dylan Thu Nov
11 21:11:22 2004
@@ -9,6 +9,7 @@
define sideways method emit-mainfile
(back-end :: <harp-back-end>, ld :: <library-description>,
#rest keys, #key, #all-keys)
+ // do nothing
end;
define sideways method emit-gluefile
@@ -20,10 +21,10 @@
compilation-layer,
#all-keys)
let current-library-mode = ld.library-description-compilation-mode;
- let interactive-mode? = current-library-mode = #"interactive";
+ let interactive-mode? = current-library-mode == #"interactive";
- dynamic-bind(*compiling-dylan?* =
dylan-library-library-description?(ld),
- *interactive-mode?* = interactive-mode?)
+ dynamic-bind(*compiling-dylan?* = dylan-library-library-description?(ld),
+ *interactive-mode?* = interactive-mode?)
emit-gluefile-internal(back-end, ld, cr-names,
harp-output?: harp-output?,
assembler-output?: assembler-output?,
@@ -34,25 +35,29 @@
end method;
-define method glue-unit-name
+define method glue-unit-name
(lib-name, interactive?) => (name :: <byte-string>)
let simple-name :: <byte-string> = glue-unit(lib-name);
if (interactive?)
- concatenate("_interactive_", simple-name);
- else simple-name;
- end if;
+ concatenate("_interactive_", simple-name)
+ else
+ simple-name
+ end if
end method;
define method main-unit-name
(lib-name, interactive?) => (name :: <byte-string>)
let simple-name :: <byte-string> = main-unit(lib-name);
if (interactive?)
- concatenate("_interactive_", simple-name);
- else simple-name;
- end if;
+ concatenate("_interactive_", simple-name)
+ else
+ simple-name
+ end if
end method;
-define open generic main-unit?(back-end :: <harp-back-end>) => (main? ::
<boolean>);
+define open generic main-unit?
+ (back-end :: <harp-back-end>)
+ => (main? :: <boolean>);
define method main-unit?(back-end :: <harp-back-end>) => (main? :: <boolean>)
#f
@@ -61,14 +66,14 @@
define dylan-reference %true internal dylan;
define dylan-reference %false internal dylan;
-
define open generic emit-library-initializer
(back-end :: <harp-back-end>, stream, ld,
emit-call-used :: <method>,
emit-call-crs :: <method>,
emit-branch-on-init :: <method>,
init-name :: <byte-string>,
- harp-output?, debug-info?) => ();
+ harp-output?, debug-info?)
+ => ();
define sideways method emit-library-initializer
(back-end :: <harp-back-end>, stream, ld,
@@ -76,37 +81,36 @@
emit-call-crs :: <method>,
emit-branch-on-init :: <method>,
init-name :: <byte-string>,
- harp-output?, debug-info?) => ()
-
+ harp-output?, debug-info?)
+ => ();
+ let initializer
+ = with-harp-emitter (back-end, stream, init-name,
+ harp-debug: harp-output?,
+ export: #t)
+ let return-tag = make-tag(back-end);
+ emit-branch-on-init(back-end, return-tag);
+ emit-call-used(back-end);
+ emit-call-crs(back-end);
+ ins--tag(back-end, return-tag);
+ ins--rts-and-drop(back-end, 0);
+ end with-harp-emitter;
+
output-compiled-lambda(back-end, stream,
- with-harp-emitter(back-end,
- stream,
- init-name,
- harp-debug: harp-output?,
- export: #t)
-
- let return-tag = make-tag(back-end);
- emit-branch-on-init(back-end, return-tag);
- emit-call-used(back-end);
- emit-call-crs(back-end);
- ins--tag(back-end, return-tag);
- ins--rts-and-drop(back-end, 0);
-
- end with-harp-emitter,
+ initializer,
section: #"init-code",
debug-info?: debug-info?);
end method;
-define method emit-gluefile-internal (back-end :: <harp-back-end>, ld,
cr-names,
- #key harp-output? = unsupplied(),
- assembler-output? = unsupplied(),
- downloadable-data? = #f,
- debug-info? = *default-debug-info?*,
- compilation-layer)
- => (data)
-
+define method emit-gluefile-internal
+ (back-end :: <harp-back-end>, ld, cr-names,
+ #key harp-output? = unsupplied(),
+ assembler-output? = unsupplied(),
+ downloadable-data? = #f,
+ debug-info? = *default-debug-info?*,
+ compilation-layer)
+ => (data);
let lib-name = as-lowercase(as(<string>, library-description-emit-name(ld)));
let name = glue-name(lib-name);
let base-name = glue-unit-name(lib-name, downloadable-data?);
@@ -114,17 +118,14 @@
let dylan-library? = *compiling-dylan?*;
let main-unit? = main-unit?(back-end);
let data = #f;
-
- with-harp-outputter(back-end,
- stream,
- ld,
- base: base-name,
- harp-output?: harp-output?,
- assembler-output?: assembler-output?,
- model-object-protocol?: #f,
- dynamic-linking-protocol?: *interactive-mode?*,
- download?: downloadable-data?)
-
+
+ with-harp-outputter (back-end, stream, ld,
+ base: base-name,
+ harp-output?: harp-output?,
+ assembler-output?: assembler-output?,
+ model-object-protocol?: #f,
+ dynamic-linking-protocol?: #t,
+ download?: downloadable-data?)
let constant-ref = curry(ins--constant-ref, back-end);
let imported-ref = curry(make-imported-constant-reference, back-end);
let dylan-ref = if (dylan-library?) constant-ref else imported-ref end;
@@ -132,196 +133,186 @@
let used-glue-names = map(library-description-glue-name, lds);
let cr-init-names = cr-init-names(ld, cr-names);
- let initialize-library? =
- ins--indirect-constant-ref(back-end,
- raw-mangle(back-end,
-
as-lowercase(format-to-string("%%%s-library-booted?",
- lib-name))));
-
- local method emit-call-used (back-end :: <harp-back-end>)
- // initialize all used libraries
- let init-names = map(imported-ref, used-glue-names);
- for (name in init-names)
- output-external(back-end, stream, name);
- ins--call(back-end, name, 0);
- end for;
- end method emit-call-used,
-
- method emit-call-crs (back-end :: <harp-back-end>)
- // initialize all CRs for this library
- let init-names = map(constant-ref, cr-init-names);
- for (name in init-names)
- output-external(back-end, stream, name);
- ins--call(back-end, name, 0);
- end for;
- if (dylan-library?)
- without-dependency-tracking
- let install-boot-symbols =
- constant-ref(emit-name(back-end, #f,
^iep(dylan-value(#"%install-boot-symbols"))));
- ins--register-external(back-end, install-boot-symbols);
- ins--call(back-end, install-boot-symbols, 0);
- end without-dependency-tracking;
- end if;
+ let initialize-library?-name
+ = as-lowercase(format-to-string("%%%s-library-booted?", lib-name));
+ let initialize-library?
+ = ins--indirect-constant-ref(back-end,
+ raw-mangle(back-end,
+ initialize-library?-name));
+
+ local
+ method emit-call-used (back-end :: <harp-back-end>)
+ // initialize all used libraries
+ let init-names = map(imported-ref, used-glue-names);
+ for (name in init-names)
+ output-external(back-end, stream, name);
+ ins--call(back-end, name, 0);
+ end for;
+ end method emit-call-used,
+
+ method emit-call-crs (back-end :: <harp-back-end>)
+ // initialize all CRs for this library
+ let init-names = map(constant-ref, cr-init-names);
+ for (name in init-names)
+ output-external(back-end, stream, name);
+ ins--call(back-end, name, 0);
+ end for;
+ if (dylan-library?)
+ without-dependency-tracking
+ let install-boot-symbols
+ = constant-ref(emit-name(back-end, #f,
+
^iep(dylan-value(#"%install-boot-symbols"))));
+ ins--register-external(back-end, install-boot-symbols);
+ ins--call(back-end, install-boot-symbols, 0);
+ end without-dependency-tracking;
+ end if;
end method emit-call-crs,
- method emit-branch-on-init (back-end :: <harp-back-end>, return-tag
:: <tag>)
- ins--bne(back-end, return-tag, initialize-library?, $false);
- ins--move(back-end, initialize-library?, $true);
- end method emit-branch-on-init;
-
- with-harp-variables(back-end)
-
- dynamic-bind (*emitting-init-code?* = #t,
- $true = dylan-ref($%true),
- $false = dylan-ref($%false))
-
- emit-header(back-end, stream);
-
- output-external(back-end, stream, $false);
- output-external(back-end, stream, $true);
-
- emit-library-imported-data(back-end, stream, ld,
- compilation-layer: compilation-layer);
-
- emit-glue-data(back-end, stream, ld);
-
- output-variable(back-end, stream, initialize-library?, $false,
- section: #"variables", export?: #f);
- emit-data-footer(back-end, stream, initialize-library?);
- output-code-start(back-end, stream);
-
- emit-library-initializer(back-end, stream, ld,
- emit-call-used, emit-call-crs,
- emit-branch-on-init,
- name, harp-output?, debug-info?);
-
- emit-shared-library-entry-points
- (back-end, stream, ld,
- harp-output?: harp-output?,
- debug-info?: debug-info?);
-
- unless (main-unit?)
- emit-executable-entry-points
- (back-end, stream, ld,
- harp-output?: harp-output?,
- debug-info?: debug-info?);
- end;
-
- for (init-name in used-glue-names,
- library-name in lds)
- cache-import-in-library(back-end, init-name, library-name);
- end for;
- emit-imports(back-end, base-name, ld);
-
- emit-footer(back-end, stream);
-
- end dynamic-bind;
+ method emit-branch-on-init
+ (back-end :: <harp-back-end>, return-tag :: <tag>)
+ ins--bne(back-end, return-tag, initialize-library?, $false);
+ ins--move(back-end, initialize-library?, $true);
+ end method emit-branch-on-init;
+
+ with-harp-variables (back-end)
+ dynamic-bind (*emitting-init-code?* = #t,
+ $true = dylan-ref($%true),
+ $false = dylan-ref($%false))
+ emit-header(back-end, stream);
+
+ output-external(back-end, stream, $false);
+ output-external(back-end, stream, $true);
+
+ emit-library-imported-data(back-end, stream, ld,
+ compilation-layer: compilation-layer);
+
+ emit-glue-data(back-end, stream, ld);
+
+ output-variable(back-end, stream, initialize-library?, $false,
+ section: #"variables", export?: #f);
+ emit-data-footer(back-end, stream, initialize-library?);
+ output-code-start(back-end, stream);
+
+ emit-library-initializer(back-end, stream, ld,
+ emit-call-used, emit-call-crs,
+ emit-branch-on-init,
+ name, harp-output?, debug-info?);
+
+ emit-shared-library-entry-points(back-end, stream, ld,
+ harp-output?: harp-output?,
+ debug-info?: debug-info?);
+
+ unless (main-unit?)
+ emit-executable-entry-points(back-end, stream, ld,
+ harp-output?: harp-output?,
+ debug-info?: debug-info?);
+ end;
+
+ for (init-name in used-glue-names, library-name in lds)
+ cache-import-in-library(back-end, init-name, library-name);
+ end for;
+ emit-imports(back-end, base-name, ld);
+ emit-footer(back-end, stream);
+ end dynamic-bind;
end with-harp-variables;
- if (downloadable-data?)
- data := outputter-downloadable-data(back-end, *harp-outputter*);
- end if;
-
- end with-harp-outputter;
-
- if (main-unit?)
-
- let base-name = main-unit-name(lib-name, downloadable-data?);
-
- with-harp-outputter(back-end,
- stream,
- ld,
- base: base-name,
- harp-output?: harp-output?,
- assembler-output?: assembler-output?,
- model-object-protocol?: #f,
- dynamic-linking-protocol?: *interactive-mode?*,
- download?: downloadable-data?)
-
- with-harp-variables(back-end)
-
- dynamic-bind (*emitting-init-code?* = #t)
-
- emit-header(back-end, stream);
-
- output-code-start(back-end, stream);
+ if (downloadable-data?)
+ data := outputter-downloadable-data(back-end, *harp-outputter*);
+ end if;
+ end with-harp-outputter;
+
+ if (main-unit?)
+ let base-name = main-unit-name(lib-name, downloadable-data?);
+
+ with-harp-outputter(back-end,
+ stream,
+ ld,
+ base: base-name,
+ harp-output?: harp-output?,
+ assembler-output?: assembler-output?,
+ model-object-protocol?: #f,
+ dynamic-linking-protocol?: *interactive-mode?*,
+ download?: downloadable-data?)
+ with-harp-variables (back-end)
+ dynamic-bind (*emitting-init-code?* = #t)
+ emit-header(back-end, stream);
+
+ output-code-start(back-end, stream);
+
+ emit-executable-entry-points (back-end, stream, ld,
+ harp-output?: harp-output?,
+ debug-info?: debug-info?);
- emit-executable-entry-points
- (back-end, stream, ld,
- harp-output?: harp-output?,
- debug-info?: debug-info?);
-
- emit-imports(back-end, base-name, ld);
-
- emit-footer(back-end, stream);
-
- end dynamic-bind;
+ emit-imports(back-end, base-name, ld);
+ emit-footer(back-end, stream);
+ end dynamic-bind;
end with-harp-variables;
- if (downloadable-data?)
- assert(~data, "downloadable data with main unit not supported yet");
- data := outputter-downloadable-data(back-end, *harp-outputter*);
- end if;
-
- end with-harp-outputter;
-
+ if (downloadable-data?)
+ assert(~data, "downloadable data with main unit not supported yet");
+ data := outputter-downloadable-data(back-end, *harp-outputter*);
+ end if;
+ end with-harp-outputter;
end if;
-
data
end method;
define open generic emit-glue-data
- (back-end :: <harp-back-end>, stream, ld) => ();
+ (back-end :: <harp-back-end>, stream, ld)
+ => ();
define sideways method emit-glue-data
- (back-end :: <harp-back-end>, stream, ld) => ()
+ (back-end :: <harp-back-end>, stream, ld)
+ => ();
// do nothing by default
end method;
define open generic emit-executable-entry-points
(back-end :: <harp-back-end>, stream, ld,
- #key harp-output?, debug-info?) => ();
+ #key harp-output?, debug-info?)
+ => ();
define sideways method emit-executable-entry-points
(back-end :: <harp-back-end>, stream, ld,
#key harp-output?, debug-info?) => ()
-
let constant-ref = curry(ins--constant-ref, back-end);
let lib-name = as-lowercase(as(<string>, library-description-emit-name(ld)));
let name = glue-name(lib-name);
let name-ref = constant-ref(name);
let dylan-library? = *compiling-dylan?*;
let mangled-lib-name = harp-raw-mangle(lib-name);
- let init-dylan-library = ins--indirect-constant-ref(back-end,
"_init_dylan_library");
- let dylandllentry =
constant-ref(shared-library-runtime-entry-point-name(back-end));
+ let init-dylan-library
+ = ins--indirect-constant-ref(back-end, "_init_dylan_library");
+ let dylandllentry
+ = constant-ref(shared-library-runtime-entry-point-name(back-end));
output-external(back-end, stream, init-dylan-library);
output-external(back-end, stream, dylandllentry);
let dllentry =
invoke-harp(back-end,
- method(back-end :: <harp-back-end>)
- ins--move(back-end, init-dylan-library, name-ref);
- ins--jmp(back-end, dylandllentry, 1);
- end method,
+ method (back-end :: <harp-back-end>)
+ ins--move(back-end, init-dylan-library, name-ref);
+ ins--jmp(back-end, dylandllentry, 1);
+ end method,
shared-library-entry-point-name(back-end, mangled-lib-name),
section: #"init-code",
harp-debug: harp-output?,
export: #f);
output-compiled-lambda(back-end, stream, dllentry,
- section: #"init-code",
+ section: #"init-code",
debug-info?: debug-info?);
let dylanexeentry = constant-ref(c-name(back-end, "dylan_main"));
output-external(back-end, stream, dylanexeentry);
let exeentry =
invoke-harp(back-end,
- method(back-end :: <harp-back-end>)
+ method(back-end :: <harp-back-end>)
ins--move(back-end, init-dylan-library, name-ref);
ins--jmp(back-end, dylanexeentry, 1);
end method,
@@ -356,7 +347,6 @@
unless (dylan-library?)
cache-import-in-library(back-end, dylan-main, dylan-library-description());
end unless;
-
end method;
define open generic emit-shared-library-entry-points
@@ -411,11 +401,7 @@
// other objects are fixed up at startup time by doing a number of
// indirections off that
//
-// Gluefile generator emits Binary "dyimp" section for dynamic linking
-// in interactive compilation mode only; in batch compilation this has
-// to be delayed until link-time in the build-system in order to support
-// DLL Unification of Dylan libraries
-//
+// The gluefile generator emits a binary "dyimp" section for dynamic linking.
//
@@ -443,24 +429,23 @@
define variable *iep-offset-mask* = #f;
-define inline function iep-offset-mask ()
- => (offset-mask :: <integer>)
+define inline function iep-offset-mask () => (offset-mask :: <integer>);
*iep-offset-mask*
- | (begin
- *iep-offset-mask* :=
- logior(iep-runtime-slot-offset() + 1, $offset-mask);
- end);
+ | (begin
+ *iep-offset-mask* :=
+ logior(iep-runtime-slot-offset() + 1, $offset-mask);
+ end);
end;
define method function-offset-mask
- (back-end :: <harp-back-end>, o :: <&method>) => (i :: <integer>)
- mep-offset-mask();
+ (back-end :: <harp-back-end>, o :: <&method>) => (i :: <integer>);
+ mep-offset-mask()
end method;
define method function-offset-mask
(back-end :: <harp-back-end>, o :: <&keyword-method>) => (i :: <integer>)
- iep-offset-mask();
+ iep-offset-mask()
end method;
@@ -472,22 +457,23 @@
| (begin
*method-offset-mask* :=
add-offset-mask(-1,
- generic-function-methods-runtime-slot-offset() + 1,
- 0);
+ generic-function-methods-runtime-slot-offset() + 1,
+ 0);
end);
end;
define inline method add-offset-mask
(mask :: <integer>, field :: <integer>, pos :: <integer>)
- => (mask :: <integer>)
+ => (mask :: <integer>);
let offset = pos * $offset-width;
logand(mask,
- logior(ash(field, offset), offset-mask(offset)));
+ logior(ash(field, offset), offset-mask(offset)))
end;
define inline function offset-mask
- (offset :: <integer>) => (mask :: <integer>)
- lognot(ash(#xff, offset))
+ (offset :: <integer>)
+ => (mask :: <integer>);
+ lognot(ash(#xff, offset))
end function;
define method add-offset-masks(mask :: <integer>, #rest fields)
@@ -511,20 +497,20 @@
for (i :: <integer> from 0 below factor)
result := add-offset-mask(result,
- $method-byte-offset-fill,
- i + pos);
+ $method-byte-offset-fill,
+ i + pos);
end;
add-offset-mask(result,
- generic-method-offset(method-number - factor *
$method-byte-offset-max),
- factor + pos);
+ generic-method-offset(method-number - factor *
$method-byte-offset-max),
+ factor + pos)
end method;
-define inline method generic-method-offset(method-number :: <integer>)
+define inline method generic-method-offset (method-number :: <integer>)
=> (offset :: <integer>)
1 + 3 * method-number
end method;
-define inline method generic-method-offset?(method-number :: <integer>)
+define inline method generic-method-offset? (method-number :: <integer>)
=> (encodeable? :: <boolean>)
method-number < 2 * $method-byte-offset-max
end method;
@@ -537,9 +523,9 @@
*wrapper-offset-mask*
| (begin
*wrapper-offset-mask* :=
- add-offset-masks(-1,
+ add-offset-masks(-1,
class-implementation-class-runtime-slot-offset() + 1,
- class-mm-wrapper-runtime-slot-offset() + 1);
+ class-mm-wrapper-runtime-slot-offset() + 1);
end);
end;
@@ -550,7 +536,7 @@
*class-constructor-offset-mask*
| (begin
*class-constructor-offset-mask* :=
- add-offset-masks(-1,
+ add-offset-masks(-1,
class-implementation-class-runtime-slot-offset() + 1,
class-constructor-runtime-slot-offset() + 1);
end);
@@ -559,19 +545,6 @@
// Emitters of the imported data fixups
-define macro with-harp-imports-emitter
- { with-harp-imports-emitter (?description:expression) ?:body end }
- => {
- if (*interactive-mode?*)
- ?body
- else
- with-build-area-output (?=stream = ?description, name:
"_imports.import")
- ?body
- end;
- end;
- }
-end macro;
-
define open generic emit-library-imported-data
(back-end :: <harp-back-end>, stream, description :: <library-description>,
#key compilation-layer)
@@ -580,73 +553,60 @@
define method emit-library-imported-data
(back-end :: <harp-back-end>, stream, description :: <library-description>,
#key compilation-layer)
- => ()
+ => ();
unless (*compiling-dylan?*)
-
- with-harp-imports-emitter(description)
-
- let seen :: <table> = make(<table>);
- let first-cr = #f;
- let crs =
+ let seen :: <table> = make(<table>);
+ let first-cr = #f;
+ let crs =
if (*interactive-mode?*)
- compilation-context-records(compilation-layer)
+ compilation-context-records(compilation-layer)
else
- let combined-cr =
- library-description-combined-record(description);
- (combined-cr & list(combined-cr))
- | compilation-context-records(description);
- end;
-
- for (cr :: <compilation-record> in crs,
- first? = #t then #f)
-
- with-dependent ($compilation of cr)
-
- if (first?) first-cr := cr end;
- let heap = cr.compilation-record-model-heap;
- let objects
- = if (heap)
- heap.heap-referenced-objects
- else
- compilation-record-heap-referenced-objects(cr);
- end if;
-
- // dynamic-bind (*current-heap* = heap)
-
- for (object in objects)
- emit-imported-data(back-end, stream, object, seen, first?);
- end for;
-
- // end dynamic-bind;
-
- end with-dependent;
-
- end for;
-
- unless (*interactive-mode?*)
-
- if (first-cr)
-
- with-dependent ($compilation of first-cr)
-
- // Registration of dylan constants that may be referenced out-of-heap
- emit-imported-data(back-end, stream,
^iep(dylan-value($symbol-fixup-name)), seen, #f,
- import?: #t);
- emit-imported-data(back-end, stream,
^iep(dylan-value(#"unbound-instance-slot")), seen, #f,
- import?: #t);
- emit-imported-data(back-end, stream,
^iep(dylan-value(#"type-check-error")), seen, #f,
- import?: #t);
-
- format(stream, "\n");
-
+ let combined-cr =
+ library-description-combined-record(description);
+ (combined-cr & list(combined-cr))
+ | compilation-context-records(description);
end;
-
- end;
-
- end unless;
-
- end with-harp-imports-emitter;
-
+
+ for (cr :: <compilation-record> in crs,
+ first? = #t then #f)
+ with-dependent ($compilation of cr)
+ if (first?) first-cr := cr end;
+ let heap = cr.compilation-record-model-heap;
+ let objects
+ = if (heap)
+ heap.heap-referenced-objects
+ else
+ compilation-record-heap-referenced-objects(cr);
+ end if;
+
+ // dynamic-bind (*current-heap* = heap)
+ for (object in objects)
+ emit-imported-data(back-end, stream, object, seen, first?);
+ end for;
+ // end dynamic-bind;
+ end with-dependent;
+ end for;
+
+ unless (*interactive-mode?*)
+ if (first-cr)
+ with-dependent ($compilation of first-cr)
+ // Registration of dylan constants that may be
+ // referenced out-of-heap
+ emit-imported-data (back-end, stream,
+ ^iep(dylan-value($symbol-fixup-name)),
+ seen, #f,
+ import?: #t);
+ emit-imported-data(back-end, stream,
+ ^iep(dylan-value(#"unbound-instance-slot")),
+ seen, #f,
+ import?: #t);
+ emit-imported-data(back-end, stream,
+ ^iep(dylan-value(#"type-check-error")),
+ seen, #f,
+ import?: #t);
+ end;
+ end;
+ end unless;
end unless;
end method;
@@ -655,11 +615,11 @@
{ define ?options emit-import-method ?:name (?class:name) ?:body end }
=>
{
-
define ?options method ?name
- (?=back-end :: <harp-back-end>, ?=stream, ?=o :: ?class, ?=seen ::
<table>, ?=first?,
+ (?=back-end :: <harp-back-end>, ?=stream,
+ ?=o :: ?class, ?=seen :: <table>, ?=first?,
#key import?)
- => (emitted? :: <boolean>)
+ => (emitted? :: <boolean>);
let seen? =
unless (?=first?)
element(?=seen, ?=o, default: #f);
@@ -669,71 +629,62 @@
if (seen?)
seen? == #"emitted"
else
-
- let import? = import? | dll-imported-object?(?=back-end, ?=o);
+ let import? = import? | dll-imported-object?(?=back-end, ?=o);
if (import?)
- ?body
+ ?body
end if;
- if (?=emitted?) ?=seen[?=o] := #"emitted"; #t
- else ?=seen[?=o] := #t; #f end;
-
- end if;
+ if (?=emitted?)
+ ?=seen[?=o] := #"emitted";
+ #t
+ else
+ ?=seen[?=o] := #t;
+ #f
+ end
+ end if
end method
-
}
options:
-
- {} => {}
-
- {?:name} => {?name}
+ { } => { }
+ { ?:name } => { ?name }
end macro;
define method emit-imported-data
- (back-end :: <harp-back-end>, stream, o, seen :: <table>, first?,
- #key) => (emitted? :: <boolean>)
+ (back-end :: <harp-back-end>, stream, o, seen :: <table>, first?, #key)
+ => (emitted? :: <boolean>)
end method;
-
// IEPs are derived from methods
define emit-import-method emit-imported-data (<&iep>)
-
unless (model-externally-visible??(o))
-
let name = emit-imported-name(back-end, stream, o);
let f :: <&method> = o.function;
let f-name = emit-name(back-end, stream, f);
- let emitted?? = emit-imported-data(back-end, stream, f, seen, #f, import?:
#t);
+ let emitted??
+ = emit-imported-data(back-end, stream, f, seen, #f, import?: #t);
unless (emitted??)
cache-import-in-library(back-end, f-name, model-library-description(f));
end;
output-imported-data(back-end, stream,
- name, f-name, function-offset-mask(back-end, f));
-
+ name, f-name, function-offset-mask(back-end, f));
emitted? := #t;
-
end unless;
-
end emit-import-method;
// methods are derived from generic methods list or bindings
define emit-import-method emit-imported-data (<&method>)
-
let (internal?, method-number?) = model-internal-only?(o);
-
if (internal?)
-
if (method-number?)
-
let method-number :: <integer> = method-number?;
let name = emit-imported-name(back-end, stream, o);
let gf :: <&generic-function> = internal?;
@@ -745,22 +696,27 @@
emit-generic-methods-name(back-end, stream, gf-name);
end;
- let emitted?? =
- gf-sealed? & emit-imported-data(back-end, stream, gf, seen, #f,
import?: #t);
+ let emitted??
+ = gf-sealed?
+ & emit-imported-data(back-end, stream, gf, seen, #f, import?: #t);
unless (emitted??)
- cache-import-in-library(back-end, gf-root,
model-library-description(gf));
+ cache-import-in-library(back-end, gf-root,
+ model-library-description(gf));
end;
- let offset-mask :: <integer> =
- if (gf-sealed?) method-offset-mask()
- else $offset-mask end;
- let offset :: <integer> =
- generic-method-offset-mask(offset-mask, method-number, 1);
+ let offset-mask :: <integer>
+ = if (gf-sealed?)
+ method-offset-mask()
+ else
+ $offset-mask
+ end;
+ let offset :: <integer>
+ = generic-method-offset-mask(offset-mask, method-number, 1);
output-imported-data(back-end, stream,
name, gf-root,
- offset);
+ offset);
else
let binding :: <module-binding> = internal?;
emit-imported-binding-data(back-end, stream, o, binding);
@@ -768,23 +724,23 @@
emitted? := #t;
end if;
-
end emit-import-method;
// class-constructor methods are derived from classes
define emit-import-method emit-imported-data (<&initializer-method>)
-
let class :: <&class> = o.^function-signature.^signature-values.first;
let name = emit-imported-name(back-end, stream, o);
let class-name = emit-name(back-end, stream, class);
- let emitted?? = emit-imported-data(back-end, stream, class, seen, #f,
import?: #t);
+ let emitted??
+ = emit-imported-data(back-end, stream, class, seen, #f, import?: #t);
unless (emitted??)
- cache-import-in-library(back-end, class-name,
model-library-description(class));
+ cache-import-in-library(back-end, class-name,
+ model-library-description(class));
end;
output-imported-data(back-end, stream,
@@ -795,75 +751,70 @@
define inline method emit-imported-binding-data
(back-end :: <harp-back-end>, stream, o, binding :: <module-binding>) => ()
-
let name = emit-imported-name(back-end, stream, o);
let binding-name = emit-reference(back-end, stream, binding);
- cache-import-in-library(back-end, binding-name,
model-library-description(o));
+ cache-import-in-library(back-end, binding-name,
+ model-library-description(o));
output-imported-data(back-end, stream,
- name, binding-name, $offset-mask);
-
+ name, binding-name, $offset-mask);
end method;
define inline emit-import-method emit-imported-data-with-binding (<object>)
-
let internal? = model-internal-only?(o);
-
if (internal?)
-
let binding :: <module-binding> = internal?;
emit-imported-binding-data(back-end, stream, o, binding);
emitted? := #t;
-
end if;
-
end emit-import-method;
// generics are derived from bindings
define method emit-imported-data
- (back-end :: <harp-back-end>, stream, o :: <&generic-function>, seen ::
<table>, first?,
- #key import?)
- => (emitted? :: <boolean>)
+ (back-end :: <harp-back-end>, stream,
+ o :: <&generic-function>, seen :: <table>, first?, #key import?)
+ => (emitted? :: <boolean>);
emit-imported-data-with-binding
- (back-end, stream, o, seen, first?, import?: import?);
+ (back-end, stream, o, seen, first?, import?: import?)
end method;
// classes are derived from bindings
define method emit-imported-data
- (back-end :: <harp-back-end>, stream, o :: <&class>, seen :: <table>,
first?,
+ (back-end :: <harp-back-end>, stream,
+ o :: <&class>, seen :: <table>, first?,
#key import?)
- => (emitted? :: <boolean>)
+ => (emitted? :: <boolean>);
emit-imported-data-with-binding
- (back-end, stream, o, seen, first?, import?: import?);
+ (back-end, stream, o, seen, first?, import?: import?)
end method;
// wrappers are derived from their classes
define emit-import-method emit-imported-data (<&mm-wrapper>)
-
let class :: <&class> = o.^mm-wrapper-implementation-class.^iclass-class;
let name = emit-imported-name(back-end, stream, o);
let class-name = emit-name(back-end, stream, class);
- let emitted?? = emit-imported-data(back-end, stream, class, seen, #f,
import?: #t);
+ let emitted??
+ = emit-imported-data(back-end, stream, class, seen, #f, import?: #t);
unless (emitted??)
- cache-import-in-library(back-end, class-name,
model-library-description(class));
+ cache-import-in-library(back-end, class-name,
+ model-library-description(class));
end;
output-imported-data(back-end, stream,
name, class-name, wrapper-offset-mask());
emitted? := #t;
-
end emit-import-method;
@@ -871,31 +822,20 @@
define method output-imported-data
(back-end :: <harp-back-end>, stream,
- name :: <byte-string>, import :: <byte-string>, offset :: <integer>) => ()
- if (*interactive-mode?*)
-
- output-external(back-end, stream, import, import?: #t);
-
- output-public(back-end, stream, name);
-
- output-definition(back-end, stream, name,
- section: #"variables");
-
- output-data-item(back-end, stream, import,
- import?: #t, offset: offset);
-
- emit-data-footer(back-end, stream, name);
-
- else
- format(stream, "%s\n", name);
- format(stream, "%s\n", import);
- format(stream, "%d\n", offset);
- end if;
+ name :: <byte-string>, import :: <byte-string>, offset :: <integer>)
+ => ();
+ output-external(back-end, stream, import, import?: #t);
+ output-public(back-end, stream, name);
+
+ output-definition(back-end, stream, name,
+ section: #"variables");
+
+ output-data-item(back-end, stream, import,
+ import?: #t, offset: offset);
+
+ emit-data-footer(back-end, stream, name);
end method;
-
-
// eof
-
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-link-object.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-link-object.dylan
(original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-link-object.dylan Thu Nov
11 21:11:22 2004
@@ -7,74 +7,94 @@
Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
-
/// VARIABLES
define method runtime-module-binding-type?
- (binding :: <module-binding>) => (binding-type)
+ (binding :: <module-binding>)
+ => (binding-type);
unless (constant?(binding))
let binding-type = binding.binding-type-model-object;
let declared? = binding-type ~== dylan-value(#"<object>");
if (declared?)
- if (binding-type) binding-type
+ if (binding-type)
+ binding-type
else
unsupplied()
end if
end if
- end unless;
+ end unless
end method;
define method emit-forward
- (back-end :: <harp-back-end>, stream, o :: <module-binding>) => ()
- let name = emit-reference(back-end, stream, o);
- let export? = model-externally-visible?(o);
- emit-public(back-end, stream, o, name: name, export?: export?);
- let binding-type = o.runtime-module-binding-type?;
- if (binding-type)
- emit-public(back-end, stream, unsupplied(),
- name: concatenate(name, $runtime-module-binding-type-marker),
- export?: export?);
- end if;
+ (back-end :: <harp-back-end>, stream, o :: <module-binding>)
+ => ();
+ let name = emit-reference(back-end, stream, o);
+ let export? = model-externally-visible?(o);
+ emit-public(back-end, stream, o, name: name, export?: export?);
+ let binding-type = o.runtime-module-binding-type?;
+ if (binding-type)
+ emit-public(back-end, stream, unsupplied(),
+ name: concatenate(name, $runtime-module-binding-type-marker),
+ export?: export?);
+ end if;
end method;
define method emit-forward
- (back-end :: <harp-back-end>, stream, o :: <&mep>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <&mep>)
+ => ();
emit-extern(back-end, stream, emit-reference(back-end, stream, o), o, #f);
end method;
// CLASSES
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&class>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&class>)
+ => ();
emit-public(back-end, stream, o,
- export?: model-externally-visible?(o) &
model-externally-visible??(o));
+ export?:
+ model-externally-visible?(o)
+ & model-externally-visible??(o));
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&mm-wrapper>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&mm-wrapper>)
+ => ();
emit-public(back-end, stream, o, export?: #f);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&slot-descriptor>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&slot-descriptor>)
+ => ();
emit-public(back-end, stream, o);
end method;
-define inline function emit-external-ep(back-end :: <harp-back-end>, stream, o)
+define inline function emit-external-ep
+ (back-end :: <harp-back-end>, stream, o)
+ => ();
emit-extern(back-end, stream, emit-reference(back-end, stream, o), o, #f);
end function;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&singular-terminal-engine-node>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream,
+ o :: <&singular-terminal-engine-node>)
+ => ();
// We have to fudge the externalness of these odd objects.
model-externally-visible?(o) := #t;
emit-public(back-end, stream, o);
emit-external-ep(back-end, stream, o.^engine-node-entry-point);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&engine-node>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream,
+ o :: <&engine-node>)
+ => ();
emit-external-ep(back-end, stream, o.^engine-node-entry-point);
end method;
define method emit-forward
- (back-end :: <harp-back-end>, stream, o :: <&generic-function>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <&generic-function>)
+ => ();
if (o.model-has-definition?)
let name :: <byte-string> = emit-name(back-end, stream, o);
let export? = model-externally-visible?(o);
@@ -89,87 +109,119 @@
emit-external-ep(back-end, stream, o.^xep);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&domain>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&domain>)
+ => ();
emit-public(back-end, stream, o);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&namespace>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&namespace>)
+ => ();
emit-public(back-end, stream, o);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&method>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&method>)
+ => ();
if (o.model-has-definition?)
emit-public(back-end, stream, o,
- export?: model-externally-visible?(o) &
model-externally-visible??(o),
- derived-model-object:
- (instance?(o, <&lambda>) & make-derived-model-object(o.^iep,
$iep-suffix)));
+ export?:
+ model-externally-visible?(o) & model-externally-visible??(o),
+ derived-model-object:
+ (instance?(o, <&lambda>)
+ & make-derived-model-object(o.^iep, $iep-suffix)));
end if;
emit-external-ep(back-end, stream, o.^xep);
end method;
-define method emit-forward (back-end :: <harp-back-end>, stream, o ::
<&keyword-method>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&keyword-method>)
+ => ();
next-method();
emit-external-ep(back-end, stream, o.^mep);
end method;
-define method emit-forward(back-end :: <harp-back-end>, stream, o ::
<&bottom-type>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <&bottom-type>)
+ => ();
emit-public(back-end, stream, o);
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o ::
<boolean>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <boolean>)
+ => ();
emit-public(back-end, stream, o);
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o ::
<mapped-unbound>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <mapped-unbound>)
+ => ();
emit-public(back-end, stream, o);
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o == #()) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o == #())
+ => ();
emit-public(back-end, stream, o);
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o :: <vector>)
=> ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <vector>)
+ => ();
if (o.model-has-definition?)
emit-public(back-end, stream, o);
end if;
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o :: <string>)
=> ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <string>)
+ => ();
if (o = "")
emit-public(back-end, stream, o);
end if;
end method emit-forward;
define method emit-uninterned-symbol
- (back-end :: <harp-back-end>, stream, o :: <uninterned-symbol>) => (name,
model-object)
+ (back-end :: <harp-back-end>, stream, o :: <uninterned-symbol>)
+ => (name, model-object);
let symbol :: <symbol> = as(<symbol>, o.symbol-name);
if (o.model-has-definition?)
values($dummy-name, symbol)
else
values(emit-reference(back-end, stream, symbol),
- unsupplied())
+ unsupplied())
end if
end method;
-define method emit-forward(back-end :: <harp-back-end>, stream, o ::
<uninterned-symbol>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <uninterned-symbol>)
+ => ();
if (o.model-has-definition?)
emit-public(back-end, stream, o);
end if;
end method emit-forward;
-define method emit-forward(back-end :: <harp-back-end>, stream, o ::
<model-properties>) => ()
+define method emit-forward
+ (back-end :: <harp-back-end>, stream, o :: <model-properties>)
+ => ();
if (instance?(o.model-definition, <constant-definition>))
emit-public(back-end, stream, o);
end if;
end method emit-forward;
define method emit-forward
- (back-end :: <harp-back-end>, stream, o) => ()
+ (back-end :: <harp-back-end>, stream, o)
+ => ();
+ // do nothing
end method;
define method emit-extern/import
- (back-end :: <harp-back-end>, stream, o :: <module-binding>, import? ::
<boolean>) => ()
+ (back-end :: <harp-back-end>, stream,
+ o :: <module-binding>,
+ import? :: <boolean>)
+ => ();
let name = emit-reference(back-end, stream, o);
let model-library = model-library-description(o);
emit-extern(back-end, stream, name, o, import?, model-library: model-library);
@@ -182,18 +234,18 @@
end method;
define method emit-extern/import
- (back-end :: <harp-back-end>, stream, o, import? :: <boolean>) => ()
+ (back-end :: <harp-back-end>, stream, o, import? :: <boolean>)
+ => ();
unless (o.direct-object?)
let name = emit-name(back-end, stream, o);
emit-extern(back-end, stream, name, o, import?,
- really-import?: import? & model-externally-visible??(o));
+ really-import?: import? & model-externally-visible??(o));
end unless;
end method;
-//
// Override external visibility of model-objects here
-
+//
// This can happen in the following cases:
//
// - model-objects (functions & classes) derived from their bindings
@@ -207,79 +259,80 @@
// from their imported parents
//
-define inline function model-externally-visible??(o)
+define inline function model-externally-visible?? (o)
=> (external? :: <boolean>)
~ model-internal-only?(o);
end;
-define method model-internal-only?(o)
+define method model-internal-only? (o)
#f
end method;
-define method model-internal-only?
- (o :: <&iep>)
+define method model-internal-only? (o :: <&iep>)
let f = o.function;
- instance?(f, <&lambda>) & f.lambda-runtime-function?;
+ instance?(f, <&lambda>)
+ & f.lambda-runtime-function?
end method;
-define method model-internal-only?(o :: <&mm-wrapper>)
+define method model-internal-only? (o :: <&mm-wrapper>)
#t
end method;
-define method model-internal-only?(o :: <&class>)
- binding-internal-only?(o);
+define method model-internal-only? (o :: <&class>)
+ binding-internal-only?(o)
end method;
-define method model-internal-only?(o :: <&generic-function>)
- binding-internal-only?(o);
+define method model-internal-only? (o :: <&generic-function>)
+ binding-internal-only?(o)
end method;
-define inline function binding-internal-only?(o)
- model-variable-binding(o);
+define inline function binding-internal-only? (o)
+ model-variable-binding(o)
end;
-define method model-internal-only?(o :: <&initializer-method>)
+define method model-internal-only? (o :: <&initializer-method>)
#t
end method;
-define method model-internal-only?(o :: <&method>)
+define method model-internal-only? (o :: <&method>)
let defn = o.model-definition;
- if (defn & form-compile-stage-only?(defn)) #f
+ if (defn & form-compile-stage-only?(defn))
+ #f
elseif (instance?(defn, <method-definition>))
+ let gf :: <module-binding> = form-variable-binding(defn);
+ let gf-model = binding-model-or-hollow-object(gf);
- let gf :: <module-binding> = form-variable-binding(defn);
- let gf-model = binding-model-or-hollow-object(gf);
-
- if (instance?(gf-model, <&generic-function>))
-
- // Goal reduction: only methods statically added in the
- // defining library of their generic are handled here
-
- let generic-library = home-library(binding-home(gf));
- let method-library = language-definition(form-library(defn));
-
- if (generic-library == method-library)
- let num :: <integer> = method-number(defn);
- if (num.generic-method-offset?)
- values(gf-model, num);
- else #f
- end;
- else #f
- end;
-
- // otherwise attempt to use their bindings
- else
- let internal? = binding-internal-only?(o);
- values(internal?, #f)
- end;
+ if (instance?(gf-model, <&generic-function>))
+ // Goal reduction: only methods statically added in the
+ // defining library of their generic are handled here
+ let generic-library = home-library(binding-home(gf));
+ let method-library = language-definition(form-library(defn));
+
+ if (generic-library == method-library)
+ let num :: <integer> = method-number(defn);
+ if (num.generic-method-offset?)
+ values(gf-model, num)
+ else
+ #f
+ end;
+ else
+ #f
+ end
+ else
+ // otherwise attempt to use their bindings
+ let internal? = binding-internal-only?(o);
+ values(internal?, #f)
+ end
else
let internal? = binding-internal-only?(o);
values(internal?, #f)
- end;
+ end
end method;
define method emit-extern/import
- (back-end :: <harp-back-end>, stream, o :: <&c-function>, import? ::
<boolean>) => ()
+ (back-end :: <harp-back-end>, stream,
+ o :: <&c-function>, import? :: <boolean>)
+ => ()
if (o.binding-name)
let name = emit-name(back-end, stream, o);
emit-extern(back-end, stream, name, unsupplied(), import?);
@@ -287,14 +340,17 @@
end method;
define method emit-extern/import
- (back-end :: <harp-back-end>, stream, v :: <&c-variable>, import? ::
<boolean>) => ()
+ (back-end :: <harp-back-end>, stream,
+ v :: <&c-variable>, import? :: <boolean>)
+ => ();
let name = c-name(back-end, v.name);
-
emit-extern(back-end, stream, name, v, v.dll-import?);
end method;
define method emit-extern/import
- (back-end :: <harp-back-end>, stream, o :: <&raw-aggregate-type>, import?
:: <boolean>) => ()
+ (back-end :: <harp-back-end>, stream,
+ o :: <&raw-aggregate-type>, import? :: <boolean>)
+ => ();
// do nothing
end;
@@ -310,13 +366,13 @@
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&iep>) => ()
-
+ (back-end :: <harp-back-end>, stream, o :: <&iep>)
+ => ();
if (o.code)
if (*stream-outputters?*)
emit-comment(stream, "%=", o.function);
end if;
- for(c in o.code)
+ for (c in o.code)
let externals = c.lambda-externals;
output-compiled-lambda(back-end, stream, c, debug-info?: *debug-info?*);
cache-imports-in-lambda(back-end, externals);
@@ -327,37 +383,38 @@
else
error("Code Generation must precede Linking");
end if;
-
end method;
define method emit-init-code-definition
- (back-end :: <harp-back-end>, stream, name) => ()
-
- local method emit-compiled-lambda(lambda, #key model-object = unsupplied())
- let externals = lambda.lambda-externals;
- output-compiled-lambda(back-end, stream,
- lambda,
- section: #"init-code",
- debug-info?: *debug-info?*,
- model-object: model-object);
- cache-imports-in-lambda(back-end, externals);
- end method;
-
- dynamic-bind (*emitting-init-code?* = #t)
+ (back-end :: <harp-back-end>, stream, name)
+ => ();
+ local
+ method emit-compiled-lambda (lambda, #key model-object = unsupplied())
+ let externals = lambda.lambda-externals;
+ output-compiled-lambda(back-end, stream,
+ lambda,
+ section: #"init-code",
+ debug-info?: *debug-info?*,
+ model-object: model-object);
+ cache-imports-in-lambda(back-end, externals);
+ end method;
+ dynamic-bind (*emitting-init-code?* = #t)
emit-comment(stream, "SYSTEM INIT CODE");
-
let system-name = concatenate(name, $system-init-code-tag);
let system-lambda = emitted-name(as(<symbol>, system-name));
let system-init-code = *current-heap*.heap-root-system-init-code;
if (#t)
let fixups-name = format-to-string("%s_fixups", system-name);
- emit-compiled-lambda(emitted-name(as(<symbol>, concatenate(fixups-name,
"_code"))),
- model-object: emitted-name(as(<symbol>,
fixups-name)));
+ emit-compiled-lambda(emitted-name(as(<symbol>,
+ concatenate(fixups-name, "_code"))),
+ model-object:
+ emitted-name(as(<symbol>, fixups-name)));
for (o in system-init-code, count from 0)
- let init-name = format-to-string("%s_%d", system-name, count);
- emit-compiled-lambda(o.^iep.code,
- model-object: emitted-name(as(<symbol>,
init-name)));
+ let init-name = format-to-string("%s_%d", system-name, count);
+ emit-compiled-lambda(o.^iep.code,
+ model-object:
+ emitted-name(as(<symbol>, init-name)));
end for;
emit-compiled-lambda(system-lambda);
else
@@ -365,50 +422,55 @@
end if;
emit-comment(stream, "USER INIT CODE");
-
let user-name = concatenate(name, $user-init-code-tag);
let user-lambda = emitted-name(as(<symbol>, user-name));
let user-init-code = *current-heap*.heap-root-init-code;
if (#t)
for (o in user-init-code, count from 0)
- let init-name = format-to-string("%s_%d", user-name, count);
+ let init-name = format-to-string("%s_%d", user-name, count);
emit-compiled-lambda(o.^iep.code,
- model-object: emitted-name(as(<symbol>,
init-name)));
+ model-object:
+ emitted-name(as(<symbol>, init-name)));
end for;
emit-compiled-lambda(user-lambda);
else
emit-compiled-lambda(user-lambda);
end if;
-
- end dynamic-bind;
-
+ end dynamic-bind;
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&kernel-ep>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <&kernel-ep>)
+ => ();
+ // do nothing
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&mep>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <&mep>)
+ => ();
+ // do nothing
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <runtime-object>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <runtime-object>)
+ => ();
+ // do nothing
end method;
define method emit-definition // !@#$ need unifying type
- (back-end :: <harp-back-end>, stream, o) => ()
+ (back-end :: <harp-back-end>, stream, o)
+ => ();
// Direct objects are always emitted in full at point of reference and
// are never referred to by name, hence no need for a forward declaration.
unless (o.direct-object?)
let (name, model-object) =
select(o by instance?)
- <uninterned-symbol> =>
- emit-uninterned-symbol(back-end, stream, o);
- otherwise =>
- values($dummy-name, apropo-model-object(o));
+ <uninterned-symbol> =>
+ emit-uninterned-symbol(back-end, stream, o);
+ otherwise =>
+ values($dummy-name, apropo-model-object(o));
end select;
-
+
output-definition(back-end,
stream,
name,
@@ -418,7 +480,6 @@
emit-object(back-end, stream, o);
emit-data-footer(back-end, stream, name, model-object: model-object);
-
end unless;
end method;
@@ -438,8 +499,8 @@
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&generic-function>) => ()
-
+ (back-end :: <harp-back-end>, stream, o :: <&generic-function>)
+ => ();
// let req-size =
// spec-argument-number-required(signature-spec(o));
@@ -454,19 +515,16 @@
emit-data-footer(back-end, stream, $dummy-name, model-object: o);
if (emit-generic-methods-list?(o))
-
- let name = emit-generic-methods-name(back-end, stream, o);
- output-definition(back-end,
- stream,
- name,
- section: #"variables");
-
- emit-data-item(back-end, stream, o.^generic-function-methods);
-
- emit-data-footer(back-end, stream, name);
-
- end;
-
+ let name = emit-generic-methods-name(back-end, stream, o);
+ output-definition(back-end,
+ stream,
+ name,
+ section: #"variables");
+
+ emit-data-item(back-end, stream, o.^generic-function-methods);
+
+ emit-data-footer(back-end, stream, name);
+ end if;
end method;
@@ -483,7 +541,7 @@
define method emit-generic-methods-list?
(o :: <&generic-function>,
#key export?)
- => (emit?)
+ => (emit?);
let export? = export? | model-externally-visible?(o);
export?
& ~ o.^generic-function-sealed?
@@ -494,49 +552,47 @@
define method emit-generic-methods-name
(back-end :: <harp-back-end>, stream, o :: <&generic-function>)
- => (name :: <string>)
- concatenate-as(<byte-string>,
- emit-name(back-end, stream, o),
- $generic-methods-suffix);
+ => (name :: <string>);
+ concatenate-as(<byte-string>,
+ emit-name(back-end, stream, o),
+ $generic-methods-suffix)
end method;
define method emit-generic-methods-name
(back-end :: <harp-back-end>, stream, name :: <byte-string>)
- => (name :: <string>)
+ => (name :: <string>);
concatenate-as(<byte-string>,
name,
$generic-methods-suffix);
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&method>) => ()
-
- output-definition(back-end,
- stream,
- $dummy-name,
- model-object: o,
- section:
- if (instance?(o, <&closure-method-mixin>)
+ (back-end :: <harp-back-end>, stream, o :: <&method>)
+ => ();
+ output-definition(back-end,
+ stream,
+ $dummy-name,
+ model-object: o,
+ section:
+ if (instance?(o, <&closure-method-mixin>)
& method-top-level?(o))
- // special top-level closures are not cloned;
- // they are mutated by traceable signatures
- #"objects"
- else
- #"untraced-objects"
- end if);
-
- emit-object(back-end, stream, o);
-
- emit-data-footer(back-end, stream, $dummy-name, model-object: o);
+ // special top-level closures are not cloned;
+ // they are mutated by traceable signatures
+ #"objects"
+ else
+ #"untraced-objects"
+ end if);
+ emit-object(back-end, stream, o);
+ emit-data-footer(back-end, stream, $dummy-name, model-object: o);
end method;
define method emit-definition
- (back-end :: <harp-back-end>, stream, o :: <&raw-aggregate-type>) => ()
+ (back-end :: <harp-back-end>, stream, o :: <&raw-aggregate-type>)
+ => ();
// do nothing
end;
/*
-
Alternative, expensive contiguous list dumping of generic function
methods list at the level of the back-end instead of the Heaper
@@ -567,8 +623,8 @@
// INDIRECTION DEFINITIONS
define method emit-indirection-definition
- (back-end :: <harp-back-end>, stream, o :: <object>) => ()
-
+ (back-end :: <harp-back-end>, stream, o :: <object>)
+ => ();
let local-symbol = element(heap-symbols(*current-heap*), o, default: #f);
if (symbol-emitted?(local-symbol))
@@ -580,12 +636,11 @@
emit-data-item(back-end, stream, local-symbol.cg-uninterned-symbol);
emit-data-footer(back-end, stream, indirection);
end if;
-
end method;
define sideways method emit-object
- (back-end :: <harp-back-end>, stream, o :: <module-binding>) => (object)
-
+ (back-end :: <harp-back-end>, stream, o :: <module-binding>)
+ => (object);
output-definition(back-end, stream,
$dummy-name,
model-object: o,
@@ -615,33 +670,37 @@
end method;
define sideways method emit-object
- (back-end :: <harp-back-end>, stream, o :: <string>) => (object)
- let class-wrapper = ^class-mm-wrapper(&object-class(o));
- emit-data-item(back-end, stream, class-wrapper);
- emit-data-item(back-end, stream, o.size);
- unless (o.empty?)
- output-data-byte(back-end, stream, o);
- end unless;
- output-data-byte(back-end, stream, 0);
+ (back-end :: <harp-back-end>, stream, o :: <string>)
+ => (object);
+ let class-wrapper = ^class-mm-wrapper(&object-class(o));
+ emit-data-item(back-end, stream, class-wrapper);
+ emit-data-item(back-end, stream, o.size);
+ unless (o.empty?)
+ output-data-byte(back-end, stream, o);
+ end unless;
+ output-data-byte(back-end, stream, 0)
end method emit-object;
define sideways method emit-object // !@#$ NEED UNIFYING TYPE
- (back-end :: <harp-back-end>, stream, o :: <object>) => (object)
- let class = &object-class(o);
- let wrapper = ^class-mm-wrapper(class);
- emit-data-item(back-end, stream, wrapper);
- emit-line-comment(stream, "wrapper");
- for (slotd in ^instance-slot-descriptors(class))
- emit-object-slot(back-end, stream, class, slotd, o);
- end;
- let rpt = ^repeated-slot-descriptor(class);
- if (rpt)
- emit-object-slot(back-end, stream, class, rpt, o);
- end if;
+ (back-end :: <harp-back-end>, stream, o :: <object>)
+ => (object);
+ let class = &object-class(o);
+ let wrapper = ^class-mm-wrapper(class);
+ emit-data-item(back-end, stream, wrapper);
+ emit-line-comment(stream, "wrapper");
+ for (slotd in ^instance-slot-descriptors(class))
+ emit-object-slot(back-end, stream, class, slotd, o);
+ end;
+ let rpt = ^repeated-slot-descriptor(class);
+ if (rpt)
+ emit-object-slot(back-end, stream, class, rpt, o);
+ end if;
end method;
define method emit-object-slot
- (back-end :: <harp-back-end>, stream, class, slotd ::
<&any-instance-slot-descriptor>, o) => ()
+ (back-end :: <harp-back-end>, stream, class,
+ slotd :: <&any-instance-slot-descriptor>, o)
+ => ();
let the-slot = ^slot-value(o, slotd);
// just use the iep model for mep models
let the-slot =
@@ -652,53 +711,50 @@
the-slot
else
o.^iep
- end if;
- otherwise => the-slot;
- end select;
+ end if;
+ otherwise =>
+ the-slot;
+ end select;
emit-slot(back-end, stream, the-slot,
if (*stream-outputters?*) struct-field-name(class, slotd, 0)
else #f
end if);
-
end method;
define method emit-object-slot
(back-end :: <harp-back-end>, stream,
- class, slotd :: <&repeated-slot-descriptor>, o) => ()
- let size = ^slot-value(o, ^size-slot-descriptor(slotd));
+ class,
+ slotd :: <&repeated-slot-descriptor>,
+ o)
+ => ();
+ let repeated-size = ^slot-value(o, ^size-slot-descriptor(slotd));
if (slotd.^slot-type == dylan-value(#"<byte-character>"))
- for (i from 0 below size)
-
+ for (i from 0 below repeated-size)
emit-raw-data-item(back-end, stream,
- format-to-string("%s", ^repeated-slot-value(o, slotd,
i)));
-
+ format-to-string("%s",
+ ^repeated-slot-value(o, slotd, i)));
end;
else
- for (i from 0 below size)
-
+ for (i from 0 below repeated-size)
let value = ^repeated-slot-value(o, slotd, i);
-
emit-data-item(back-end, stream, value);
if (*stream-outputters?*)
- emit-line-comment(stream,
- " %s[%d] ",
- struct-field-name(class, slotd, i),
- i);
+ emit-line-comment(stream,
+ " %s[%d] ",
+ struct-field-name(class, slotd, i),
+ i);
end if;
end;
end if;
end method;
-
define function emit-slot(back-end :: <harp-back-end>, stream, o, field-name)
-
emit-data-item(back-end, stream, o);
if (*stream-outputters?*)
emit-line-comment(stream, " %s ", field-name);
end if;
-
end function emit-slot;
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker-library.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker-library.dylan
(original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker-library.dylan Thu Nov
11 21:11:22 2004
@@ -18,7 +18,8 @@
define module dfmc-harp-cg-linker
use functional-dylan;
use machine-word-lowlevel,
- import: { machine-word-unsigned-shift-left,
machine-word-unsigned-shift-right };
+ import: { machine-word-unsigned-shift-left,
+ machine-word-unsigned-shift-right };
use dfmc-harp-cg;
use dfmc-linker;
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.dylan (original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.dylan Thu Nov 11
21:11:22 2004
@@ -10,8 +10,8 @@
// define class <harp-linker> (<linker>) end;
-// *default-debug-info?* controls whether debug-info is output with compiled
lambdas
-// by default.
+// *default-debug-info?* controls whether debug-info is output with
+// compiled lambdas by default.
//
define variable *default-debug-info?* = #t;
@@ -27,8 +27,10 @@
define sideways method emit-library-records
(back-end :: <harp-back-end>, ld :: <library-description>,
#rest flags,
- #key harp-output? = unsupplied(), assembler-output? = unsupplied(), cr,
debug-info?,
- #all-keys) => ()
+ #key harp-output? = unsupplied(),
+ assembler-output? = unsupplied(), cr, debug-info?,
+ #all-keys)
+ => ();
if (cr)
apply(emit-library-record, back-end, cr, ld, force-link?: #t, flags);
else
@@ -39,23 +41,29 @@
end method;
define sideways method emit-library-record
- (back-end :: <harp-back-end>, cr :: <compilation-record>, ld ::
<library-description>,
+ (back-end :: <harp-back-end>,
+ cr :: <compilation-record>,
+ ld :: <library-description>,
#rest flags,
- #key harp-output? = unsupplied(), assembler-output? = unsupplied(),
force-link?, debug-info?,
- #all-keys) => ()
- local method emitter(cr :: <compilation-record>)
- let stream = #f;
- with-harp-outputter(back-end,
- stream,
- ld,
- name: compilation-record-name(cr),
- harp-output?: harp-output?,
- assembler-output?: assembler-output?)
- let name = cr.compilation-record-source-record.source-record-name;
- progress-line("Linking %s.dylan", name);
- apply(link-all, back-end, stream, cr, ld, flags);
- end with-harp-outputter;
- end method emitter;
+ #key harp-output? = unsupplied(),
+ assembler-output? = unsupplied(),
+ force-link?, debug-info?,
+ #all-keys)
+ => ();
+ local
+ method emitter (cr :: <compilation-record>)
+ let stream = #f;
+ with-harp-outputter(back-end,
+ stream,
+ ld,
+ name: compilation-record-name(cr),
+ harp-output?: harp-output?,
+ assembler-output?: assembler-output?)
+ let name = cr.compilation-record-source-record.source-record-name;
+ progress-line("Linking %s.dylan", name);
+ apply(link-all, back-end, stream, cr, ld, flags);
+ end with-harp-outputter;
+ end method emitter;
if (force-link?)
emitter(cr);
else
@@ -72,33 +80,36 @@
define sideways method link-and-download
(back-end :: <harp-back-end>, il :: <interactive-layer>, runtime-context,
#rest flags,
- #key harp-output? = unsupplied(), assembler-output? = unsupplied(),
debug-info? = #f,
+ #key harp-output? = unsupplied(),
+ assembler-output? = unsupplied(),
+ debug-info? = #f,
#all-keys)
- => (transaction-id)
-
+ => (transaction-id);
let crs = compilation-context-records(il);
let coff-files = make(<vector>, size: crs.size + 1);
let ld = il.interactive-layer-base;
- let component-name = as-lowercase(as(<byte-string>,
ld.library-description-emit-name));
+ let component-name
+ = as-lowercase(as(<byte-string>, ld.library-description-emit-name));
let init-function-name = glue-name(component-name);
let flags = vector(harp-output?: harp-output?,
assembler-output?: assembler-output?,
debug-info?: debug-info?);
- local method emitter(cr :: <compilation-record>) => (data)
- let stream = #f;
- with-harp-outputter(back-end,
- stream,
- ld,
- name: compilation-record-name(cr),
- harp-output?: harp-output?,
- assembler-output?: assembler-output?,
- download?: #t)
- progress-line("Interactive linking %s.", cr);
- apply(link-all, back-end, stream, cr, ld, flags);
- outputter-downloadable-data(back-end, *harp-outputter*);
- end with-harp-outputter;
- end method emitter;
+ local
+ method emitter(cr :: <compilation-record>) => (data)
+ let stream = #f;
+ with-harp-outputter(back-end,
+ stream,
+ ld,
+ name: compilation-record-name(cr),
+ harp-output?: harp-output?,
+ assembler-output?: assembler-output?,
+ download?: #t)
+ progress-line("Interactive linking %s.", cr);
+ apply(link-all, back-end, stream, cr, ld, flags);
+ outputter-downloadable-data(back-end, *harp-outputter*);
+ end with-harp-outputter;
+ end method emitter;
for (cr in crs, i from 0)
if (compilation-record-needs-linking?(cr))
@@ -110,43 +121,51 @@
end for;
let cr-names = map-as(<vector>, compilation-record-name, crs);
- coff-files[crs.size] :=
- emit-gluefile(back-end, ld, cr-names,
- harp-output?: harp-output?,
- assembler-output?: assembler-output?,
- downloadable-data?: #t,
- debug-info?: debug-info?,
- compilation-layer: il);
+ coff-files[crs.size]
+ := emit-gluefile(back-end, ld, cr-names,
+ harp-output?: harp-output?,
+ assembler-output?: assembler-output?,
+ downloadable-data?: #t,
+ debug-info?: debug-info?,
+ compilation-layer: il);
download-for-interactive-execution
(runtime-context, coff-files, component-name, init-function-name);
end method;
-define method dll-imported-object? (back-end :: <harp-back-end>, object) =>
(res :: <boolean>)
+define method dll-imported-object?
+ (back-end :: <harp-back-end>, object)
+ => (res :: <boolean>);
imported-object?(back-end, object) & (~ model-interactive?(object))
end method;
-define method dll-imported-binding? (back-end :: <harp-back-end>, object) =>
(res :: <boolean>)
- library-imported-binding?(current-library-description(), object) & (~
binding-interactive?(object))
+define method dll-imported-binding?
+ (back-end :: <harp-back-end>, object)
+ => (res :: <boolean>);
+ library-imported-binding?(current-library-description(), object)
+ & (~ binding-interactive?(object))
end method;
define method link-all
- (back-end :: <harp-back-end>, stream, cr :: <compilation-record>, ld ::
<library-description>,
+ (back-end :: <harp-back-end>,
+ stream,
+ cr :: <compilation-record>,
+ ld :: <library-description>,
#key debug-info? = *default-debug-info?*,
- #all-keys) => ()
-
+ #all-keys)
+ => ();
with-simple-abort-retry-restart
("Abort the emission phase", "Restart the emission phase")
with-harp-variables(back-end)
-
let heap = cr.compilation-record-model-heap;
- let current-library-mode =
current-library-description().library-description-compilation-mode;
- let loose-mode? = current-library-mode = #"loose";
- let interactive-mode? = current-library-mode = #"interactive";
+ let current-library-mode
+ = current-library-description().library-description-compilation-mode;
+ let loose-mode? = current-library-mode == #"loose";
+ let interactive-mode? = current-library-mode == #"interactive";
dynamic-bind (*compiling-dylan?* = compiling-dylan-library?(),
*current-heap* = heap,
@@ -154,61 +173,45 @@
*loose-mode?* = loose-mode?,
*interactive-mode?* = interactive-mode?,
*debug-info?* = debug-info? )
-
- block()
-
- register-dylan-code-models();
-
- emit-header(back-end, stream);
-
- emit-externs(back-end, stream, cr);
-
- emit-forwards(back-end, stream, cr);
-
- emit-indirection-definitions(back-end, stream, cr);
-
- emit-comment(stream, "Variables");
-
- for (binding in heap.heap-defined-bindings)
- emit-definition(back-end, stream, binding);
- end for;
-
- emit-comment(stream, "Objects");
-
- for (literal in heap.heap-defined-object-sequence)
- emit-data-definition(back-end, stream, literal);
- end for;
-
- output-code-start(back-end, stream);
-
- for (literal in heap.heap-defined-object-sequence)
- emit-code-definition(back-end, stream, literal);
- end for;
-
- emit-comment(stream, "Top-level");
-
- let top-level-id =
- cr-init-name(compilation-record-library(cr),
- compilation-record-name(cr));
-
- emit-init-code-definition(back-end, stream, top-level-id);
-
- emit-comment(stream, "eof");
-
- emit-imports(back-end, cr, ld);
-
- emit-footer(back-end, stream);
-
- cleanup
-
- deregister-dylan-code-models();
-
- end block;
-
+ block()
+ register-dylan-code-models();
+ emit-header(back-end, stream);
+ emit-externs(back-end, stream, cr);
+ emit-forwards(back-end, stream, cr);
+ emit-indirection-definitions(back-end, stream, cr);
+
+ emit-comment(stream, "Variables");
+ for (binding in heap.heap-defined-bindings)
+ emit-definition(back-end, stream, binding);
+ end for;
+
+ emit-comment(stream, "Objects");
+ for (literal in heap.heap-defined-object-sequence)
+ emit-data-definition(back-end, stream, literal);
+ end for;
+
+ output-code-start(back-end, stream);
+ for (literal in heap.heap-defined-object-sequence)
+ emit-code-definition(back-end, stream, literal);
+ end for;
+
+ emit-comment(stream, "Top-level");
+ let top-level-id =
+ cr-init-name(compilation-record-library(cr),
+ compilation-record-name(cr));
+
+ emit-init-code-definition(back-end, stream, top-level-id);
+
+ emit-comment(stream, "eof");
+
+ emit-imports(back-end, cr, ld);
+
+ emit-footer(back-end, stream);
+ cleanup
+ deregister-dylan-code-models();
+ end block;
end dynamic-bind;
-
end with-harp-variables;
-
end with-simple-abort-retry-restart;
end method;
@@ -231,16 +234,17 @@
end method;
define method emit-externs
- (back-end :: <harp-back-end>, stream, cr :: <compilation-record>) => ()
-
+ (back-end :: <harp-back-end>, stream, cr :: <compilation-record>)
+ => ();
emit-comment(stream, "Referenced object declarations");
let heap = cr.compilation-record-model-heap;
- local method emit-extern(object)
- let import? = dll-imported-object?(back-end, object);
- emit-extern/import(back-end, stream, object, import?)
- end method;
+ local
+ method emit-extern(object)
+ let import? = dll-imported-object?(back-end, object);
+ emit-extern/import(back-end, stream, object, import?)
+ end method;
let defined-c-functions = #f;
let emitted-objects = make(<table>);
@@ -248,13 +252,14 @@
// Avoid duplication of some objects like #[] and "" which
// appear on the heap multiply
- local method emitted-object?(object)
- element(emitted-objects, object, default: #f);
- end method;
-
- local method emitted-object(object)
- element(emitted-objects, object) := #t
- end method;
+ local
+ method emitted-object?(object)
+ element(emitted-objects, object, default: #f);
+ end method,
+
+ method emitted-object(object)
+ element(emitted-objects, object) := #t
+ end method;
// emit classes
for (object in heap.heap-referenced-objects)
@@ -271,22 +276,23 @@
// hack to get around local c-functions
<&c-function> =>
defined-c-functions
- | (defined-c-functions := c-callable-functions-in-heap(heap));
+ | (defined-c-functions := c-callable-functions-in-heap(heap));
let locally-defined? =
locally-defined-c-function?(object, defined-c-functions);
- unless (locally-defined?)
- emit-extern(object)
+ unless (locally-defined?)
+ emit-extern(object);
end unless;
otherwise =>
let object = canonical-model-object(object);
unless (emitted-object?(object))
emit-extern(object);
- emitted-object(object)
+ emitted-object(object);
end unless;
end select;
end for;
+
for (object in heap.heap-referenced-bindings)
let import? = dll-imported-binding?(back-end, object);
emit-extern/import(back-end, stream, object, import?);
@@ -294,48 +300,55 @@
end method;
define method emit-forwards
- (back-end :: <harp-back-end>, stream, cr :: <compilation-record>) => ()
-
+ (back-end :: <harp-back-end>, stream, cr :: <compilation-record>)
+ => ();
emit-comment(stream, "Defined object declarations");
let heap = cr.compilation-record-model-heap;
+
// emit classes
for (object in heap.heap-defined-objects)
if (instance?(object, <&class>))
emit-forward(back-end, stream, object);
end if;
end for;
+
// emit non-classes
for (object in heap.heap-defined-objects)
if (~instance?(object, <&class>))
emit-forward(back-end, stream, object);
end if;
end for;
+
// emit variables
for (binding in heap.heap-defined-bindings)
emit-forward(back-end, stream, binding);
end for;
-
end method;
define method emit-indirection-definitions
- (back-end :: <harp-back-end>, stream, cr :: <compilation-record>) => ()
+ (back-end :: <harp-back-end>, stream, cr :: <compilation-record>)
+ => ();
emit-comment(stream, "Indirection variables");
+
let heap = cr.compilation-record-model-heap;
+
for (refs in heap.heap-load-bound-references)
let object = load-bound-referenced-object(first(refs));
emit-indirection-definition(back-end, stream, object);
end for;
end method;
-define method c-callable-functions-in-heap(heap :: <model-heap>)
+define method c-callable-functions-in-heap
+ (heap :: <model-heap>)
=> (c-functions :: <sequence>)
- reduce(method(result, key)
- let o = heap.heap-defined-objects[key];
+ reduce(method (result, key)
+ let o = heap.heap-defined-objects[key];
if (instance?(o, <&iep>)
- & instance?(o.function, <&c-callable-function>))
+ & instance?(o.function, <&c-callable-function>))
add(result, o)
- else result
+ else
+ result
end if
end method,
#[],
@@ -343,17 +356,16 @@
end method;
define method locally-defined-c-function?
- (object :: <&c-function>, c-functions :: <sequence>)
- => (locally-defined? :: <boolean>)
- let locally-defined? =
- member?(object, c-functions,
- test: method(object, c-function)
- let c-fun = c-function.function;
- if (object.binding-name = c-fun.binding-name)
- (object.c-modifiers = c-fun.c-modifiers)
- | error("c-function %= has different calling convention "
- "from its c-callable-function",
object.binding-name)
+ (object :: <&c-function>, c-functions :: <sequence>)
+ => (locally-defined? :: <boolean>);
+ member?(object, c-functions,
+ test: method (object, c-function)
+ let c-fun = c-function.function;
+ if (object.binding-name = c-fun.binding-name)
+ (object.c-modifiers = c-fun.c-modifiers)
+ | error("c-function %= has different calling convention "
+ "from its c-callable-function",
+ object.binding-name)
end if
- end method);
- locally-defined?
+ end method)
end method;
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.lid
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.lid (original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-linker.lid Thu Nov 11
21:11:22 2004
@@ -3,7 +3,6 @@
harp-linker
harp-link-object
harp-makefile
- harp-scripts
harp-gluefile
Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
All rights reserved.
Modified: trunk/fundev/Sources/dfmc/harp-cg-linker/harp-makefile.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg-linker/harp-makefile.dylan
(original)
+++ trunk/fundev/Sources/dfmc/harp-cg-linker/harp-makefile.dylan Thu Nov
11 21:11:22 2004
@@ -179,17 +179,6 @@
if (*emit-makefile?*)
emit-makefile();
- else
- emit-build-script(back-end,
- t, lib-desc, units,
- executable: executable,
- base-address: base-address,
- linker-options: linker-options,
- c-source-files: c-source-files,
- c-header-files: c-header-files,
- c-object-files: c-object-files,
- rc-files: rc-files,
- c-libraries: c-libraries);
end if;
end method emit-target-makefile;
Modified: trunk/fundev/Sources/dfmc/harp-cg/harp-emit.dylan
==============================================================================
--- trunk/fundev/Sources/dfmc/harp-cg/harp-emit.dylan (original)
+++ trunk/fundev/Sources/dfmc/harp-cg/harp-emit.dylan Thu Nov 11 21:11:22 2004
@@ -7,81 +7,83 @@
Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
-define sideways method emit-all (back-end :: <harp-back-end>, cr ::
<compilation-record>,
- #rest flags, #key dfm-output? = #f, #all-keys)
=> ()
+define sideways method emit-all
+ (back-end :: <harp-back-end>, cr :: <compilation-record>,
+ #rest flags, #key dfm-output? = #f, #all-keys)
+ => ();
with-simple-abort-retry-restart
("Abort the emission phase", "Restart the emission phase")
-
- with-harp-variables(back-end)
-
-
+ with-harp-variables (back-end)
let heap = cr.compilation-record-model-heap;
- // compilation-record-data will be filled in later(during linking)
+ // compilation-record-data will be filled in later (during linking)
// when lambda-names are known
cr.compilation-record-back-end-data := make(<string-table>);
let compiling-dylan? = compiling-dylan-library?();
- let current-library-mode =
current-library-description().library-description-compilation-mode;
- let loose-mode? = current-library-mode = #"loose";
- let interactive-mode? = current-library-mode = #"interactive";
-
+ let current-library-mode
+ = current-library-description().library-description-compilation-mode;
+ let loose-mode? = current-library-mode == #"loose";
+ let interactive-mode? = current-library-mode == #"interactive";
dynamic-bind (*emitting-data?* = #f,
- *compiling-dylan?* = compiling-dylan?,
+ *compiling-dylan?* = compiling-dylan?,
*current-heap* = heap,
*loose-mode?* = loose-mode?,
*interactive-mode?* = interactive-mode?,
- $dylan-integer = dylan-value(#"<integer>"),
- $dylan-byte-character = dylan-value(#"<byte-character>"),
- $dylan-unicode-character =
dylan-value(#"<unicode-character>"),
- $current-handlers = op--constant-ref(back-end,
dylan-binding(#"*current-handlers*"), import?: #f),
- $true = op--constant-ref(back-end, #t,
import?: ~ compiling-dylan?),
- $false = op--constant-ref(back-end, #f,
import?: ~ compiling-dylan?))
-
- block()
-
- register-dylan-code-models();
-
- register-imports-in-heap(back-end, cr, heap);
-
- let literals = heap.heap-defined-object-sequence;
- when (dfm-output?)
- with-build-area-output (stream = current-library-description(),
- name: concatenate(cr.compilation-record-name,
".dfm"))
- for (literal in literals)
- apply(emit-dfm, back-end, stream, literal, flags);
- end for;
- end with-build-area-output;
- end when;
-
- for (literal in heap.heap-defined-object-sequence)
- apply(emit-code, back-end, literal, flags);
- end for;
-
- with-labeling-from-dynamic
- let top-level-id =
- cr-init-name(compilation-record-library(cr),
- compilation-record-name(cr));
-
- apply(emit-init-code-definition,
- back-end, #f, heap, top-level-id, flags);
-
- retract-local-methods-in-heap(heap);
-
- end with-labeling-from-dynamic;
-
- cleanup
-
- deregister-dylan-code-models();
-
- end block;
-
+ $dylan-integer
+ = dylan-value(#"<integer>"),
+ $dylan-byte-character
+ = dylan-value(#"<byte-character>"),
+ $dylan-unicode-character
+ = dylan-value(#"<unicode-character>"),
+ $current-handlers
+ = op--constant-ref(back-end,
+ dylan-binding(#"*current-handlers*"),
+ import?: #f),
+ $true
+ = op--constant-ref(back-end, #t,
+ import?: ~ compiling-dylan?),
+ $false
+ = op--constant-ref(back-end, #f,
+ import?: ~ compiling-dylan?))
+ block()
+ register-dylan-code-models();
+
+ register-imports-in-heap(back-end, cr, heap);
+
+ let literals = heap.heap-defined-object-sequence;
+ when (dfm-output?)
+ with-build-area-output (stream = current-library-description(),
+ name:
concatenate(cr.compilation-record-name, ".dfm"))
+ for (literal in literals)
+ apply(emit-dfm, back-end, stream, literal, flags);
+ end for;
+ end with-build-area-output;
+ end when;
+
+ for (literal in heap.heap-defined-object-sequence)
+ apply(emit-code, back-end, literal, flags);
+ end for;
+
+ with-labeling-from-dynamic
+ let top-level-id =
+ cr-init-name(compilation-record-library(cr),
+ compilation-record-name(cr));
+
+ apply(emit-init-code-definition,
+ back-end, #f, heap, top-level-id, flags);
+
+ retract-local-methods-in-heap(heap);
+
+ end with-labeling-from-dynamic;
+ cleanup
+ deregister-dylan-code-models();
+ end block;
end dynamic-bind;
end with-harp-variables;
-
end with-simple-abort-retry-restart;
end method emit-all;
@@ -103,11 +105,14 @@
end unless;
end if;
end for;
- compilation-record-code-size(heap-compilation-record(heap)) :=
total-code-size;
+ compilation-record-code-size(heap-compilation-record(heap))
+ := total-code-size;
end method;
/*
-define function no-code-for-lambda(back-end :: <harp-back-end>, name ::
<string>) => (compiled-lambda :: <object>)
+define function no-code-for-lambda
+ (back-end :: <harp-back-end>, name :: <string>)
+ => (compiled-lambda :: <object>)
with-harp-emitter(back-end, #f, name, static: #t, export: #f)
back-end-primitive-emitter(back-end, #"primitive-break")(back-end, #f);
ins--rts-and-drop(back-end, 0);
@@ -115,39 +120,45 @@
end function;
*/
-define method emit-code (back-end :: <harp-back-end>, o :: <&iep>,
- #rest flags, #key form?, force-emit?, #all-keys) => ()
+define method emit-code
+ (back-end :: <harp-back-end>, o :: <&iep>,
+ #rest flags, #key form?, force-emit?, #all-keys)
+ => ()
let re-emit? =
case
force-emit? => #t;
form? =>
- subsequence-position(as-lowercase(as(<string>, emit-name(back-end, #f,
o))), form?);
+ subsequence-position(as-lowercase(as(<string>,
+ emit-name(back-end, #f, o))),
+ form?);
otherwise => ~ code(o) // DFM EXISTS?
end case;
- if (re-emit?)
- o.code := #();
- apply(emit-lambda, back-end, #f, o, flags);
- if (*retract-dfm?*)
- if (lambda-top-level?(o))
- format-out?("\nRETRACTING %=\n", o);
- retract-method-dfm(o);
- retract-method-dfm(o.function);
- end if;
+ if (re-emit?)
+ o.code := #();
+ apply(emit-lambda, back-end, #f, o, flags);
+ if (*retract-dfm?*)
+ if (lambda-top-level?(o))
+ format-out?("\nRETRACTING %=\n", o);
+ retract-method-dfm(o);
+ retract-method-dfm(o.function);
end if;
end if;
+ end if;
end method emit-code;
-define method emit-code (back-end :: <harp-back-end>, o,
- #rest flags, #key, #all-keys) => ()
+define method emit-code
+ (back-end :: <harp-back-end>, o, #rest flags, #key, #all-keys)
+ => ();
+ // do nothing
end method;
-define method emit-dfm (back-end :: <harp-back-end>, stream :: <stream>, o ::
<&iep>,
- #rest flags, #key form?, force-emit?, #all-keys) => ()
-
+define method emit-dfm
+ (back-end :: <harp-back-end>, stream :: <stream>, o :: <&iep>,
+ #rest flags, #key form?, force-emit?, #all-keys)
+ => ();
print-method(stream, o.function);
format(stream, "\n");
-
end method emit-dfm;
define method emit-dfm (back-end :: <harp-back-end>, stream :: <stream>, o,
@@ -160,99 +171,102 @@
define method emit-init-code-definition
(back-end :: <harp-back-end>, stream, heap, name :: <string>,
#rest flags,
- #key harp-output? = unsupplied(), force-emit?, #all-keys) => ()
-
- let system-name = concatenate(name, $system-init-code-tag);
- let system-init-code = heap.heap-root-system-init-code;
- if (#t)
- let system-init-names = make(<table>);
- let fixups-name = ins--constant-ref(back-end,
format-to-string("%s_fixups", system-name));
- let fixups-string = fixups-name.cr-refers-to-object;
- system-init-names[0] := fixups-name;
- for (o in system-init-code, count from 0)
- system-init-names[count + 1] :=
- ins--constant-ref(back-end, format-to-string("%s_%d", system-name,
count));
- end for;
- emitted-name(as(<symbol>, concatenate(fixups-string, "_code"))) :=
- apply(emit-system-init-code,
- back-end, stream, heap,
- fixups-string,
- code?: #"fixups", flags);
- emitted-name(as(<symbol>, fixups-string)) := fixups-string;
- for (o in system-init-code, count from 0)
- let compiled-lambda = o.^iep.code;
- let re-emit? = force-emit? | ~ compiled-lambda;
- let init-name = system-init-names[count + 1];
- let init-string = init-name.cr-refers-to-object;
- if (re-emit?)
- o.^iep.code :=
- apply(emit-system-init-code,
- back-end, stream, heap,
- init-string,
- code?: o, flags);
- end if;
- emitted-name(as(<symbol>, init-string)) := init-string;
- end for;
- emitted-name(as(<symbol>, system-name)) :=
- with-harp-init-emitter(back-end,
- system-name,
- harp-debug: harp-output?,
- export: #f)
- for (count from 0 below system-init-names.size)
- ins--call(back-end, system-init-names[count], 0);
- end for;
- end with-harp-init-emitter;
- else
- emitted-name(as(<symbol>, system-name)) :=
- apply(emit-system-init-code,
- back-end, stream, heap, system-name, flags);
- end if;
+ #key harp-output? = unsupplied(), force-emit?, #all-keys)
+ => ()
+ let system-name = concatenate(name, $system-init-code-tag);
+ let system-init-code = heap.heap-root-system-init-code;
+ if (#t)
+ let system-init-names = make(<table>);
+ let fixups-name
+ = ins--constant-ref(back-end,
+ format-to-string("%s_fixups", system-name));
+ let fixups-string = fixups-name.cr-refers-to-object;
+ system-init-names[0] := fixups-name;
+ for (o in system-init-code, count from 0)
+ system-init-names[count + 1]
+ := ins--constant-ref(back-end,
+ format-to-string("%s_%d", system-name, count));
+ end for;
+ emitted-name(as(<symbol>, concatenate(fixups-string, "_code")))
+ := apply(emit-system-init-code,
+ back-end, stream, heap,
+ fixups-string,
+ code?: #"fixups", flags);
+ emitted-name(as(<symbol>, fixups-string)) := fixups-string;
+ for (o in system-init-code, count from 0)
+ let compiled-lambda = o.^iep.code;
+ let re-emit? = force-emit? | ~ compiled-lambda;
+ let init-name = system-init-names[count + 1];
+ let init-string = init-name.cr-refers-to-object;
+ if (re-emit?)
+ o.^iep.code
+ := apply(emit-system-init-code,
+ back-end, stream, heap,
+ init-string,
+ code?: o, flags);
+ end if;
+ emitted-name(as(<symbol>, init-string)) := init-string;
+ end for;
+ emitted-name(as(<symbol>, system-name))
+ := with-harp-init-emitter (back-end, system-name,
+ harp-debug: harp-output?,
+ export: #f)
+ for (count from 0 below system-init-names.size)
+ ins--call(back-end, system-init-names[count], 0);
+ end for;
+ end with-harp-init-emitter;
+ else
+ emitted-name(as(<symbol>, system-name))
+ := apply(emit-system-init-code,
+ back-end, stream, heap, system-name, flags);
+ end if;
- let user-name = concatenate(name, $user-init-code-tag);
- let user-init-code = heap.heap-root-init-code;
- if (#t)
- let user-init-names = make(<table>);
- for (o in user-init-code, count from 0)
- user-init-names[count] :=
- ins--constant-ref(back-end, format-to-string("%s_%d", |
