aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGabriel Dos Reis <gdr@axiomatics.org>2015-12-27 08:56:15 -0800
committerGabriel Dos Reis <gdr@axiomatics.org>2015-12-27 08:56:15 -0800
commit687bef6eb89db2a2d84ddc96bf9fb8efdf1546d7 (patch)
tree35b32cf9795bef3fe984ab3ffa4f41cbb9573711 /src
parentba8d29ccd1dd272f5883fe3d042b1bc38f1ce688 (diff)
downloadopen-axiom-687bef6eb89db2a2d84ddc96bf9fb8efdf1546d7.tar.gz
Write out a functor's operation table separately in generated code stream.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/daase.lisp6
-rw-r--r--src/interp/define.boot5
-rw-r--r--src/interp/lisplib.boot5
4 files changed, 21 insertions, 3 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 08edbd6d..35d1e555 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2015-12-27 Gabriel Dos Reis <gdr@axiomatics.org>
+
+ * interp/daase.lisp (DATABASE): Add new field 'optable'.
+ (dbOperationTable): New accessor macro.
+ * interp/define.boot (makeCompactDirect): Tidy. Set dbOperationTable.
+ * interp/lisplib.boot (writeOperationTable): New.
+ (finalizeLisplib): Call it.
+
2015-12-26 Gabriel Dos Reis <gdr@axiomatics.org>
* interp/nruncomp.boot (buildFunctor): Remove use of
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index df27ff72..995ad0ec 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2013, Gabriel Dos Reis.
+;; Copyright (C) 2007-2015, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -223,6 +223,7 @@
; for a functor, this is the template.
lookup-function ; for a functor, lookup function. For category
; constructor, default package constructor.
+ optable ; for a functor, operation table.
) ; database structure
(deftype |%Database| nil 'database)
@@ -299,6 +300,9 @@
(defmacro |dbTemplate| (db)
`(database-template ,db))
+(defmacro |dbOperationTable| (db)
+ `(database-optable ,db))
+
(defmacro |dbLookupFunction| (db)
`(database-lookup-function ,db))
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c3813fda..b33f9f20 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -407,9 +407,10 @@ makeCompactDirect(db,u) ==
$byteVecAcc: local := nil
[nam,[addForm,:opList]] := u
--pp opList
- d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(db,op,items)]
+ d := [:[op,y] for [op,:items] in opList
+ | y := makeCompactDirect1(db,op,items)]
dbByteList(db) := [:dbByteList db,:"append"/reverse! $byteVecAcc]
- vector("append"/d)
+ dbOperationTable(db) := vector d
makeCompactDirect1(db,op,items) ==
--NOTES: creates byte codes for ops implemented by the domain
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index c0b341bc..807f752f 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -473,6 +473,10 @@ writeTemplate db ==
dbConstructorKind db = 'category => nil
writeLoadInfo(db,dbTemplate db,'template,'dbTemplate)
+writeOperationTable db ==
+ dbConstructorKind db = 'category => nil
+ writeLoadInfo(db,dbOperationTable db,'optable,'dbOperationTable)
+
writeLookupFunction db ==
fun := dbLookupFunction db =>
writeLoadInfo(db,quote fun,'lookupFunction,'dbLookupFunction)
@@ -569,6 +573,7 @@ finalizeLisplib(db,libName) ==
$NRTslot1PredicateList : local := []
genInitialAttributeAlist(db,rest opsAndAtts)
writeSuperDomain db
+ writeOperationTable db
writeCapsuleLevelDefinitions db
writeAttributes db
writePredicates db