diff --git a/changelog b/changelog index ee61e59..920f6c5 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090830 tpd src/axiom-website/patches.html 20090830.03.tpd.patch +20090830 tpd src/interp/Makefile move hashcode.boot to hashcode.lisp +20090830 tpd src/interp/hashcode.lisp added, rewritten from hashcode.boot +20090830 tpd src/interp/hashcode.boot removed, rewritten to hashcode.lisp 20090830 tpd src/axiom-website/patches.html 20090830.02.tpd.patch 20090830 tpd src/interp/Makefile move bc-matrix.boot to bc-matrix.lisp 20090830 tpd src/interp/bc-matrix.lisp added, rewritten from bc-matrix.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 71f607a..894fbd0 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1942,5 +1942,7 @@ src/interp/Makefile remove all .dvi usage
src/interp/br-con rewrite from boot to lisp
20090830.02.tpd.patch src/interp/bc-matrix rewrite from boot to lisp
+20090830.03.tpd.patch +src/interp/hashcode rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 863b268..0c48c5e 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4154,37 +4154,27 @@ ${MID}/sfsfun.lisp: ${IN}/sfsfun.lisp.pamphlet @ -\subsection{hashcode.boot} -files for the new compiler +\subsection{hashcode.lisp} <>= - -${OUT}/hashcode.${O}: ${MID}/hashcode.clisp - @ echo 583 making ${OUT}/hashcode.${O} from ${MID}/hashcode.clisp - @ (cd ${MID} ; \ +${OUT}/hashcode.${O}: ${MID}/hashcode.lisp + @ echo 136 making ${OUT}/hashcode.${O} from ${MID}/hashcode.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/hashcode.clisp"' \ + echo '(progn (compile-file "${MID}/hashcode.lisp"' \ ':output-file "${OUT}/hashcode.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/hashcode.clisp"' \ + echo '(progn (compile-file "${MID}/hashcode.lisp"' \ ':output-file "${OUT}/hashcode.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/hashcode.clisp: ${IN}/hashcode.boot.pamphlet - @ echo 584 making ${MID}/hashcode.clisp \ - from ${IN}/hashcode.boot.pamphlet +<>= +${MID}/hashcode.lisp: ${IN}/hashcode.lisp.pamphlet + @ echo 137 making ${MID}/hashcode.lisp from \ + ${IN}/hashcode.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/hashcode.boot.pamphlet >hashcode.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "hashcode.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "hashcode.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm hashcode.boot ) + ${TANGLE} ${IN}/hashcode.lisp.pamphlet >hashcode.lisp ) @ @@ -4624,7 +4614,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/hashcode.boot.pamphlet b/src/interp/hashcode.boot.pamphlet deleted file mode 100644 index ab388db..0000000 --- a/src/interp/hashcode.boot.pamphlet +++ /dev/null @@ -1,129 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp hashcode.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - --- Type hasher for old compiler style type names which produces a hash code --- compatible with the asharp compiler. Takes a hard error if the type --- is parameterized, but has no constructor modemap. -getDomainHash dom == SPADCALL(CDR dom, (CAR dom).4) - -hashType(type, percentHash) == - SYMBOLP type => - type = '$ => percentHash - type = "%" => percentHash - hashString SYMBOL_-NAME type - STRINGP type => hashCombine(hashString type, - hashString('"Enumeration")) - type is ['QUOTE, val] => hashType(val, percentHash) - type is [dom] => hashString SYMBOL_-NAME dom - type is ['_:, ., type2] => hashType(type2, percentHash) - isDomain type => getDomainHash type - [op, :args] := type - hash := hashString SYMBOL_-NAME op - op = 'Mapping => - hash := hashString '"->" - [retType, :mapArgs] := args - for arg in mapArgs repeat - hash := hashCombine(hashType(arg, percentHash), hash) - retCode := hashType(retType, percentHash) - EQL(retCode, $VoidHash) => hash - hashCombine(retCode, hashCombine(32236,hash)) - op = 'Enumeration => - for arg in args repeat - hash := hashCombine(hashString(STRING arg), hash) - hash - op in $DomainsWithoutLisplibs => - for arg in args repeat - hash := hashCombine(hashType(arg, percentHash), hash) - hash - - cmm := CDDAR getConstructorModemap(op) - cosig := CDR GETDATABASE(op, 'COSIG) - for arg in args for c in cosig for ct in cmm repeat - if c then - hash := hashCombine(hashType(arg, percentHash), hash) - else - hash := hashCombine(7, hash) --- !!! If/when asharp hashes values using their type, use instead --- ctt := EQSUBSTLIST(args, $FormalMapVariableList, ct) --- hash := hashCombine(hashType(ctt, percentHash), hash) - - - hash - ---The following are in cfuns.lisp -$hashModulus := 1073741789 -- largest 30-bit prime - --- Produce a 30-bit hash code. This function must produce the same codes --- as the asharp string hasher in src/strops.c -hashString str == - h := 0 - for i in 0..#str-1 repeat - j := CHAR_-CODE char str.i - h := LOGXOR(h, ASH(h, 8)) - h := h + j + 200041 - h := LOGAND(h, 1073741823) -- 0x3FFFFFFF - REM(h, $hashModulus) - --- Combine two hash codes to make a new one. Must be the same as in --- the hashCombine function in aslib/runtime.as in asharp. -hashCombine(hash1, hash2) == - MOD(ASH(LOGAND(hash2, 16777215), 6) + hash1, $hashModulus) - - -$VoidHash := hashString '"Void" - - --- following two lines correct bad coSig properties due to SubsetCategory ---putConstructorProperty('LocalAlgebra,'coSig,'(NIL T T T)) ---putConstructorProperty('Localize,'coSig,'(NIL T T T)) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/hashcode.lisp.pamphlet b/src/interp/hashcode.lisp.pamphlet new file mode 100644 index 0000000..c25ed57 --- /dev/null +++ b/src/interp/hashcode.lisp.pamphlet @@ -0,0 +1,224 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp hashcode.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;-- Type hasher for old compiler style type names which produces a hash code +;-- compatible with the asharp compiler. Takes a hard error if the type +;-- is parameterized, but has no constructor modemap. +;getDomainHash dom == SPADCALL(CDR dom, (CAR dom).4) + +(DEFUN |getDomainHash| (|dom|) + (SPADCALL (CDR |dom|) (ELT (CAR |dom|) 4))) + +;hashType(type, percentHash) == +; SYMBOLP type => +; type = '$ => percentHash +; type = "%" => percentHash +; hashString SYMBOL_-NAME type +; STRINGP type => hashCombine(hashString type, +; hashString('"Enumeration")) +; type is ['QUOTE, val] => hashType(val, percentHash) +; type is [dom] => hashString SYMBOL_-NAME dom +; type is ['_:, ., type2] => hashType(type2, percentHash) +; isDomain type => getDomainHash type +; [op, :args] := type +; hash := hashString SYMBOL_-NAME op +; op = 'Mapping => +; hash := hashString '"->" +; [retType, :mapArgs] := args +; for arg in mapArgs repeat +; hash := hashCombine(hashType(arg, percentHash), hash) +; retCode := hashType(retType, percentHash) +; EQL(retCode, $VoidHash) => hash +; hashCombine(retCode, hashCombine(32236,hash)) +; op = 'Enumeration => +; for arg in args repeat +; hash := hashCombine(hashString(STRING arg), hash) +; hash +; op in $DomainsWithoutLisplibs => +; for arg in args repeat +; hash := hashCombine(hashType(arg, percentHash), hash) +; hash +; cmm := CDDAR getConstructorModemap(op) +; cosig := CDR GETDATABASE(op, 'COSIG) +; for arg in args for c in cosig for ct in cmm repeat +; if c then +; hash := hashCombine(hashType(arg, percentHash), hash) +; else +; hash := hashCombine(7, hash) +;-- !!! If/when asharp hashes values using their type, use instead +;-- ctt := EQSUBSTLIST(args, $FormalMapVariableList, ct) +;-- hash := hashCombine(hashType(ctt, percentHash), hash) +; hash + +(DEFUN |hashType| (|type| |percentHash|) + (PROG (|val| |dom| |ISTMP#1| |ISTMP#2| |type2| |op| |args| |retType| + |mapArgs| |retCode| |cmm| |cosig| |hash|) + (declare (special |$DomainsWithoutLisplibs| |$VoidHash|)) + (RETURN + (SEQ (COND + ((SYMBOLP |type|) + (COND + ((BOOT-EQUAL |type| '$) |percentHash|) + ((BOOT-EQUAL |type| '%) |percentHash|) + ('T (|hashString| (SYMBOL-NAME |type|))))) + ((STRINGP |type|) + (|hashCombine| (|hashString| |type|) + (|hashString| (MAKESTRING "Enumeration")))) + ((AND (PAIRP |type|) (EQ (QCAR |type|) 'QUOTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |type|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) 'T)))) + (|hashType| |val| |percentHash|)) + ((AND (PAIRP |type|) (EQ (QCDR |type|) NIL) + (PROGN (SPADLET |dom| (QCAR |type|)) 'T)) + (|hashString| (SYMBOL-NAME |dom|))) + ((AND (PAIRP |type|) (EQ (QCAR |type|) '|:|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |type|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |type2| (QCAR |ISTMP#2|)) + 'T)))))) + (|hashType| |type2| |percentHash|)) + ((|isDomain| |type|) (|getDomainHash| |type|)) + ('T (SPADLET |op| (CAR |type|)) + (SPADLET |args| (CDR |type|)) + (SPADLET |hash| (|hashString| (SYMBOL-NAME |op|))) + (COND + ((BOOT-EQUAL |op| '|Mapping|) + (SPADLET |hash| (|hashString| (MAKESTRING "->"))) + (SPADLET |retType| (CAR |args|)) + (SPADLET |mapArgs| (CDR |args|)) + (DO ((G166088 |mapArgs| (CDR G166088)) + (|arg| NIL)) + ((OR (ATOM G166088) + (PROGN (SETQ |arg| (CAR G166088)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |hash| + (|hashCombine| + (|hashType| |arg| + |percentHash|) + |hash|))))) + (SPADLET |retCode| + (|hashType| |retType| |percentHash|)) + (COND + ((EQL |retCode| |$VoidHash|) |hash|) + ('T + (|hashCombine| |retCode| + (|hashCombine| 32236 |hash|))))) + ((BOOT-EQUAL |op| '|Enumeration|) + (DO ((G166097 |args| (CDR G166097)) (|arg| NIL)) + ((OR (ATOM G166097) + (PROGN (SETQ |arg| (CAR G166097)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |hash| + (|hashCombine| + (|hashString| (STRING |arg|)) + |hash|))))) + |hash|) + ((|member| |op| |$DomainsWithoutLisplibs|) + (DO ((G166106 |args| (CDR G166106)) (|arg| NIL)) + ((OR (ATOM G166106) + (PROGN (SETQ |arg| (CAR G166106)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |hash| + (|hashCombine| + (|hashType| |arg| + |percentHash|) + |hash|))))) + |hash|) + ('T + (SPADLET |cmm| (CDDAR (|getConstructorModemap| |op|))) + (SPADLET |cosig| (CDR (GETDATABASE |op| 'COSIG))) + (DO ((G166117 |args| (CDR G166117)) (|arg| NIL) + (G166118 |cosig| (CDR G166118)) (|c| NIL) + (G166119 |cmm| (CDR G166119)) (|ct| NIL)) + ((OR (ATOM G166117) + (PROGN (SETQ |arg| (CAR G166117)) NIL) + (ATOM G166118) + (PROGN (SETQ |c| (CAR G166118)) NIL) + (ATOM G166119) + (PROGN (SETQ |ct| (CAR G166119)) NIL)) + NIL) + (SEQ (EXIT (COND + (|c| (SPADLET |hash| + (|hashCombine| + (|hashType| |arg| |percentHash|) + |hash|))) + ('T + (SPADLET |hash| + (|hashCombine| 7 |hash|))))))) + |hash|)))))))) + +;--The following are in cfuns.lisp +;$hashModulus := 1073741789 -- largest 30-bit prime + +(SPADLET |$hashModulus| 1073741789) + +;-- Produce a 30-bit hash code. This function must produce the same codes +;-- as the asharp string hasher in src/strops.c +;hashString str == +; h := 0 +; for i in 0..#str-1 repeat +; j := CHAR_-CODE char str.i +; h := LOGXOR(h, ASH(h, 8)) +; h := h + j + 200041 +; h := LOGAND(h, 1073741823) -- 0x3FFFFFFF +; REM(h, $hashModulus) + +(DEFUN |hashString| (|str|) + (PROG (|j| |h|) + (declare (special |$hashModulus|)) + (RETURN + (SEQ (PROGN + (SPADLET |h| 0) + (DO ((G166163 (SPADDIFFERENCE (|#| |str|) 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G166163) NIL) + (SEQ (EXIT (PROGN + (SPADLET |j| + (CHAR-CODE + (|char| (ELT |str| |i|)))) + (SPADLET |h| (LOGXOR |h| (ASH |h| 8))) + (SPADLET |h| (PLUS (PLUS |h| |j|) 200041)) + (SPADLET |h| (LOGAND |h| 1073741823)))))) + (REM |h| |$hashModulus|)))))) + +;-- Combine two hash codes to make a new one. Must be the same as in +;-- the hashCombine function in aslib/runtime.as in asharp. +;hashCombine(hash1, hash2) == +; MOD(ASH(LOGAND(hash2, 16777215), 6) + hash1, $hashModulus) + +(DEFUN |hashCombine| (|hash1| |hash2|) + (declare (special |$hashModulus|)) + (MOD (PLUS (ASH (LOGAND |hash2| 16777215) 6) |hash1|) |$hashModulus|)) + +;$VoidHash := hashString '"Void" +;-- following two lines correct bad coSig properties due to SubsetCategory +;--putConstructorProperty('LocalAlgebra,'coSig,'(NIL T T T)) +;--putConstructorProperty('Localize,'coSig,'(NIL T T T)) + +(SPADLET |$VoidHash| (|hashString| (MAKESTRING "Void"))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}