From aef4e0276d0324933e07ee4cfb30a593730f7428 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 14 Jan 2012 16:46:43 +0000 Subject: * interp/patches.lisp: Move content to msgdb.boot. Remove. --- src/ChangeLog | 4 +++ src/interp/Makefile.in | 7 +---- src/interp/msgdb.boot | 29 ++++++++++++++++++-- src/interp/patches.lisp | 70 ------------------------------------------------- src/interp/setvars.boot | 1 - 5 files changed, 32 insertions(+), 79 deletions(-) delete mode 100644 src/interp/patches.lisp (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 664cd4dc..ed39d381 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2012-01-14 Gabriel Dos Reis + + * interp/patches.lisp: Move content to msgdb.boot. Remove. + 2012-01-14 Gabriel Dos Reis * interp/word.boot: Add import and scope statements. Include in diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 6407f63b..76fc6029 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -106,11 +106,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \ termrw.$(FASLEXT) \ trace.$(FASLEXT) word.$(FASLEXT) \ fortcall.$(FASLEXT) i-parser.$(FASLEXT) \ - $(OCOBJS) $(BROBJS) $(INOBJS) - -# Last minite patches. -# FIXMEL: should be folded into the main object list. -INOBJS= setvart.$(FASLEXT) patches.$(FASLEXT) + $(OCOBJS) $(BROBJS) setvart.$(FASLEXT) # Main compiler files. OCOBJS= \ @@ -271,7 +267,6 @@ hypertex.$(FASLEXT): types.$(FASLEXT) ## OpenAxiom's interpreter. makeint.$(FASLEXT): util.$(FASLEXT) -patches.$(FASLEXT): macros.$(FASLEXT) g-timer.$(FASLEXT) sys-driver.$(FASLEXT) setvars.$(FASLEXT): macros.$(FASLEXT) debug.$(FASLEXT) profile.$(FASLEXT): macros.$(FASLEXT) rulesets.$(FASLEXT): vmlisp.$(FASLEXT) diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index a1fbc880..149ea132 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -81,9 +81,9 @@ namespace BOOT --% Message Database Code and Message Utility Functions +$msgHash := nil $msgDatabase := nil $cacheMessages := 'T -- for debugging purposes -$msgAlist := nil $msgDatabaseName := nil $testingErrorPrefix := '"Daly Bug" $testingSystem := false @@ -114,6 +114,32 @@ wordFrom(l,i) == getKeyedMsg key == fetchKeyedMsg(key,false) +fetchKeyedMsg(key,x) == + if $msgHash = nil then + $msgHash := hashTable 'EQ + cacheKeyedMsg $defaultMsgDatabaseName + tableValue($msgHash,object2Identifier key) + +cacheKeyedMsg p == + try + instream := inputTextFile p + msg := '"" + key := nil + repeat + line := readLine instream + line = %nothing => + key ~= nil => + tableValue($msgHash,key) := msg + leave nil + #line = 0 => nil + stringChar(line,0) = char "S" => + if key ~= nil then + tableValue($msgHash,key) := msg + key := makeSymbol line + msg := '"" + msg := strconc(msg,line) + finally closeStream instream + --% Formatting and Printing Keyed Messages segmentKeyedMsg(msg) == string2Words msg @@ -559,7 +585,6 @@ spadStartUpMsgs() == sayKeyedMsg("S2GL0018D",nil) sayKeyedMsg("S2GL0003B",[$opSysName]) sayMSG bar - $msgAlist := nil -- these msgs need not be saved sayMSG " " HELP() == sayKeyedMsg("S2GL0019",nil) diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp deleted file mode 100644 index 20b0c6e8..00000000 --- a/src/interp/patches.lisp +++ /dev/null @@ -1,70 +0,0 @@ -;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -;; All rights reserved. -;; Copyright (C) 2007-2011, Gabriel Dos Reis. -;; 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. - -(import-module "macros") -(import-module "g-timer") -(import-module "sys-driver") -(in-package "BOOT") -;;patches for now - -(setq *print-escape* nil) ;; so stringimage doesn't escape idents? - -(defvar *msghash* nil "hash table keyed by msg number") - -(defun cacheKeyedMsg (file) - (let ((line "") (msg "") key) - (with-open-file (in file) - (catch 'done - (loop - (setq line (read-line in nil nil)) - (cond - ((null line) - (when key - (setf (gethash key *msghash*) msg)) - (throw 'done nil)) - ((= (length line) 0)) - ((char= (schar line 0) #\S) - (when key - (setf (gethash key *msghash*) msg)) - (setq key (intern line "BOOT")) - (setq msg "")) - ('else - (setq msg (concatenate 'string msg line))))))))) - -(defun |fetchKeyedMsg| (key ignore) - (declare (ignore ignore)) - (setq key (|object2Identifier| key)) - (unless *msghash* - (setq *msghash* (make-hash-table)) - (cacheKeyedMsg |$defaultMsgDatabaseName|)) - (gethash key *msghash*)) diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index 493c5ced..1907a738 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -151,7 +151,6 @@ resetWorkspaceVariables() == SETQ($slamFlag , nil) SETQ($CommandSynonymAlist , COPY($InitialCommandSynonymAlist)) SETQ($UserAbbreviationsAlist , nil) - SETQ($msgAlist , nil) SETQ($msgDatabase , nil) SETQ($msgDatabaseName , nil) SETQ($IOindex , 1 ) -- cgit v1.2.3