diff options
author | dos-reis <gdr@axiomatics.org> | 2007-09-20 04:33:26 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-09-20 04:33:26 +0000 |
commit | 516d3e4928185c380ffee8249454fe76ab6f2851 (patch) | |
tree | ac69cb24a13b8e7cfa5b955db57b56951a599499 /src/interp/msg.boot.pamphlet | |
parent | 7bacc11540fe33bf3530c361a59772ecd4d529d9 (diff) | |
download | open-axiom-516d3e4928185c380ffee8249454fe76ab6f2851.tar.gz |
remove pamphlets - part 6
Diffstat (limited to 'src/interp/msg.boot.pamphlet')
-rw-r--r-- | src/interp/msg.boot.pamphlet | 577 |
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} |