From 3a83e42280a29741eefd9ec6bfbc21fb5da3aaf6 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 12 Sep 2007 23:47:29 +0000
Subject:  	* posit.boot: New.  Import sys-macros, astr. 
 (tokConstruct): Move from ptrees.boot.pamphlet. 	(tokType): Likewise. 
 (tokPart): Likewise. 	(tokPosn): Likewise. 	(pfAbSynOp): Likewise. 
 (pfAbSynOp?): Likewise. 	(pfLeaf?): Likewise. 	(pfLeaf): Likewise. 
 (pfLeafToken): Likewise. 	(pfLeafPosition): Likewise. 	(pfTree):
 Likewise. 	(pfParts): Likewise. 	(pfFirst): Likewise. 	(pfSecond):
 Likewise. 	* astr.boot: New.  Import boot-pkg. 	* sys-constants.boot
 (IDENTITY): Define. 	* patches.lisp.pamphlet (identity): Move definition to
 sys-constants. 	* cformat.boot: New.  Import unlisp, posit.  Add ugly
 workwound 	for GCL bug. 	* incl.boot: New.  Import unlisp, cstream,
 cformat.  Tweak. 	Add ugly workwound for GCL bug. 	(incLude1):
 Fix thinko 	* Makefile.pamphlet (incl.$(FASLEXT)): New rule. 
 (cformat.$(FASLEXT)): Likewise. 	(posit.$(FASLEXT)): Likewise. 
 (astr.$(FASLEXT)): Likewise. 	(DEP): Don't include bits.lisp. 
 (${DEPSYS}): Explicitly load "bits" here.

---
 src/interp/cformat.boot | 99 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 src/interp/cformat.boot

(limited to 'src/interp/cformat.boot')

diff --git a/src/interp/cformat.boot b/src/interp/cformat.boot
new file mode 100644
index 00000000..953fc744
--- /dev/null
+++ b/src/interp/cformat.boot
@@ -0,0 +1,99 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copryight (C) 2007, 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.
+
+-- This is a horrible hack to work around a horrible bug in GCL
+-- as reported here:
+--    http://lists.gnu.org/archive/html/gcl-devel/2007-08/msg00004.html
+--
+)if %hasFeature KEYWORD::GCL
+)package "VMLISP"
+)package "AxiomCore"
+)endif 
+
+import '"unlisp"
+import '"posit"
+
+)package "BOOT"
+
+--% Formatting functions for various compiler data objects.
+--  These are used as [%origin o, %id n] for %1f %2f... style arguments
+--  in a keyed message.
+--  SMW, SG June 88
+ 
+%id a     == [IDENTITY, a]
+ 
+-- Union(FileName,"strings","console")
+%origin x ==
+    [function porigin, x]
+porigin x ==
+    (STRINGP x => x; pfname x)
+ 
+%fname x ==
+    [function pfname, x]
+pfname x ==
+    PathnameString x
+ 
+
+%pos p == [function ppos, p]
+ppos p ==
+    pfNoPosition? p => ['"no position"]
+    pfImmediate? p  => ['"console"]
+    cpos := pfCharPosn p
+    lpos := pfLinePosn p
+    org  := porigin pfFileName p
+    [org,'" ",'"line",'" ",lpos]
+ 
+%key keyStuff == [function pkey, keyStuff]
+--keyStuff ::= keynumber | [ one or more keySeqs ]
+--keySeq   ::= keynumber optargList optdbn
+--optARgL  ::= [ 0 or more arguments ] | nothing at all
+--optDbn   ::= ['dbN , databaseName ] | nothing at all
+----------- (override in format.boot.pamphlet)
+pkey keyStuff ==
+    if not PAIRP keyStuff then keyStuff := [keyStuff]
+    allMsgs := []
+    while not null keyStuff repeat
+        dbN := NIL
+        argL := NIL
+        key := first keyStuff
+        keyStuff := IFCDR keyStuff
+        next := IFCAR keyStuff
+        while PAIRP next repeat
+            if CAR next = 'dbN then dbN := CADR next
+            else argL := next
+            keyStuff  := IFCDR keyStuff
+            next      := IFCAR keyStuff
+        oneMsg  := returnStLFromKey(key,argL,dbN)
+        allMsgs := NCONC (oneMsg,allMsgs)
+    allMsgs
+ 
-- 
cgit v1.2.3