aboutsummaryrefslogtreecommitdiff
path: root/src/interp/msg.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 04:33:26 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 04:33:26 +0000
commit516d3e4928185c380ffee8249454fe76ab6f2851 (patch)
treeac69cb24a13b8e7cfa5b955db57b56951a599499 /src/interp/msg.boot.pamphlet
parent7bacc11540fe33bf3530c361a59772ecd4d529d9 (diff)
downloadopen-axiom-516d3e4928185c380ffee8249454fe76ab6f2851.tar.gz
remove pamphlets - part 6
Diffstat (limited to 'src/interp/msg.boot.pamphlet')
-rw-r--r--src/interp/msg.boot.pamphlet577
1 files changed, 0 insertions, 577 deletions
diff --git a/src/interp/msg.boot.pamphlet b/src/interp/msg.boot.pamphlet
deleted file mode 100644
index ac311779..00000000
--- a/src/interp/msg.boot.pamphlet
+++ /dev/null
@@ -1,577 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/msg.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-
-\tableofcontents
-\eject
-
-\section{License}
-
-<<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.
-
-@
-<<*>>=
-<<license>>
-
-)package "BOOT"
-
-ListMember?(ob, l) ==
- MEMBER(ob, l, KEYWORD::TEST, function EQUAL)
-
---% Messages for the USERS of the compiler.
--- The program being compiled has a minor error.
--- Give a message and continue processing.
-ncSoftError(pos, erMsgKey, erArgL,:optAttr) ==
- $newcompErrorCount := $newcompErrorCount + 1
- desiredMsg erMsgKey =>
- processKeyedError _
- msgCreate ('error, pos, erMsgKey, erArgL, $compErrorPrefix,optAttr)
-
--- The program being compiled is seriously incorrect.
--- Give message and throw to a recovery point.
-ncHardError(pos, erMsgKey, erArgL,:optAttr) ==
- $newcompErrorCount := $newcompErrorCount + 1
- desiredMsg erMsgKey =>
- erMsg := processKeyedError _
- msgCreate('error,pos,erMsgKey, erArgL, $compErrorPrefix,optAttr)
- ncError()
-
--- Bug in the compiler: something which shouldn't have happened did.
-ncBug (erMsgKey, erArgL,:optAttr) ==
- $newcompErrorCount := $newcompErrorCount + 1
- erMsg := processKeyedError _
- msgCreate('bug,$nopos, erMsgKey, erArgL,$compBugPrefix,optAttr)
- -- The next line is to try to deal with some reported cases of unwanted
- -- backtraces appearing, MCD.
- ENABLE_-BACKTRACE(nil)
- BREAK()
- ncAbort()
-
---% Lower level functions
-
---msgObject tag -- catagory of msg
--- -- attributes as a-list
--- 'imPr => dont save for list processing
--- toWhere, screen or file
--- 'norep => only display once in list
--- pos -- position with possible FROM/TO tag
--- key -- key for message database
--- argL -- arguments to be placed in the msg test
--- prefix -- things like "Error: "
--- text -- the actual text
-
-msgCreate(tag,posWTag,key,argL,optPre,:optAttr) ==
- if PAIRP key then tag := 'old
- msg := [tag,posWTag,key,argL,optPre,NIL]
- if CAR optAttr then
- setMsgForcedAttrList(msg,car optAttr)
- putDatabaseStuff msg
- initImPr msg
- initToWhere msg
- msg
-
-processKeyedError msg ==
- getMsgTag? msg = 'old => --temp
- erMsg := getMsgKey msg --temp
- if pre := getMsgPrefix? msg then --temp
- erMsg := ['%b, pre, '%d, :erMsg] --temp
- sayBrightly ['"old msg from ",_
- CallerName 4,:erMsg] --temp
- msgImPr? msg =>
- msgOutputter msg
- $ncMsgList := cons (msg, $ncMsgList)
-
----------------------------------
---%getting info from db.
-putDatabaseStuff msg ==
- [text,attributes] := getMsgInfoFromKey msg
- if attributes then setMsgUnforcedAttrList(msg,attributes)
- setMsgText(msg,text)
-
-getMsgInfoFromKey msg ==
- $msgDatabaseName : local := []
- msgText :=
- msgKey := getMsgKey? msg => --temp oldmsgs use key tostoretext
- dbL := [$erLocMsgDatabaseName,$erGlbMsgDatabaseName]
- getErFromDbL (msgKey,dbL)
- getMsgKey msg --temp oldmsgs
- msgText := segmentKeyedMsg msgText
- [msgText,attributes] := removeAttributes msgText
- msgText := substituteSegmentedMsg(msgText, getMsgArgL msg)
- [msgText,attributes]
-
-
-getErFromDbL (erMsgKey,dbL) ==
- erMsg := NIL
- while null erMsg repeat
- dbName := CAR dbL
- dbL := CDR dbL
- $msgDatabaseName := dbName
- lastName := null dbL
--- fileFound := '"co_-eng.msgs"
- fileFound := '"s2_-us.msgs"
- if fileFound or lastName then
- erMsg := fetchKeyedMsg(erMsgKey,not lastName)
- erMsg
-
------------------------
---%character position marking
-
-processChPosesForOneLine msgList ==
- chPosList := posPointers msgList
- for msg in msgList repeat
- if getMsgFTTag? msg then
- putFTText (msg,chPosList)
- posLetter := CDR ASSOC(poCharPosn getMsgPos msg,chPosList)
- oldPre := getMsgPrefix msg
- setMsgPrefix (msg,STRCONC(oldPre,_
- MAKE_-FULL_-CVEC ($preLength - 4 - SIZE oldPre),posLetter) )
- leaderMsg := makeLeaderMsg chPosList
- NCONC(msgList,LIST leaderMsg) --a back cons
-
-posPointers msgList ==
---gets all the char posns for msgs on one line
---associates them with a uppercase letter
- pointers := '"ABCDEFGHIJKLMONPQRS"
- increment := 0
- posList:= []
- ftPosList := []
- for msg in msgList repeat
- pos := poCharPosn getMsgPos msg
- if pos ^= IFCAR posList then
- posList := [pos,:posList]
- if getMsgFTTag? msg = 'FROMTO then
- ftPosList := [poCharPosn getMsgPos2 msg,:ftPosList]
- for toPos in ftPosList repeat
- posList := insertPos(toPos,posList)
- for pos in posList repeat
- posLetterList := [[pos,:pointers.increment],:posLetterList]
- increment := increment + 1
- posLetterList
-
-insertPos(newPos,posList) ==
---insersts a position in the proper place of a positon list
---used for the 2nd pos of a fromto
- done := false
- bot := [0,:posList]
- top := []
- while not done repeat
- top := [CAR bot,:top]
- bot := CDR bot
- pos := CAR bot
- done :=
- pos < newPos => false
- pos = newPos => true
- pos > newPos =>
- top := [newPos,:top]
- true
- [CDR reverse top,:bot]
-
-putFTText (msg,chPosList) ==
- tag := getMsgFTTag? msg
- pos := poCharPosn getMsgPos msg
- charMarker := CDR ASSOC(pos,chPosList)
- tag = 'FROM =>
- markingText := ['"(from ",charMarker,'" and on) "]
- setMsgText(msg,[:markingText,:getMsgText msg])
- tag = 'TO =>
- markingText := ['"(up to ",charMarker,'") "]
- setMsgText(msg,[:markingText,:getMsgText msg])
- tag = 'FROMTO =>
- pos2 := poCharPosn getMsgPos2 msg
- charMarker2 := CDR ASSOC(pos2,chPosList)
- markingText := ['"(from ",charMarker,'" up to ",_
- charMarker2,'") "]
- setMsgText(msg,[:markingText,:getMsgText msg])
-
-rep (c,n) ==
- n > 0 =>
- MAKE_-FULL_-CVEC(n, c)
- '""
-
---called from parameter list of nc message functions
-From pos == ['FROM, pos]
-To pos == ['TO, pos]
-FromTo (pos1,pos2) == ['FROMTO, pos1, pos2]
-
-------------------------
---%processing error lists
-processMsgList (erMsgList,lineList) ==
- $outputList :local := []--grows in queueUp errors
- $noRepList :local := []--grows in queueUp errors
- erMsgList := erMsgSort erMsgList
- for line in lineList repeat
- msgLine := makeMsgFromLine line
- $outputList := [msgLine,:$outputList]
- globalNumOfLine := poGlobalLinePosn getMsgPos msgLine
- erMsgList :=
- queueUpErrors(globalNumOfLine,erMsgList)
- $outputList := append(erMsgList,$outputList) --the nopos's
- st := '"---------SOURCE-TEXT-&-ERRORS------------------------"
- listOutputter reverse $outputList
-
-erMsgSort erMsgList ==
- [msgWPos,msgWOPos] := erMsgSep erMsgList
- msgWPos := listSort(function erMsgCompare, msgWPos)
- msgWOPos := reverse msgWOPos
- [:msgWPos,:msgWOPos]
-
-erMsgCompare(ob1,ob2)==
- pos1 := getMsgPos ob1
- pos2 := getMsgPos ob2
- compareposns(pos2,pos1)
-
-erMsgSep erMsgList ==
- msgWPos := []
- msgWOPos := []
- for msg in erMsgList repeat
- if poNopos? getMsgPos msg then
- msgWOPos := [msg,:msgWOPos]
- else
- msgWPos := [msg,:msgWPos]
- [msgWPos,msgWOPos]
-
-getLinePos line == CAR line
-getLineText line == CDR line
-
-queueUpErrors(globalNumOfLine,msgList)==
- thisPosMsgs := []
- notThisLineMsgs := []
- for msg in msgList _
- while thisPosIsLess(getMsgPos msg,globalNumOfLine) repeat
- --these are msgs that refer to positions from earlier compilations
- if not redundant (msg,notThisPosMsgs) then
- notThisPosMsgs := [msg,:notThisPosMsgs]
- msgList := rest msgList
- for msg in msgList _
- while thisPosIsEqual(getMsgPos msg,globalNumOfLine) repeat
- if not redundant (msg,thisPosMsgs) then
- thisPosMsgs := [msg,:thisPosMsgs]
- msgList := rest msgList
- if thisPosMsgs then
- thisPosMsgs := processChPosesForOneLine thisPosMsgs
- $outputList := NCONC(thisPosMsgs,$outputList)
- if notThisPosMsgs then
- $outputList := NCONC(notThisPosMsgs,$outputList)
- msgList
-
-redundant(msg,thisPosMsgs) ==
- found := NIL
- if msgNoRep? msg then
- for item in $noRepList repeat
- sameMsg?(msg,item) => return (found := true)
- $noRepList := [msg,$noRepList]
- found or member(msg,thisPosMsgs)
-
-sameMsg? (msg1,msg2) ==
- (getMsgKey msg1 = getMsgKey msg2) and _
- (getMsgArgL msg1 = getMsgArgL msg2)
-
-
-thisPosIsLess(pos,num) ==
- poNopos? pos => NIL
- poGlobalLinePosn pos < num
-
-thisPosIsEqual(pos,num) ==
- poNopos? pos => NIL
- poGlobalLinePosn pos = num
-
---%outputting stuff
-
-listOutputter outputList ==
- for msg in outputList repeat
- msgOutputter msg
-
-msgOutputter msg ==
- st := getStFromMsg msg
- shouldFlow := not (leader? msg or line? msg)
- if toScreen? msg then
- if shouldFlow then
- st := flowSegmentedMsg(st,$LINELENGTH,0)
- sayBrightly st
- if toFile? msg then
- if shouldFlow then
- st := flowSegmentedMsg(st,$LOGLENGTH,0)
- alreadyOpened := alreadyOpened? msg
-
-toScreen? msg == getMsgToWhere msg ^= 'fileOnly
-toFile? msg ==
- PAIRP $fn and _
- getMsgToWhere msg ^= 'screenOnly
-
-
-alreadyOpened? msg ==
- not msgImPr? msg
-
-getStFromMsg msg ==
- $optKeyBlanks : local := '"" --set in setOptKeyBlanks()
- setOptKeyBlanks()
- preStL := getPreStL getMsgPrefix? msg
- getMsgTag msg = 'line =>
- [$optKeyBlanks, '"%x1" , :preStL,_
- getMsgText msg]
- posStL := getPosStL msg
- optKey :=
- $showKeyNum =>
- msgKey := getMsgKey? msg => PNAME msgKey
- '"no key "
- '""
- st :=[posStL,getMsgLitSym msg,_
- optKey,:preStL,_
- tabbing msg,:getMsgText msg]
-
-tabbing msg ==
- chPos := 2
- if getMsgPrefix? msg then
- chPos := chPos + $preLength - 1
- if $showKeyNum then chPos := chPos + 8
- ["%t",:chPos]
-
-setOptKeyBlanks() ==
- $optKeyBlanks :=
- $showKeyNum => '"%x8"
- '""
-
-getPosStL msg ==
- not showMsgPos? msg => '""
- msgPos := getMsgPos msg
- howMuch :=
- msgImPr? msg =>
- decideHowMuch (msgPos,$lastPos)
- listDecideHowMuch (msgPos,$lastPos)
- $lastPos := msgPos
- fullPrintedPos := ppos msgPos
- printedFileName := ['"%x2",'"[",:remLine fullPrintedPos,'"]" ]
- printedLineNum := ['"%x2",'"[",:remFile fullPrintedPos,'"]" ]
- printedOrigin := ['"%x2",'"[",:fullPrintedPos,'"]" ]
- howMuch = 'ORG => [$optKeyBlanks,:printedOrigin, '%l]
- howMuch = 'LINE => [$optKeyBlanks,:printedLineNum, '%l]
- howMuch = 'FILE => [$optKeyBlanks,:printedFileName, '%l]
- howMuch = 'ALL => [$optKeyBlanks,:printedFileName, '%l,_
- $optKeyBlanks,:printedLineNum, '%l]
- '""
-
-showMsgPos? msg ==
- $erMsgToss or (not msgImPr? msg and not msgLeader? msg)
-
-
-remFile positionList ==
- IFCDR IFCDR positionList
-
-remLine positionList ==
- [IFCAR positionList]
-
-decideHowMuch(pos,oldPos) ==
---when printing a msg, we wish not to show pos infor that was
---shown for a previous msg with identical pos info.
---org prints out the word noposition or console
- ((poNopos? pos) and (poNopos? oldPos)) or _
- ((poPosImmediate? pos) and (poPosImmediate? oldPos)) => 'NONE
- (poNopos? pos) or (poPosImmediate? pos) => 'ORG
- (poNopos? oldPos) or (poPosImmediate? oldPos) => 'ALL
- poFileName oldPos ^= poFileName pos => 'ALL
- poLinePosn oldPos ^= poLinePosn pos => 'LINE
- 'NONE
-
-listDecideHowMuch(pos,oldPos) ==
- ((poNopos? pos) and (poNopos? oldPos)) or _
- ((poPosImmediate? pos) and (poPosImmediate? oldPos)) => 'NONE
- (poNopos? pos) => 'ORG
- (poNopos? oldPos) => 'NONE
- poGlobalLinePosn pos < poGlobalLinePosn oldPos =>
- poPosImmediate? pos => 'ORG
- 'LINE
- --(poNopos? pos) or (poPosImmediate? pos) => 'ORG
- 'NONE
-
-getPreStL optPre ==
- null optPre => [MAKE_-FULL_-CVEC 2]
- spses :=
- (extraPlaces := ($preLength - (SIZE optPre) - 3)) > 0 =>
- MAKE_-FULL_-CVEC extraPlaces
- '""
- ['%b, optPre,spses,'":", '%d]
-
--------------------
---% a-list stuff
-desiredMsg (erMsgKey,:optCatFlag) ==
- isKeyQualityP(erMsgKey,'show) => true
- isKeyQualityP(erMsgKey,'stifle) => false
- not null optCatFlag => CAR optCatFlag
- true
-
-isKeyQualityP (key,qual) ==
- --returns pair if found, else NIL
- found := false
- while not found and (qualPair := ASSOC(key,$specificMsgTags)) repeat
- if CDR qualPair = qual then found := true
- qualPair
-
------------------------------
---% these functions handle the attributes
-
-initImPr msg ==
- $erMsgToss or MEMQ (getMsgTag msg,$imPrTagGuys) =>
- setMsgUnforcedAttr (msg,'$imPrGuys,'imPr)
-
-initToWhere msg ==
- member ('trace,getMsgCatAttr (msg,'catless)) =>
- setMsgUnforcedAttr (msg,'$toWhereGuys,'screenOnly)
-
-msgImPr? msg ==
- (getMsgCatAttr (msg,'$imPrGuys) = 'imPr)
-
-msgNoRep? msg ==
- (getMsgCatAttr (msg,'$repGuys) = 'noRep)
-
-msgLeader? msg ==
- getMsgTag msg = 'leader
-
-getMsgToWhere msg ==
- getMsgCatAttr (msg,'$toWhereGuys)
-
-getMsgCatAttr (msg,cat) ==
- IFCDR QASSQ(cat, ncAlist msg)
-
-setMsgForcedAttrList (msg,aL) ==
- for attr in aL repeat
- setMsgForcedAttr(msg,whichCat attr,attr)
-
-setMsgUnforcedAttrList (msg,aL) ==
- for attr in aL repeat
- setMsgUnforcedAttr(msg,whichCat attr,attr)
-
-setMsgForcedAttr(msg,cat,attr) ==
- cat = 'catless => setMsgCatlessAttr(msg,attr)
- ncPutQ(msg,cat,attr)
-
-setMsgUnforcedAttr(msg,cat,attr) ==
- cat = 'catless => setMsgCatlessAttr(msg,attr)
- not QASSQ(cat, ncAlist msg) => ncPutQ(msg,cat,attr)
-
-setMsgCatlessAttr(msg,attr) ==
- ncPutQ(msg,'catless,CONS (attr, IFCDR QASSQ(catless, ncAlist msg)))
-
-whichCat attr ==
- found := 'catless
- for cat in $attrCats repeat
- if ListMember? (attr,EVAL cat) then
- found := cat
- return found
- found
-
---------------------------------------
---% these functions directly interact with the message object
-
-makeLeaderMsg chPosList ==
- st := MAKE_-FULL_-CVEC ($preLength- 3)
- oldPos := -1
- for [posNum,:posLetter] in reverse chPosList repeat
- st := STRCONC(st, _
- rep(char ".", (posNum - oldPos - 1)),posLetter)
- oldPos := posNum
- ['leader,$nopos,'nokey,NIL,NIL,[st]]
-
-makeMsgFromLine line ==
- posOfLine := getLinePos line
- textOfLine := getLineText line
- globalNumOfLine := poGlobalLinePosn posOfLine
- localNumOfLine :=
- i := poLinePosn posOfLine
- stNum := STRINGIMAGE i
- STRCONC(rep(char " ", ($preLength - 7 - SIZE stNum)),_
- stNum)
- ['line,posOfLine,NIL,NIL, STRCONC('"Line", localNumOfLine),_
- textOfLine]
-
-getMsgTag msg == ncTag msg
-
-getMsgTag? msg ==
- IFCAR member (getMsgTag msg,_
- ['line,'old,'error,'warn,'bug,'unimple,'remark,'stat,'say,'debug])
-
-leader? msg == getMsgTag msg = 'leader
-line? msg == getMsgTag msg = 'line
-
-getMsgPosTagOb msg == msg.1
-
-getMsgPos msg ==
- getMsgFTTag? msg => CADR getMsgPosTagOb msg
- getMsgPosTagOb msg
-
-getMsgPos2 msg ==
- getMsgFTTag? msg => CADDR getMsgPosTagOb msg
- ncBug('"not a from to",[])
-
-getMsgFTTag? msg == IFCAR member (IFCAR getMsgPosTagOb msg,_
- ['FROM,'TO,'FROMTO])
-
-getMsgKey msg == msg.2
-
-getMsgKey? msg == IDENTP (val := getMsgKey msg) => val
-
-getMsgArgL msg == msg.3
-
-getMsgPrefix? msg ==
- (pre := msg.4) = 'noPre => NIL
- pre
-
-getMsgPrefix msg == msg.4
-
-
-getMsgLitSym msg ==
- getMsgKey? msg => '" "
- '"*"
-
-getMsgText msg == msg.5
-
-setMsgPrefix (msg,val) == msg.4 := val
-
-setMsgText (msg,val) == msg.5 := val
-
-
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}