; ; File: ScriptMgrUtilNum.a (formerly SMgrUtilNum.a) ; ; Contains: Script Manager formatted number routines ; ; Written by: DRS daan Strebe ; MED Mark Davis ; LDC Lee Collins ; PKE Peter Edberg ; ; Copyright: © 1987-1992 by Apple Computer, Inc. All rights reserved. ; ; This file is used in these builds: ROM, disk ; ; Change History (most recent first): ; ; 11/6/92 SWC Changed PackMacs.a->Packages.a. ; <8> 4/30/92 FM Remove obsolete conditionals: smgrUsesStdExit, smgrSysVers ; <7> 9/14/90 BG Removed <6>. 040s are now behaving more reliably. ; <6> 7/17/90 BG Added EclipseNOPs for flakey 040s. ; <5> 4/16/90 PKE Use smgrSysVers and smgrROMVers symbols instead of buildLevel to ; control conditionalization. ; <4> 4/10/90 PKE Deleted conditionalized definitions of forRom, SysVers, and ; TestScriptManager. Deleted import of GetSMgrCore macro! Fixed ; tabs. Used new smgrUseStdExit symbol instead of buildLevel where ; appropriate. ; <3> 3/4/90 PKE Changed _UprText to _UpperText to match new Traps.a. ; <2> 2/22/90 PKE Replaced obsolete _LwrStringToUpr opword with _UprText. Updated ; header to BBS format. ; <1> 12/18/89 CCH Adding for the first time into BBS. Changed include 'inc.sum.a' ; to load 'StandardEqu.d'. Updated file name references. ; ; (BBS versions above, EASE versions below:) ; <2.2> 8/26/89 PKE Cleaned up conditionals, changing newItl2Tables to buildLevel >= ; 1. ; <2.1> 8/22/89 SES Removed references to nFiles. ; <2.0> 6/30/89 PKE NEEDED FOR AURORA: Use new LwrString for localizable upper- ; casing (!) instead of UprString; change to use internal vectors ; for ROM version only. (First item is from code review, second ; item is only a change for 7.0). ; <1.9> 6/23/89 PKE Skip definition of buildLevel (done in ScriptPriv.a). ; <1.8> 5/22/89 PKE (Esprit needs this too): 1) Fix FormatStr2X to correct ; best-guess handling of negative numbers that don't match the ; format string (was broken by Altair changes). 2) Fix ; ConvertToString so that FormatX2Str handles a 0 value correctly ; in a format with an exponent (BRC #39590). 3) Change ; CheckForDigits and FormatStr2X so that when trying to match a ; number string to a zero format, non-zero digits are not accepted ; until after an exponent (fixes BRC #41209). 4) Fix Str2Format to ; impose tighter restrictions on format strings: it now disallows ; any format with preDig+postDig=0, unless it is just a literal ; with no decimal pt., exponent, or percent sign (fixes BRC ; #47210, 47211, 47212). 5) Fix FormatStr2X & FormatX2Str to check ; for invalid formats detected by Str2Format. 6) Fix ; CheckForm/SendItem so Format2Str returns correct positions (BRC ; #46877). NOTE: Should have more limit checking. ; <1.7> 2/21/89 PKE Replaced with RomProj version, which already had system and Rom ; sources merged. ; (EASE ROMproj history below) ; <1.5> 2/21/89 PKE Fix up includes: always use include 'inc.sum.a'. Fix bugs caused ; by old use of a5 as a temp register; this caused problems with ; the new method of getting case conversion tables out of itl2. ; For example, MatchingBlocks saves/restores a5, and uses it in ; between as a temp reg; but while a5 is altered, it calls ; MatchingSubstring, which calls CharComp, which calls UprString, ; which NOW calls IUGetIntl, which calls IntlScript, which depends ; on the a5 world. Still need to remove a5 use in xFormX2Str, ; which doesn't indirectly call UprString, but which should be ; fixed anyway. ALso, xFormStr2X unnecessarily saves a5. ; <1.4> 2/14/89 PKE Updated to use MPW 3.0 final ScriptEqu.a equate names ; <1.3> 2/3/89 PKE Merged with current system sources (CCH's 01/16/1989 merge of ; 6.0.3 and 7.0 sources, done in RES.sys:smgr) ; <1.2> 11/14/88 PKE Synchronize EASE and Projector ; <1.1> 11/11/88 CCH Fixed Header. ; <1.0> 11/9/88 CCH Adding to EASE. ; (old EASE ROMproj history below) ; <1.7> 10/27/88 LDC Mods by Carl Hewitt and Brian McGhie in the process of putting ; Script Manager in ROM ; (EASE SYSproj history below) ; <1.6> 2/14/89 PKE Updated to use MPW 3.0 final ScriptEqu.a equates ; <1.5> 1/31/89 PKE One more "SysVers >= $700" conditionalization fixup ; <1.4> 1/31/89 PKE Use "SysVers >= $700" to conditionalize BEQ.S vs BEQ somewhere ; <1.3> 1/31/89 PKE Fixed up some of the "SysVers >= $700" conditionalization ; <1.2> 1/17/89 CCH Merged changes from 6.0.3. ; <1.1> 1/16/89 CCH Merged 6.0.3 final sources into 7.0. ; <1.0> 11/16/88 CCH Added to EASE. ; (pre-EASE history below) ; 9/21/88 ldc fixed bug #30677 and 30680, checking for multiple decimals and ; spurious chars ; 9/19/88 fixed bug #29602, non acceptance of #.##e+# format ; 9/8/88 ldc fixed 30678 (failure to detect overflow) in FormatStr2X and ; 33761 (confusion of overflow with nan) ; 9/7/88 ldc fixed failure to detect minus zero cf bug # 30675 and failure to ; detect empty format string (c.f. bug ddm #29008) ; 6/17/88 ldc Vectorized internal procs ; 5/19/88 ldc added standard exits ; * changes above are for ROM or buildLevel >= 2 * ; 4/14/88 ldc fix to problem with empty string not returning nan; changed ; failure to match literal string to return NAN(17), instead of ; fSpuriousChars ** Changes for ROM or buildLevel 2: ** ; 4/4/88 ldc Changed NumFormatString record to FormatStringPriv ; 4/4/88 ldc fixed problem with random garbage after booting in Format2Str ; 3/31/88 ldc fixed FormatStr2X to allow output of 1 when positive format ; input is literal string containing no digits e.g., 'number' => 1 ; 3/30/88 ldc fixed problem with not being able to output literal only format ; strings, e.g. 'zero', in FormatX2Str ; 3/28/88 ldc Fixed random bug caused by non initialization of length of ; outString in Format2Str ; 3/25/88 ldc added code in FormatX2Str to fix problem will excess clipping of ; predecimal leaders when non-leaders are present (#000.0 + 1.0 -> ; 001.0, not 1.0). Also compacted calls to DoSendChar in ; AppendSymbol ; 3/18/88 ldc found two more missing offsets to NumberParts.data ; 3/18/88 ldc Fixed bra.s to looptest ; 3/17/88 med IsSubstring: Since dan is using limits, not counts, a limit of ; zero means one character ; 3/17/88 ldc CheckExp: hanged because this was getting the wrong address ; 3/16/88 ldc Added boolean parameter "ignoreCase" to MatchingSubString ; 3/15/88 ldc Placed call UprString within CharComp ; 3/14/88 ldc Cleaned up after adding version to Number Parts table. ; 3/4/88 ldc added UprString to allow case insensitivity ; 2/25/88 med/ldc Fixed alternate digits address error and bad index. ; 2/25/88 med/ldc Fixed failure to detect overflow with ".##" + 345.0 ; 2/25/88 drs also "bettered" the display zero paradigm ; 2/25/88 drs Fixed both open bugs in one fell swoop; "^.#" + 0 => "*.", but ; "*." not accepted on input, "#;#.#E+#'DB'" + 3.E+0DB => 3 ; 2/24/88 ldc added 'fBestGuess' to flag case when no exact match is found ; 2/23/88 ldc replaced #1 with #fFormatOK ; 2/23/88 ldc fixed xyz -> nan,error; -xyz -> nan,noError ; 2/22/88 ldc removed nested LINK and UNLK in FormatStr2X ; 2/19/88 ldc Added debugging macros for symbol generation ; 2/8/88 med Fixed leaders to print correctly, not "^^^" => "***" ; 2/8/88 med Better bounds checking in SendChar ; 2/8/88 med Garbage input partially caught (drs) ; 2/8/88 med Special SANE values not caught (drs) ; 2/7/88 med Fixed embedded escaped characters in Format2Str. ; 2/7/88 med Changed TranslateText to use two-byte char for catching escaped ; characters ; 2/7/88 med Got quotes to work properly on Format2Str! ; 2/7/88 med misc fixes, some optimizations; lot of code transposition ; 2/7/88 med formCount is a byte ; 2/7/88 med Added some formatting with macros ; 1/25/88 med Dan added comments & fixed three minor bugs: ; "#.##'CR';#.##'DB'" + "2.1DB" didn't yield -2.1 ; "##E#,###" + 1E1234 didn't yield "1E1,234" ; "#.#" + "2." ≠> 2.0 ; 1/7/88 med Added inversion for odd cases ; 12/16/87 med Included Dan’s assemblyized versions, for comments see pascal ; version ;___________________________________________________________________________________________________ ; To Do (old): ; Format Open features: ; Better alternate numbers selection. ; Leaders should act also as trailers: "###^^^.^^^###" + 3.4 => ***3.4*** ; Less strict pattern-matching. ; General code review & optimization. ; E.g. Axe the addendum string in Translate to text, just append to dest string. ; Issue: On input, unquoteds get turned into quoteds ; What to do about '-' in the format string. ;___________________________________________________________________________________________________ STRING AsIs MACRO CheckDebug &thisProc if testScriptManager then dc.b &thisProc endif ENDM load 'StandardEqu.d' include 'ScriptPriv.a' include 'SANEMacs.a' include 'Packages.a' IMPORT StdUnlink EXPORT xStr2Form,xForm2Str,xFormX2Str,xFormStr2X ; internal routine exports <6/18/88ldc> EXPORT AppendSymbol EXPORT ConvertToString EXPORT ExpHandling EXPORT ExpMatching EXPORT CheckForDigits EXPORT MatchingSubstring EXPORT Cond EXPORT CheckForm EXPORT TackOnExp EXPORT MakeExp EXPORT CheckPartsIntegrity EXPORT RetrieveChar EXPORT IsSubstring ;============================================================ macro comp0 &a,&b,&c if &substr(&a,1,1)<>'#' goto +.normal if &eval(&substr(&a,2,&len(&a)-1))<>0 goto +.normal tst&c &b goto +.end .normal: cmp&c &a,&b .end: endMacro macro compw &a,&b comp0 &a,&b,.w endMacro macro compl &a,&b comp0 &a,&b,.l endMacro macro compb &a,&b comp0 &a,&b,.b endMacro ;============================================================ ; Routine CharComp(char1,char2: HighChar): Boolean ;case insensitive comparison of two characters ;<3/15/88ldc> added CharComp ; ; trashes a0, d0, d1 ; calls _UprString (6.0.4 & earlier)/_LwrString (new ROMs & 7.0) ; ; NOTE: UprString (called by CharComp) now depends on the a5 world, ; so don't muck around with a5 before calling CharComp! <02/21/89 pke> ; Actually, UprString is again independent of a5 world, but now we're ; using LwrString instead, which DOES depend on a5 world. <06/30/89 pke> ; CharCompFrame record {oldA6},decrement equal ds.w 1 ; return value args equ * char1 ds.w 1 ; char char2 ds.w 1 ; char argSize equ args-* returnAdr ds.l 1 oldA6 ds.l 1 locals equ * endr ;------------------------------- CharComp proc with CharCompFrame link A6, #locals lea char1(a6), a0 ; UprString uses a0 for string ptr move.w #2, d0 ; apply UprString to one char _UpperText ; _LwrString with smUpper function <3> move.w (a0), d1 lea char2(a6), a0 move.w #2, d0 ; apply UprString to one byte _UpperText ; _LwrString with smUpper function <3> cmp.w (a0), d1 seq equal(a6) move #argSize, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'CHARCOMP' endwith endp ;============================================================ ; NextFormatClass ; ; trashes d0 ; calls -- ; NextFormatClass proc EXT.W D0 ADDQ.W #1,D0 compw #3,D0 BNE.S @L1 MOVEQ.L #0,D0 @L1: RTS endp ;============================================================ ;<9/8/88ldc> ; Function GetSANEClass ; Gets SANE number class for extended ; input: ; a1 = ptr to extended ; output: ; d0 = class ; uses: ; a0 ;<9/8/88ldc> SANE number classes negZero equ $fffc ; -4 ie negative zero sane number class <9/7/88ldc> posQNan equ $0002 ; positive quiet NAN negQNan equ $fffe ; negative quiet NAN posSNan equ $0001 ; positive signalling NAN negSNan equ $ffff ; negative signalling NAN posInf equ $0003 ; positive infinity negInf equ $fffd ; negative infinity posDeNorm equ $0005 ; positive denormalized negDeNorm equ $fffb ; negative denormalized GetSANEClass proc clr.w -(sp) ; word storage movea.l sp, a0 ; old stack position move.l a1, -(sp) ; push x move.l a0, -(sp) ; storage for temp integer FClassX ; use SANE to get class move.w (sp)+, d0 ; return value is now on top rts endp ;============================================================ IF 1 THEN ; unfinished--don't use yet <2/7/88med> SendByte proc ; input a0 @StrPtr (length is actually max value) ; a1 @position for next char (1..254) ; d0 byte to add ; output d0 result code ; uses d1,d2 ; function add byte to string. Omit nulls, and check for overflow move.b d0,d1 ; null? beq.s @SendOk ; skip move.l #fFormatOverflow,d0 ; default result = bad move.w (a1),d2 ; get next position (1.255) cmp.b (a0),d2 ; compare max length bhs.s @SendExit ; too big, bail move.b d1,0(a0,d2.w) ; set byte add.w #1,(a1) ; bump position @SendOk move.l #fFormatOK,d0 ; return ok @SendExit rts endProc ;============================================================ SendCharRev0 proc ; input a0 @StrPtr (length is actually max value ; a1 @position for next char (1..254) ; d0 word to add ; output d0 result code export SendChar0 ror.w #8,d0 ; exchange top and bottom bytes SendChar0 move.w d0,-(sp) ; stash whole char move.b (sp),d0 ; get top byte bsr.s SendByte ; send it (if it is too far, next will be too) move.w (sp)+,d0 ; get bottom byte (don't care about top) bsr.s SendByte ; send it rts endProc SendCharRev proc export SendChar topByte equ 12 botByte equ 13 textPtr equ 8 textLen equ 4 argBytes equ 10 MOVE.B topByte(A7),D0 MOVE.B botByte(A7),topByte(A7) MOVE.B D0,botByte(A7) ; drop through ; discard this mess and use a register interface someday ; SendChar ; trashes a0-a1,d0,d2,d1 (in SendByte) SendChar move.l (a7)+,d2 ; return address move.l (a7)+,a1 ; @position move.l (a7)+,a0 ; @textPtr move.w (a7)+,d0 ; word to add move.l d2,-(a7) ; restore return bsr.s SendChar0 ; do real routine move.w d0,4(a7) ; set return rts endProc ;============================================================ ELSE ;============================================================ ; old version was here ENDIF ;------------------------------------------------------------ Str2FormFrame record {oldA61},decrement returnValue1 ds.w 1 ; INTEGER argFrameT1 EQU * inString ds.l 1 ; VAR str255 partsTable ds.l 1 ; VAR NumberParts outString ds.l 1 ; VAR NumFormatString selector1 ds.l 1 argFrame1 EQU argFrameT1-* return1 ds.l 1 oldA61 ds.l 1 formCount ds.b 1 ; formatClass going ds.b 1 ; BOOLEAN c ds.w 1 ; wideChar outIndex ds.w 1 ; INTEGER inIndex ds.w 1 ; INTEGER res ds.w 1 ; INTEGER thisCode ds.w 1 ; INTEGER altNumFlag ds.b 1 ; BOOLEAN ALIGN 2 currentFlags ds.w 1 ; BitPack localFrame1 EQU * ENDR ;============================================================ InUnquoteds proc ; moved in-line endp ;============================================================ ; RetrieveChar ; ; trashes a0,d0,d1 ; uses/restores a2,a3,a4,d7 ; calls _CharByte (may trash a0-a1,d0-d2) ; RetrieveChar proc ;------------------------------------------------------------ retrieveCharFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * index ds.l 1 ; VAR INTEGER oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 k ds.w 1 localFrame2 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D7/A2-A4 indexR EQU A3 ff EQU A4 inStringR EQU A2 kR EQU D7 ;============================================================ WITH Str2FormFrame,retrieveCharFrame ;pull the next character our of the input string, whether it be a ;single-byte character or a two-byte character LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L index(A6),indexR MOVEA.L oldA6f2(A6),ff CLR.W returnValue2(A6) ;default on null--the low byte usually is anyway MOVEA.L inString(ff),inStringR ;we use inString fairly often CLR.W D0 MOVE.B (inStringR),D0 compw (indexR),D0 ;check if we have source chars left BLT.S @out CLR.W -(A7) ;we need to check how many bytes in the next char PEA 1(inStringR) ;address of first byte MOVE.W (indexR),D0 ;index into string SUBQ.W #1,D0 ;minus 1 for 0 based MOVE.W D0,-(A7) _CharByte MOVE.W (A7)+,kR ;0 designates single byte char BNE.S @twoByte MOVE.W (indexR),D0 ;get the current character CLR.W D1 MOVE.B 0(inStringR,D0.W),D1 MOVE.W D1,returnValue2(A6) ;put it in the return position ADDQ.W #1,(indexR) ;and increment the index BRA.S @out @twoByte: BPL.S @outOfSync ;positive CharByte means middle of two-byte char MOVE.W (indexR),D0 ;make sure that if it's two byte then÷ CMP.B (inStringR),D0 ;there actually is a second byte BGE.S @outOfSync MOVE.B 0(inStringR,D0.W),returnValue2(A6) ;place the bytes MOVE.B 1(inStringR,D0.W),(returnValue2+1)(A6) ADDQ.W #2,(indexR) ;and increment index BRA.S @out @outOfSync: MOVE.W #fOutOfSynch,returnValue1(ff) ;no integrity in input string @out: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'RETRIEVE' ENDWITH endp ;------------------------------------------------------------ CheckPartsIntegrityFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 temp ds.w 1 ; INTEGER j ds.w 1 ; INTEGER i ds.w 1 ; INTEGER localFrame2 EQU * ENDR ;============================================================ ; CheckExp ; ; trashes a0,d0 ; uses/restores a2,a3,a4,d6,d7 ; CheckExp proc ;------------------------------------------------------------ CheckExpFrame record {oldA63},decrement argFrameT3 EQU * exp ds.l 1 ; VAR wideCharArr oldA6f3 ds.l 1 argFrame3 EQU argFrameT3-* return3 ds.l 1 oldA63 ds.l 1 x ds.w 1 ; INTEGER i ds.w 1 ; INTEGER localFrame3 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D6/D7/A2-A4 ff EQU A2 ff1 EQU A3 partsTableR EQU A4 xR EQU D6 iR EQU D7 ;============================================================ WITH Str2FormFrame,CheckPartsIntegrityFrame,CheckExpFrame ;make sure that the first character of the exponent doesn't coincide with… ;…any other first character LINK A6,#localFrame3 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f3(A6),ff ;load up all the usuals MOVEA.L oldA6f2(ff),ff1 ; MOVEA.L (partsTable+NumberParts.data)(ff1),partsTableR ;<3/17/88ldc> changed because this was getting the wrong address MOVEA.L partsTable(ff1),partsTableR ADDA.W #NumberParts.data, partsTableR MOVEA.L exp(A6),A0 ;examine the exponent compw #0,WideCharArr.size(A0) ;does it have any characters in it? <2/7/88med> blt.s @out ; zero test now <2/7/88med> MOVE.W WideCharArr.data(A0),xR BEQ.S @out ;just to be sure MOVE.W #(tokMaxSymbols-1),iR ;check against the entire parts table @expLoop: compw (partsTableR)+,xR DBEQ iR,@expLoop BNE.S @out ;no match; we just ran out of data CLR.B returnValue2(ff) ;we actually matched, which is an error @out: MOVEM.L (A7)+,localRegs move #argFrame3, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'CHECKEXP' ENDWITH endp ;============================================================ ; CheckPartsIntegrity ; ; trashes a0,d0,d1,d2 ; uses/restores a4,d5-d7 ; calls CheckExp, which trashes a0,d0 ; CheckPartsIntegrity proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D5-D7/A4 partsTableR EQU A4 iR EQU D7 tempR EQU D5 jR EQU D6 ;============================================================ WITH Str2FormFrame,CheckPartsIntegrityFrame,NumberParts ;Test the internal integrity of the parts table by making sure that ;the first digit of any exponent string doesn't coincide with any other ;entries except other exponent strings; making sure that no other ;entries coincide with any other entries except for left vs. right ;quote marks and leadPlace vs. leader LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f2(A6),A0 MOVEA.L partsTable(A0),partsTableR ST returnValue2(A6) ;be optimistic for once and assume no problem ; check the version cmp.w #curNumberPartsVersion,version(partsTableR) ; good version? bne @ReturnBadParts ; continue with check MOVEQ #tokLeftQuote,iR ;i is the loop counter BRA.S @endI @forI: MOVE.W iR,D0 ;collect the current sample ADD.W D0,D0 MOVE.W (-(tokLeftQuote*2)+data)(partsTableR,D0.W),tempR BEQ.S @contI ;ignore it if it's empty… MOVE.W iR,jR ;…otherwise check against the rest of the table ADDQ.W #1,jR ;starting 1 after self BRA.S @endJ @startJ: MOVE.W jR,D0 ;make sure we have no duplicate entries ADD.W D0,D0 compw (-(tokLeftQuote*2)+data)(partsTableR,D0.W),tempR BNE.S @contJ ;we got a match compw #tokLeadPlacer,iR ;but if it's leadPlacer vs. leader, then fine SEQ D0 compw #tokLeader,jR SEQ D1 AND.B D1,D0 compw #tokLeftQuote,iR ;or if it's leftQuote vs. rightQuote then fine SEQ D1 compw #tokRightQuote,jR SEQ D2 AND.B D2,D1 OR.B D1,D0 ;; BNE.S @contJ ;; SF returnValue2(A6) ;it was neither, so bad break beq.s @ReturnBadParts ; bail with bad value @contJ: ADDQ.W #1,jR ;on to the next @endJ: compw #tokMaxSymbols,jR ;but are we done? BLE.S @startJ @contI: ADDQ.W #1,iR ;now increment the outer loop counter @endI: compw #(tokMaxSymbols-1),iR ;and check for done BLE.S @forI PEA PePlus(partsTableR) ;check the exponents MOVE.L A6,-(A7) JSR CheckExp PEA PeMinus(partsTableR) MOVE.L A6,-(A7) JSR CheckExp ;<1/29/88drs> Changed 8 lines to fix what I'm sure was a bug but never showed up LEA NumberParts.data(partsTableR),a0 ; use a0 as temp <2/25/88med> MOVE.W #(tokMaxSymbols),iR ;we also need to make sure that… @ccLoop: ;there are no control codes in the table SUBQ.W #1,iR ;loop the loop BLT.S @ccEnd MOVE.W (a0)+,D0 ; use a0 as temp <2/25/88med> BEQ.S @ccLoop ;null character is legal compb #(tokMaxSymbols+1),D0 ;control char is not legal BHS.S @ccLoop bra.s @ReturnBadParts ; bail with bad value ;; SF returnValue2(A6) ;reflect your disappointment @ccEnd: cmp.w #9,altNumTable.size(partsTableR) ; right size? <2-25-88med/ldc> beq.s @ccRealEnd ; escape if good <2-25-88med/ldc> @ReturnBadParts SF returnValue2(A6) ;reflect your disappointment <2-25-88med/ldc> @ccRealEnd: MOVEM.L (A7)+,localRegs UNLK A6 MOVE.L (A7)+,(A7) RTS CheckDebug 'CHECKPAR' ENDWITH endp ;------------------------------------------------------------ MakeExpFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * exp ds.l 1 ; VAR WideCharArr expOrd ds.w 1 ; INTEGER expChar ds.w 1 ; CHAR oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 localFrame2 EQU * ENDR ;============================================================ ; IsSubstring ; ; trashes a0,d0,d1 (maybe a1,d2) ; uses/restores a3,a4,d7 ; calls RetrieveChar, which trashes a0,d0,d1 (maybe a1,d2) ; IsSubstring proc ;------------------------------------------------------------ isSubStringFrame record {oldA63},decrement returnValue3 ds.w 1 ; BOOLEAN argFrameT3 EQU * oldA6f3 ds.l 1 argFrame3 EQU argFrameT3-* return3 ds.l 1 oldA63 ds.l 1 res ds.w 1 ; INTEGER k ds.w 1 ; INTEGER j ds.w 1 ; INTEGER localFrame3 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D7/A3/A4 ff EQU A3 ff1 EQU A4 kR EQU D7 ;============================================================ WITH Str2FormFrame,MakeExpFrame,IsSubStringFrame, SMgrRecord ;determine whether the input string at this point matches whichever ;exponent string we send LINK A6,#localFrame3 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f3(A6),ff MOVEA.L oldA6f2(ff),ff1 MOVEQ #1,kR ;k is index into exp MOVE.W inIndex(ff1),j(A6) ;j is index into comparator SF returnValue3(A6) ;assume no it's not a substring MOVEA.L exp(ff),A0 ;get the exp structure ;; compw WideCharArr.size(A0),kR ;and make sure it's not empty ;; BGT.S @out ;don't compare nothing ; <3/17/88med> since dan is using limits, not counts, a limit of zero means one character ; and since the first character has already been tested, just jump to the end to test bra.s @LoopTest ; test for done. @loop: MOVEA.L inString(ff1),A0 ;if j is beyond end of inString, CLR.W D0 ;then we're done comparing MOVE.B (A0),D0 compw j(A6),D0 BLT.S @out CLR.W -(A7) ;result space PEA j(A6) ;index into inString MOVE.L ff1,-(A7) ;the ubiquitous frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectRetrieveChar(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR RetrieveChar ;get the next character ENDIF MOVE.W (A7)+,c(ff1) ;and move it into c MOVEA.L exp(ff),A0 ;compare c to exp.data[k] MOVE.W kR,D0 ADD.W D0,D0 MOVE.W c(ff1),D1 compw WideCharArr.data(A0,D0.W),D1 BNE.S @out ;if it doesn't match, just leave ADDQ.W #1,kR ;otherwise advance pointer MOVEA.L exp(ff),A0 ;and check if we've run out of exp ;<3/18/88ldc> moved looptest up to here @LoopTest compw WideCharArr.size(A0),kR BLE.S @loop MOVE.W j(A6),inIndex(ff1) ;update index from j ST returnValue3(A6) ;and report the results @out: MOVEM.L (A7)+,localRegs UNLK A6 MOVE.L (A7)+,(A7) RTS CheckDebug 'ISSUBSTR' ENDWITH endp ;============================================================ ; MakeExp ; ; trashes a0,d0,d1 (maybe a1,d2) ; uses/restores a3-a4 ; calls IsSubstring, which trashes a0,d0,d1 (maybe a1,d2) ; MakeExp proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg A3/A4 ff EQU A4 outStringR EQU A3 ;============================================================ WITH Str2FormFrame,MakeExpFrame,FormatStringPriv, SMgrRecord ;if we encounter an exponent, say so and parse beyond it ;and insert the appropriate exponent character into the form string LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f2(A6),ff MOVEA.L outString(ff),outStringR SF returnValue2(A6) ;assume the worst CLR.W -(A7) ;first determine if inString is a… MOVE.L A6,-(A7) ;…subset of exp IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectIsSubstring(a0),a0 ; <6/17/88ldc> jsr (a0) ELSE JSR IsSubstring ENDIF MOVE.B (A7)+,D0 BEQ.S @out ;and just forget it if not MOVE.W currentFlags(ff),D0 ;see if we've already encountered an exp AND.L #fEMEP,D0 BEQ.S @noDupExp MOVE.W #fExtraExp,returnValue1(ff) BRA.S @flagOut ;set extra exponent flag and quit @noDupExp: BTST #fIsDecimal,currentFlags(ff) BNE.S @contDec ;if we never ran into a decimal point… MOVE.B formCount(ff),D0 ;then we should insert it now before the exp EXT.W D0 ADD.W D0,D0 MOVE.W outIndex(ff),decLocs(outStringR,D0.W) @contDec: MOVE.W expOrd(A6),D0 ;set whichever exp flag we're dealing with MOVE.W D0,D1 ASR.W #3,D0 BSET D1,currentFlags(ff,D0.W) MOVE.W outIndex(ff),D0 ;append the exp symbol to the form string MOVE.B (expChar+1)(A6),formString(outStringR,D0.W) ADDQ.W #1,outIndex(ff) ;and increment the form string index @flagOut: ST returnValue2(A6) ;we did indeed encounter an exponent @out: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'MAKEEXP ' ENDWITH endp ;============================================================ ; ProcessLead ; ; trashes a0,d0,d1 ; ProcessLead proc ;------------------------------------------------------------ processLeadFrame record {oldA62},decrement argFrameT2 EQU * ;x ds.w 1 ; INTEGER PASSED IN D0 oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 localFrame2 EQU * ENDR ;============================================================ WITH Str2FormFrame,processLeadFrame,FormatStringPriv ;process any digit placeholder by putting it into the form string ;and adding it to the count of digits MOVEA.L outString(A6),A0 MOVE.W outIndex(A6),D1 MOVE.B D0,formString(A0,D1.W) ;move the leader into the form string ADDQ.W #1,outIndex(A6) ;and advance the form string index MOVE.W currentFlags(A6),D0 ;if we have not encountered an exponent… AND.L #fEMEP,D0 BNE.S @out MOVE.B formCount(A6),D0 ;then increment postDig or preDig,… EXT.W D0 ;…depending on whether we've hit a decimal yet ADD.W D0,D0 BTST #fIsDecimal,currentFlags(A6) BEQ.S @noDec ADDQ.W #1,postDig(A0,D0.W) BRA.S @out @noDec: ADDQ.W #1,preDig(A0,D0.W) @out: RTS CheckDebug 'PROCESSL' ENDWITH endp ;============================================================ ; GetC ; ; trashes a0 (,d0,d1) (maybe a1,d2) ; calls RetrieveChar, which trashes a0,d0,d1 (maybe a1,d2) ;============================================================ GetC proc WITH Str2FormFrame, SMgrRecord ;a common enough used sequence of code to justify its own routine CLR.W -(A7) ; return space PEA inIndex(A6) ; index into inString MOVE.L A6,-(A7) ; frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectRetrieveChar(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR RetrieveChar ENDIF MOVE.W (A7)+,c(A6) ;and place the result in C RTS ENDWITH endp ;============================================================ ; xStr2Form ; ; trashes a0-a1,d0-d2 ; uses/restores a3-a4,d3-d7 ; calls CheckPartsIntegrity here trashes a0,d0-d2 ; GetC here trashes a0,d0-d1 (maybe a1,d2) ; SendChar here trashes a0-a1,d0-d2 ; ProcessLead here trashes a0,d0-d1 ; CharComp here trashes a0,d0-d1 ; MakeExp here trashes a0,d0-d1 (maybe a1,d2) ; ; NOTE: UprString (called by CharComp) now depends on the a5 world, ; so don't muck around with a5 before calling CharComp! <02/21/89 pke> ; Actually, UprString is again independent of a5 world, but now we're ; using LwrString instead, which DOES depend on a5 world. <06/30/89 pke> ; xStr2Form proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D3-D7/A3/A4 ; don't need a2,a5 <02/21/89 pke> resR EQU D6 outStringR EQU A4 partsTableR EQU A3 altNumFlagR EQU D4 thisCodeR EQU D7 goingR EQU D5 ;============================================================ WITH Str2FormFrame,FormatStringPriv,NumberParts, SMgrRecord LINK A6,#localFrame1 MOVEM.L localRegs,-(A7) MOVE.W #fFormatOK,returnValue1(A6) ; be optimistic about the result MOVEQ #fFormatOK,resR ; let resR handle immediate results CLR.W -(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectCheckPartsIntegrity(a0),a0 ; <6/17/88ldc> jsr (a0) ELSE JSR CheckPartsIntegrity ; first see that the parts table is ok ENDIF MOVE.B (A7)+,D0 BNE.S @partsTableOk ; and if it's not then report it MOVE.W #fBadPartsTable,returnValue1(A6) BRA @out @partsTableOk: MOVEA.L outString(A6),outStringR ; otherwise load up a reg or two MOVEA.L partsTable(A6),partsTableR MOVEQ.L #(2*fZero),D3 ; clear out all the flags @clearFlags: CLR.W flags(outStringR,D3.W) CLR.W decLocs(outStringR,D3.W) MOVE.W #1,startLocs(outStringR,D3.W) ; for null formats, point past end of string CLR.W preDig(outStringR,D3.W) CLR.W postDig(outStringR,D3.W) SUBQ.B #2,D3 BPL.S @clearFlags ;; MOVE.W #fPositive,formCount(A6) ;start out with positive format string move.b #fPositive,formCount(A6) ;start with positive format string <2/7/88med> compw #'#',(((tokNonLeader-tokLeftQuote)*2)+data)(partsTableR) SNE altNumFlagR ;if the nonLead symbol is not an… BEQ.S @noAltF ;…ascii '#' then assume foreign digits MOVE.W #fExAlF,currentFlags(A6) ;turn on the alternate digits flag… BRA.S @altFCont ;…and the exists flag @noAltF: MOVE.W #fEXISTF,currentFlags(A6) ;otherwise turn on just the exists flag @altFCont: moveq #1,d0 ;scratch <2/7/88med> MOVE.W d0,inIndex(A6) ;set up string indices <2/7/88med> MOVE.W d0,outIndex(A6) ; <2/7/88med> MOVE.B #(255-fixedLength),formString(outStringR) ;and give a maximum length MOVEA.L inString(A6),A0 MOVE.B (A0),D0 beq @emptyInString ; detect empty instring <9/7/88ldc> st goingR ; if inString[0] is null then don't bother @whileGoing: MOVE.B goingR,D0 ;still looping? BEQ @endWhileGoing CLR.W D0 ;if we've gone beyond the physical limits… MOVE.B formString(outStringR),D0 ;…of the format string then bomb compw outIndex(A6),D0 BGE.S @noOverflow MOVE.W #fFormatOverflow,returnValue1(A6) BRA @out @noOverflow: JSR GetC ;get next character in c(A6) MOVE.W #(tokLeftQuote-1),thisCodeR ;start ourselves off at the beginning @seekMatch: ADDQ.W #1,thisCodeR ;pre-increment compw #tokDecPoint,thisCodeR ;decPoint is the last we're concerned with BGT.S @doneSeekMatch ;so if we've passed that, then forget it MOVE.W thisCodeR,D1 ;otherwise check the char against table entries ADD.W D1,D1 MOVE.W c(A6),D2 compw (-(tokLeftQuote*2)+data)(partsTableR,D1.W),D2 BNE.S @seekMatch ;try again if no match @doneSeekMatch: MOVE.W thisCodeR,D0 ;CASE thisCode OF SUBQ.W #tokLeftQuote,D0 ;leftQuote is lowest BMI @endCase compw #(tokEPlus-tokLeftQuote),D0 ;EPlus is the highest BGT @endCase ADD.W D0,D0 MOVE.W @jTab(D0.W),D0 JMP *+2(D0.W) @jTab: DC.W @leftQuote-@jTab+2, @rightQuote-@jTab+2, @leadPlacer-@jTab+2 DC.W @garbage-@jTab+2, @rLeads-@jTab+2, @rLeads-@jTab+2 DC.W @percent-@jTab+2, @signs-@jTab+2, @signs-@jTab+2 DC.W @signs-@jTab+2, @garbage-@jTab+2, @separator-@jTab+2 DC.W @garbage-@jTab+2, @decPoint-@jTab+2, @others-@jTab+2 @leftQuote: @seekRightQuote: JSR GetC ;just start looking for right qoute MOVE.W c(A6),D0 ;but beware of escapes compw (((tokEscape-tokLeftQuote)*2)+data)(partsTableR),D0 BNE.S @escapeMerge JSR GetC ;found escape so just go right into next char CLR.W -(A7) MOVE.W c(A6),-(A7) PEA formString(outStringR) PEA outIndex(A6) ;and process it JSR SendChar OR.W (A7)+,resR ;<1/29/88drs> Changed 1 line to fix bug ;Could have two escape+c in a row, so loop back to seekRightQuote BRA.S @seekRightQuote @escapeMerge: MOVE.W c(A6),D0 ;check for right quote BEQ.S @L902 compw (((tokRightQuote-tokLeftQuote)*2)+data)(partsTableR),D0 BEQ @endCase ;and just quit if we find it CLR.W -(A7) ;otherwise send out whatever we find MOVE.W c(A6),-(A7) PEA formString(outStringR) PEA outIndex(A6) JSR SendChar OR.W (A7)+,resR BRA.S @seekRightQuote @L902: MOVE.W #fMissingLiteral,returnValue1(A6) BRA @endCase @rightQuote: ;right quote without left is an error MOVE.W #fMissingDelimiter,returnValue1(A6) BRA @endCase @rLeads: ;either zeroLead or nonLead comes here MOVE.W thisCodeR,D0 JSR ProcessLead BRA @endCase @leadPlacer: ;lead placer is replaced by the actual lead symbol MOVE.W #tokLeader,D0 JSR ProcessLead BRA @endCase @decPoint: BTST #fIsDecimal,currentFlags(A6) BEQ.S @noExtraDec ;error if more than one decimal MOVE.W #fExtraDecimal,returnValue1(A6) BRA.S @dOut @noExtraDec: MOVE.W outIndex(A6),D0 ;append decimal point to format string MOVE.B #tokDecPoint,formString(outStringR,D0.W) MOVE.B formCount(A6),D0 ;and record its position EXT.W D0 ADD.W D0,D0 MOVE.W outIndex(A6),decLocs(outStringR,D0.W) ADDQ.W #1,outIndex(A6) ;increment form string index BSET #fIsDecimal,currentFlags(A6) ;and say we got a decimal point @dOut: BRA @endCase @percent: BTST #fIsPercent,currentFlags(A6) ;make sure we don't already… BEQ.S @noExtraPercent ;…have a percent sign MOVE.W #fExtraPercent,returnValue1(A6) ;record error if we do BRA.S @pOut @noExtraPercent: BSET #fIsPercent,currentFlags(A6) ;say we got one MOVE.W outIndex(A6),D0 ;and record its position MOVE.B thisCodeR,formString(outStringR,D0.W) ADDQ.W #1,outIndex(A6) ;increment form string pointer @pOut: BRA @endCase @separator: compb #fZero,formCount(A6) ;if we've already got 3 formats… BNE.S @noExtraSep ;…then it's an error MOVE.W #fExtraSeparator,returnValue1(A6) BRA.S @sOut @noExtraSep: MOVE.B formCount(A6),D1 ;if we have no decimal point,… EXT.W D1 ;…and no exponent then make up a… ADD.W D1,D1 ;…decimal point MOVE.W currentFlags(A6),D0 AND.L #fDEMEP,D0 BNE.S @noFakeDec MOVE.W outIndex(A6),decLocs(outStringR,D1.W) @noFakeDec: MOVE.W preDig(outStringR,D1.W),D0 ; ADD.W postDig(outStringR,D1.W),D0 ; BNE.S @nullFmtTest1Done ;if preDig+postDig≠0, OK MOVE.W outIndex(A6),D0 ; CMP.W startLocs(outStringR,D1.W),D0 ; BLE.S @nullFmtTest1Bad ;otherwise, bad if null length MOVE.W currentFlags(A6),D0 ; AND.W #fDPEMEP,D0 ;otherwise, if no dec pt, percent, BEQ.S @nullFmtTest1Done ; or exponent, then OK @nullFmtTest1Bad: ; CLR.W flags(outStringR,D1.W) ; MOVE.W #fEmptyFormatString,resR ; BRA @nullFmtExit ; @nullFmtTest1Done: MOVE.W currentFlags(A6),flags(outStringR,D1.W) ;save flag set ADDQ.B #1,formCount(A6) ;advance formCount MOVE.B altNumFlagR,D0 ;record just-finished format's… BEQ.S @noAltDig ;…alternate digit record MOVE.W #fExAlF,currentFlags(A6) BRA.S @mergeAltDig @noAltDig: MOVE.W #fEXISTF,currentFlags(A6) @mergeAltDig: MOVE.B formCount(A6),D0 ;and record the starting location… EXT.W D0 ;…of this format ADD.W D0,D0 MOVE.W outIndex(A6),startLocs(outStringR,D0.W) @sOut: BRA @endCase @signs: ;plus, minus, thousands MOVE.W outIndex(A6),D0 ;just record its position MOVE.B thisCodeR,formString(outStringR,D0.W) ADDQ.W #1,outIndex(A6) ;and increment form string index BRA @endCase @garbage: ;escape, noRoomFill, leader MOVE.W #fSpuriousChars,returnValue1(A6) BRA @endCase @others: ;including exponents and unquoteds ; MOVE.W c(A6),D0 ;Check against E+ format ; compw (PePlus+WideCharArr.data)(partsTableR),D0 ;<3/15/88ldc> added case insensitive character comparison routine "CharComp" clr.w -(a7) move.w c(a6), -(a7) move.w (PePlus+WideCharArr.data)(partsTableR), -(a7) jsr CharComp tst.b (a7)+ beq.s @notEPlus ;if partsTable.PePlus.data <> c then not EPlus CLR.W -(A7) ;result room PEA PePlus(partsTableR) MOVE.W #fIsEPlus,-(A7) MOVE.W #tokEPlus,-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectMakeExp(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR MakeExp ;see if the entire EPlus is there ENDIF MOVE.B (A7)+,D0 BNE.S @matchEPlus CLR.W -(A7) ;if not then try EMinus PEA PeMinus(partsTableR) MOVE.W #fIsEMinus,-(A7) MOVE.W #tokEMinus,-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectMakeExp(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR MakeExp ;see if the entire EPlus is there ENDIF MOVE.B (A7)+,D0 BNE.S @matchEMinus MOVE.W #fSpuriousChars,returnValue1(A6) ;otherwise it's junk @matchEPlus: @matchEMinus: BRA.S @endCase @notEPlus: ; MOVE.W c(A6),D0 ; compw (PeMinus+WideCharArr.data)(partsTableR),D0 ;<3/15/88ldc> added case insensitive character comparison routine "CharComp" clr.w -(a7) ;try EMinus move.w c(a6), -(a7) move.w (PeMinus+WideCharArr.data)(partsTableR), -(a7) jsr CharComp tst.b (a7)+ beq.S @notEMinus CLR.W -(A7) PEA PeMinus(partsTableR) MOVE.W #fIsEMinus,-(A7) MOVEQ #tokEMinus,D0 MOVE.W D0,-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call <6/17/88ldc> move.l sVectMakeExp(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR MakeExp ;see if the entire EPlus is there ENDIF MOVE.B (A7)+,D0 BNE.S @wasEMinus ;if this didn't work then it's junk MOVE.W #fSpuriousChars,returnValue1(A6) @wasEMinus: BRA.S @endCase @notEMinus: LEA ((tokMaxSymbols-1)*2)(partsTableR),A1 MOVE.W c(A6),D1 ;try the unquoteds table BEQ.S @junkC ;a null char is unfathomable MOVEQ #(tokEMinus-1),D2 ;loop counter @UQLoop: compw -(A1),D1 DBEQ D2,@UQLoop ;stop if a match BNE.S @junkC ;this character doesn't belong CLR.W -(A7) ;send the code off MOVE.W c(A6),-(A7) PEA formString(outStringR) PEA outIndex(A6) JSR SendChar OR.W (A7)+,resR BRA.S @endCase @junkC: MOVE.W #fSpuriousChars,returnValue1(A6) @endCase: MOVEA.L inString(A6),A0 ;make sure we haven't exceeded the input string CLR.W D0 MOVE.B (A0),D0 compw inIndex(A6),D0 BGE.S @cGo SF goingR @cGo: BRA @whileGoing @emptyInString move.w #fEmptyFormatString, resR ;signal empty format string <9/7/88ldc> bclr.b #fExists,currentFlags(A6) ;turn off exists flag <05/22/89 pke> @endWhileGoing: MOVE.B formCount(A6),D1 ;update flags from temp flag word EXT.W D1 ADD.W D1,D1 MOVE.W preDig(outStringR,D1.W),D0 ; ADD.W postDig(outStringR,D1.W),D0 ; BNE.S @nullFmtTest2Done ;if preDig+postDig≠0, OK MOVE.W outIndex(A6),D0 ; CMP.W startLocs(outStringR,D1.W),D0 ; BLE.S @nullFmtTest2Bad ;otherwise, bad if null length MOVE.W currentFlags(A6),D0 ; AND.W #fDPEMEP,D0 ;otherwise, if no dec pt, percent, BEQ.S @nullFmtTest2Done ; or exponent, then OK @nullFmtTest2Bad: ; CLR.W currentFlags(A6) ; MOVE.W #fEmptyFormatString,resR ; @nullFmtTest2Done: MOVE.W currentFlags(A6),flags(outStringR,D1.W) MOVEQ #0,D0 ;if we never hit decimal or exponent… MOVE.W currentFlags(A6),D0 ;…then make up a decimal point at… AND.L #fDEMEP,D0 ;…this position BNE.S @contDEMEP MOVE.W outIndex(A6),decLocs(outStringR,D1.W) @contDEMEP: @nullFmtExit: ; <05/22/89 pke> CMP.B #fPositive,formCount(A6) BNE.S @notPos ;if the last form was positive then init others MOVE.W outIndex(A6),(startLocs+(2*fNegative))(outStringR) @doZero: MOVE.W outIndex(A6),(startLocs+(2*fZero))(outStringR) BRA.S @mergeP @notPos: compb #fNegative,formCount(A6) BEQ.S @doZero @mergeP: MOVE.W outIndex(A6),startLocs(outStringR) MOVE.W outIndex(A6),D0 ;set startLocs[fPositive] past last form string code SUBQ.W #1,D0 MOVE.B D0,formString(outStringR) ;<1/23/88drs> Added 2 lines to compute dynamic record length ADD.B #fixedLength,D0 MOVE.B D0,fLength(outStringR) compw #fFormatOK,resR ;if resR got changed then say so BEQ.S @out MOVE.W resR,returnValue1(A6) @out: ;<1/23/88drs> Added 1 line to insert version number MOVE.B #fVNumber,fVersion(outStringR) MOVEM.L (A7)+,localRegs move #argFrame1, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'STR2FORM' endp maxString EQU 50 ;------------------------------------------------------------ Form2StrFrame record {oldA61},decrement returnValue1 ds.w 1 ; INTEGER argFrameT1 EQU * myCanonical ds.l 1 ; VAR NumFormatString partsTable ds.l 1 ; VAR NumberParts outString ds.l 1 ; VAR str255 positions ds.l 1 ; VAR TripleInt selector1 ds.l 1 argFrame1 EQU argFrameT1-* return1 ds.l 1 oldA61 ds.l 1 res ds.w 1 ; INTEGER ;<4/1/88ldc> removed the unused i ;i ds.w 1 ; INTEGER j ds.w 1 ; INTEGER formCount ds.b 1 ; formatClass hold12 ds.l 1 hold11 ds.w 1 inLiteral ds.b 1 ; boolean pad ds.b 1 localFrame1 EQU * ENDR ;------------------------------------------------------------ TranslateToTextFrame record {oldA62},decrement argFrameT2 EQU * source ds.w 1 ; CHAR oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 addendum ds.b maxString ; string iIndex ds.w 1 ; INTEGER hold2 ds.w 1 localFrame2 EQU * ENDR ;============================================================ ; TackOnExp ; ; trashes a0,d0 ; uses/restores a2-a4,d7 ; calls SendChar, which trashes a0-a1,d0-d2 ; TackOnExp proc ;------------------------------------------------------------ TackOnExpFrame record {oldA63},decrement argFrameT3 EQU * exp ds.l 1 ; VAR WideCharArr oldA6f3 ds.l 1 argFrame3 EQU argFrameT3-* return3 ds.l 1 oldA63 ds.l 1 xj ds.w 1 hold3 ds.w 1 localFrame3 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D7/A2-A4 ; don't need a5 <02/21/89 pke> ff EQU A3 ff1 EQU A4 expR EQU A2 ;============================================================ WITH Form2StrFrame,TranslateToTextFrame,TackOnExpFrame ;FOR xj:= 0 TO exp.size DO BEGIN ; res:= SendChar(exp.data[xj], addendum, i); END; LINK A6,#localFrame3 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f3(A6),ff MOVEA.L oldA6f2(ff),ff1 MOVEA.L exp(A6),expR MOVE.W WideCharArr.size(expR),hold3(A6) LEA WideCharArr.data(expR),expR CLR.W D7 BRA.S @L448 @L451: CLR.W -(A7) MOVE.W (expR)+,-(A7) PEA addendum(ff) PEA iIndex(ff) JSR SendChar MOVE.W (A7)+,res(ff1) ADDQ.W #1,D7 @L448: compw hold3(A6),D7 BLE.S @L451 @L450: MOVEM.L (A7)+,localRegs move #argFrame3, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'TACKONEX' ENDWITH endp ;============================================================ TranslateToText proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D7/A3/A4 sourceR EQU D7 ff EQU A4 partsTableR EQU A3 ;============================================================ WITH Form2StrFrame,TranslateToTextFrame,NumberParts, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVE.W source(A6),sourceR MOVEA.L oldA6f2(A6),ff ;WITH partsTable DO BEGIN ; i:= 1; ; addendum[0]:= CHR(maxString-1); MOVEA.L partsTable(ff),partsTableR MOVE.W #1,iIndex(A6) MOVE.B #(maxString-1),addendum(A6) ;IF ORD(source) < maxSymbols+1 THEN BEGIN ; CASE ORD(source) OF TransSendMask set 1< ; if not now in literal, send a left quote if was inliteral <2/7/88med> tst.b inLiteral(ff) ; inside quoted literal? beq.s @NoLiteral ; no, done sf inLiteral(ff) ; out of here CLR.W -(A7) MOVE.W ((tokLeftQuote-tokLeftQuote)*2+data)(partsTableR),-(A7) PEA addendum(A6) PEA iIndex(A6) JSR SendChar MOVE.W (A7)+,res(ff) @NoLiteral ;; MOVE.L #$000067F6,D0 move.l #TransSendMask,d0 ; use equate BTST.L sourceR,D0 BNE.S @SendTransChar ;; MOVE.L #$00001808,D0 ; indicate anything unknown ;; BTST.L sourceR,D0 ; ;; BNE.S @TransUnknownChar ; now at end of tests compw #tokEPlus,sourceR BEQ.S @TransExpPlus compw #tokEMinus,sourceR BEQ.S @TransExpMinus BRA.S @TransUnknownChar ; anything we don't know ; leftQuote, ; rightQuote, ; leader, ; zeroLead, ; nonLeader, ; decPoint, ; percent, ; plusSign, ; minusSign, ; thousands, ; escape: res:= SendChar(data[ORD(source)], addendum, i);; @SendTransChar: CLR.W -(A7) ; fix leader move.w #tokLeadPlacer*2,d0 ; assume special case <2/8/88med> cmp.w #tokLeader,sourceR ; special case <2/8/88med> beq.s @GotFixedChar ; <2/8/88med> MOVE.W sourceR,D0 ADD.W D0,D0 @GotFixedChar MOVE.W (-(tokLeftQuote*2)+data)(partsTableR,D0.W),-(A7) PEA addendum(A6) PEA iIndex(A6) JSR SendChar MOVE.W (A7)+,res(ff) BRA.S @TransDone ; noRoomFill, ; leadPlacer, ; separator: BEGIN ; addendum:= '???'; ; i:= 4; END; @TransUnknownChar: MOVE.L #('???' + (3 << 24)),addendum(A6) MOVE.W #4,iIndex(A6) BRA.S @TransDone ; ePlus: TackOnExp( PePlus ); @TransExpPlus: PEA PePlus(partsTableR) bra.s @TransExpCommon ; join common code <2/7/88med> ;; MOVE.L A6,-(A7) ; common <2/7/88med> ;; JSR TackOnExp ; common <2/7/88med> ;; BRA.S @TransDone ; common <2/7/88med> ; eMinus: TackOnExp( PeMinus ); END; @TransExpMinus: PEA PeMinus(partsTableR) @TransExpCommon MOVE.L A6,-(A7) ; common <2/7/88med> IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup and call vector <6/17/88ldc> move.l sVectTackOnExp(a0), a0 ; <6/17/88ldc> jsr (a0) ELSE JSR TackOnExp ; common <2/7/88med> ENDIF bra.s @TransDone ; done tran char. @TransLiteral: ; new tests <2/7/88med> tst.b inLiteral(ff) ; in literal? <2/7/88med> bne.s @AlreadyIn ; no, go CLR.W -(A7) ; changed -data to +data <3/14/88ldc> MOVE.W ((tokLeftQuote-tokLeftQuote)*2+data)(partsTableR),-(A7) PEA addendum(A6) PEA iIndex(A6) JSR SendChar MOVE.W (A7)+,res(ff) st inLiteral(ff) ; in literal? <2/7/88med> @AlreadyIn ; are we in an escape or do we have an escaped rightQuote? ; changed -data to +data <3/14/88ldc> move.w ((tokEscape-tokLeftQuote)*2+data)(partsTableR),d0 ; get tokEscape cmp.w d0,sourceR ; got tokEscape? beq.s @EscapeIt cmp.w ((tokRightQuote-tokLeftQuote)*2+data)(partsTableR),sourceR ; got tokRightQuote? bne.s @EscapeOk @EscapeIt CLR.W -(A7) MOVE.W d0,-(A7) ; pass escape char. PEA addendum(A6) PEA iIndex(A6) JSR SendChar MOVE.W (A7)+,res(ff) @EscapeOk CLR.W -(A7) MOVE.W sourceR,-(A7) PEA addendum(A6) PEA iIndex(A6) JSR SendChar MOVE.W (A7)+,res(ff) ;; MOVE.W #(' ' + (1 << 8)),addendum(A6) ; forget <2/7/88med> ;; MOVE.B sourceR,addendum(A6,d0) ; add byte ; reorder TransDone to drop thru <2/7/88med> @TransDone: ; addendum[0]:= CHR(i-1); END ; ELSE BEGIN ; addendum:= ' '; ; addendum[1]:= source; ; END; MOVE.W iIndex(A6),D0 SUBQ.W #1,D0 MOVE.B D0,addendum(A6) @TransFinished: CLR.W D0 MOVE.B addendum(A6),D0 MOVE.W D0,hold2(A6) ; FOR i:= 1 TO ORD(addendum[0]) DO BEGIN ; s[j]:= addendum[i]; ; j:= j + 1; END; END; MOVE.W #1,iIndex(A6) BRA.S @CopyLoopTest @CopyLoop: MOVEA.L outString(ff),A0 MOVE.W j(ff),D0 MOVE.W iIndex(A6),D1 CLR.W D2 LEA addendum(A6),A1 MOVE.B 0(A1,D1.W),0(A0,D0.W) ADDQ.W #1,j(ff) ADDQ.W #1,iIndex(A6) @CopyLoopTest: MOVE.W iIndex(A6),D0 compw hold2(A6),D0 BLE.S @CopyLoop MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'TRANSLAT' ENDWITH endp ;============================================================ ; ; ; calls _CharByte ; CheckForm proc ;------------------------------------------------------------ CheckFormFrame record {oldA62},decrement argFrameT2 EQU * x ds.w 1 ; formatClass oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 ;i ds.w 1 ; INTEGER - unused, removed <4/1/88ldc> hold22 ds.l 1 hold21 ds.w 1 localFrame2 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D3-D7/A2-A4 ff EQU A4 myCanonicalR EQU A3 xRw EQU D3 rChar equ d5 ; added <2/7/88med> iR EQU D6 xR EQU D7 ;============================================================ WITH Form2StrFrame,CheckFormFrame,NumberParts,FormatStringPriv LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVE.B x(A6),xR MOVEA.L oldA6f2(A6),ff MOVEA.L myCanonical(ff),myCanonicalR MOVEA.L partsTable(ff),A0 MOVE.L A0,hold22(A6) ;<4/4/88ldc> initialize rChar to eliminate garbage at boot time CLR.W rChar MOVE.B xR,xRw EXT.W xRw ADD.W xRw,xRw ;WITH myCanonical, partsTable DO BEGIN ; IF startLocs[x] <= startLocs[ NextFormatClass(x)]-1 THEN BEGIN MOVE.B xR,D0 JSR NextFormatClass ADD.W D0,D0 MOVE.W startLocs(myCanonicalR,D0.W),D2 SUBQ.W #1,D2 MOVE.W D2,hold21(A6) ; moved from below <2/7/88med> ; special test for first case, since we wrap move.l #1,iR ; assume first (1) <2/7/88med> compw #fPositive,xR ; first one? <2/7/88med> beq.s @SkipFirst ; yes, bail <2/7/88med> move.w startLocs(myCanonicalR,xRw.W),iR ; broke up comp, made common <2/7/88med> compw iR,d2 ; was d0 <2/7/88med> BLT.s @checkOut ; res:= SendChar(data[separator], s, j); ; positions[x].start:= j; ;<3/18/88ldc> added NumberParts.data offset move.w #((tokSeparator-tokLeftQuote)*2+NumberParts.data),d0 ; item to send <2/7/88med> bsr.s SendItem ; do it <2/7/88med> MOVE.L positions(ff),A0 MOVE.B xR,D0 EXT.W D0 ASL.W #2,D0 MOVE.W j(ff),FVector.start(A0,D0.W) @SkipFirst ; FOR i:= startLocs[x] TO startLocs[NextFormatClass(x)]-1 DO BEGIN ; TranslateToText( formString[i] ); END; ;; MOVE.B xR,xRw ; axe all common code <2/7/88med> ;; EXT.W xRw ;; ADD.W xRw,xRw ;; MOVE.B xR,D0 ;; JSR NextFormatClass ;; ADD.W D0,D0 ;; MOVE.W (startLocs+(fPositive*2))(myCanonicalR,D0.W),D2 ;; SUBQ.W #1,D2 ;; MOVE.W D2,hold21(A6) ;; MOVE.W (startLocs+(fPositive*2))(myCanonicalR,xRw.W),iR BRA.S @loopTest @checkLoop: ;; MOVE.W iR,D0 CLR.W D1 lea formString(myCanonicalR,iR.W),a0 ; position for char, ir.w was d0.w <2/7/88med> MOVE.B (a0)+,rChar ; get first byte ; pass a character, not a byte; so we can do escape properly clr.w -(sp) ; reserve return move.l a0,-(sp) ; pass ptr move.w #0,-(sp) ; pass offset _CharByte tst.w (sp)+ ; 0 for single beq.s @GotChar asl.w #8,rChar ; moven on up move.b (a0),rChar ; next byte ADDQ.W #1,iR ; bump counter @GotChar MOVE.W rChar,-(A7) MOVE.L oldA6f2(A6),-(A7) ;spurious: ff has this value JSR TranslateToText ADDQ.W #1,iR ;; BVS.S @L472 ; don't think we will overflow <2/7/88med> @loopTest: compw hold21(A6),iR BLE.S @checkLoop ; positions[x].length:= j-positions[x].start; END; END; ;;@L472: ; this label is not used <6/28/88ldc> ; moved the following chunk down & fixed below <05/22/89 pke> ; send a right quote if not done <2/7/88med> tst.b inLiteral(ff) ; inside quoted literal? beq.s @NoLiteral ; no, done sf inLiteral(ff) ; out of here ; added NumberParts.data <3/18/88ldc> move.w #((tokRightQuote-tokLeftQuote)*2+NumberParts.data),d0 ; item to send <2/7/88med> bsr.s SendItem ; do it <2/7/88med> @NoLiteral ; move the following 7 lines here from above <05/22/89 pke> MOVE.L positions(ff),A0 MOVE.B xR,D0 EXT.W D0 ASL.W #2,D0 MOVE.W j(ff),D1 SUB.W FVector.start(A0,D0.W),D1 MOVE.W D1,FVector.length(A0,D0.W) @checkOut: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'CHECKFOR' ;============================================================ ; simple subproc for above SendItem CLR.W -(A7) MOVEA.L hold22(A6),A0 MOVE.W 0(a0,d0.w),-(A7) ; generalized <2/7/88med> MOVE.L outString(ff),-(A7) PEA j(ff) JSR SendChar MOVE.W (A7)+,res(ff) rts endProc ;============================================================ xForm2Str proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D6/D7/A3-A4 procVectR equ a3 ; for vectored proc <6/21/88ldc> myCanonicalR EQU A4 iR EQU D6 ;============================================================ WITH Form2StrFrame,FormatStringPriv,NumberParts, SMgrRecord LINK A6,#localFrame1 MOVEM.L localRegs,-(A7) ;Format2Str:= ORD(formatOk); ;res:= ORD(formatOk); ;xxx <2/23/88:ldc> replaced #1 with symbolic constant fFormatOK MOVE.W #fFormatOK,returnValue1(A6) MOVE.W #fFormatOK,res(A6) ; must initialize outString to Str255 <3/28/88ldc> MOVEA.L outString(A6),A0 MOVE.B #$FF,(A0) ;FOR formCount:= positive TO zero DO BEGIN ; positions[formCount].start:= 0; ; positions[formCount].length:= 0; END; MOVE.L positions(A6),A0 MOVEQ #(fZero*4),D7 @L475: CLR.W 0(A0,D7.W) CLR.W 2(A0,D7.W) SUBQ.B #4,D7 BPL.S @L475 ;WITH myCanonical,partsTable DO BEGIN ; j:= 1; ; positions[positive].start:= 1; @L474: MOVEA.L myCanonical(A6),myCanonicalR tst.b formString(myCanonicalR) ; check for empty formatString beq.s @emptyFormatString MOVEA.L partsTable(A6),A0 MOVE.L A0,hold12(A6) MOVE.W #1,j(A6) MOVE.L positions(A6),A0 MOVE.W #1,4*fPositive(A0) IF 1 THEN ; make common code <2/7/88med> ; CheckForm( positive ); sf inLiteral(a6) ; clear literal flag <2/7/88med> MOVE.B #fPositive,-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore procVectR ; setup and call vector <6/17/88ldc> move.l sVectCheckForm(procVectR), procVectR jsr (procVectR) ELSE JSR CheckForm ENDIF ELSE ; old stuff ; FOR i:= 1 TO startLocs[negative]-1 DO BEGIN ; TranslateToText( formString[i] ); END; MOVE.W (((startLocs+data)+(2*fNegative))(myCanonicalR),D0 SUBQ.W #1,D0 MOVE.W D0,hold11(A6) MOVEQ #1,iR BRA.S @L476 @L479: CLR.W D1 MOVE.B formString(myCanonicalR,iR.W),D1 MOVE.W D1,-(A7) MOVE.L A6,-(A7) JSR TranslateToText ADDQ.W #1,iR @L476: compw hold11(A6),iR BLE.S @L479 ; positions[positive].length:= j-1; @L478: MOVE.W j(A6),D0 SUBQ.W #1,D0 MOVEA.L positions(A6),A0 MOVE.W D0,(FVector.length+(fPositive*2))(A0) ENDIF ; CheckForm( negative ) ;<3/28/88ldc> sf inLiteral(A6) MOVE.B #fNegative,-(A7) move.l a6, -(a7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (procVectR) ELSE JSR CheckForm ENDIF ; CheckForm( zero ) ;<3/28/88ldc> sf inLiteral(A6) MOVE.B #fZero,-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (procVectR) ELSE JSR CheckForm ENDIF ; s[0]:= CHR(j-1); END; MOVEA.L outString(A6),A0 MOVE.W j(A6),D0 SUBQ.W #1,D0 MOVE.B D0,(A0) bra.s @exit ;<9/7/88ldc> return with empty outString @emptyFormatString move.w #fEmptyFormatString, res(a6) ; flag empty format string movea.l outString(A6),A0 move.b #0,(A0) ; set outstring length to zero ;IF res <> ORD(formatOk) THEN Format2Str:= res; @exit compw #fFormatOK,res(A6) BEQ.S @L482 MOVE.W res(A6),returnValue1(A6) @L482: MOVEM.L (A7)+,localRegs move #argFrame1, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'FORM2STR' endp ;------------------------------------------------------------ FormStr2XFrame record {oldA61},decrement returnValue1 ds.w 1 ; INTEGER argFrameT1 EQU * source ds.l 1 ; VAR str255 myCanonical ds.l 1 ; VAR NumFormatString partsTable ds.l 1 ; VAR NumberParts xOrig ds.l 1 ; VAR EXTENDED selector1 ds.l 1 argFrame1 EQU argFrameT1-* return1 ds.l 1 oldA61 ds.l 1 possible ds.b 4 ; ARRAY[postive..negative] OF BOOLEAN isNeg ds.b 1 ; BOOLEAN doPercent ds.b 1 ; BOOLEAN going ds.b 1 ; BOOLEAN formCount ds.b 1 ; FormatClass Fsize ds.w 1 ; INTEGER temp ds.w 1 ; INTEGER Ssize ds.w 1 ; INTEGER rIndex ds.w 1 ; INTEGER sIndex ds.w 1 ; INTEGER nothing ds.w 1 ; INTEGER real ds.b 256 ; str255 saveSIndex ds.w 1 ; INTEGER saveRIndex ds.w 1 ; INTEGER saveCIndex ds.w 1 ; INTEGER pastDecimal ds.b 1 ; BOOLEAN afterEFormat ds.b 1 ; BOOLEAN <88.09.19ldc> ;-------------------------------------------------------- ; used by calls to sane package saneEnv ds.w 1 ; SANE Environment indexF ds.w 1 ; index to floating pt value returned by str2dec prefixF ds.w 1 ; valid prefix decRecF ds.b 26 ; decimal record (needs 25 bytes, see Decimal later) garbage1 ds.b 6 ; ? (not used explicitly in this file) checkFDmask ds.b 1 ; mask for CheckForDigits result ds.b 1 ; reserved localFrame1 EQU * ENDR ;============================================================ ;Procedure MatchingSubString( c: WideChar; ; var index: integer; ; ignoreCase: boolean; ; oldAHf2: address): boolean; ;============================================================ ; MatchingSubString ; ; trashes a0,d0-d2 ; uses/restores a3-a4,d3 ; calls CharComp, which trashes a0,d0-01 ; ; NOTE: UprString (called by CharComp) now depends on the a5 world, ; so don't muck around with a5 before calling CharComp! <02/21/89 pke> ; Actually, UprString is again independent of a5 world, but now we're ; using LwrString instead, which DOES depend on a5 world. <06/30/89 pke> ; ; redefined MatchingSubString to allow case insensitivity. <3/16/88ldc> MatchingSubString proc ;------------------------------------------------------------ MatchingSubStringFrame record {oldA62},decrement match ds.w 1 ; BOOLEAN argFrameT2 EQU * c ds.w 1 ; WideChar index ds.l 1 ; VAR INTEGER ignoreCase ds.w 1 ; boolean oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 localFrame2 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg d3/a3/A4 ; don't need to save a5 <02/21/89 pke> indexR EQU A3 bumpIndexR EQU d3 ff EQU A4 ;============================================================ WITH FormStr2XFrame,MatchingSubStringFrame, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L index(A6),indexR ;make use of these lazy regs MOVEA.L oldA6f2(A6),ff MOVE.W (indexR),D2 ;compute address of source[index] MOVEA.L source(ff),A0 ADDA.W D2,A0 SF match(A6) ;default with no match MOVE.W c(A6),D0 ;put c somewhere useful BEQ.S @done ;but leave if it's null compw #$FF,D0 ;if it's a double-byte character then it'll … BLS.S @singleByte ;…be greater than $FF ;set up for CharComp of two bytes compw Ssize(ff),D2 ;verify that we're not beyond the end of the string bge.s @done ; >= for 2 bytes moveq #2,bumpIndexR ;bump index by two for two byte char move.b (a0)+,d1 ;get one byte lsl.w #8, d1 ;shift it to upper half of word move.b (a0),d1 ;get the next BRA.S @doCompare @singleByte: compw Ssize(ff),D2 ;again, check overflow BGT.S @done ;note different boundary clr.w d1 move.b (a0), d1 ; moveq #1, bumpIndexR ;match will bump index by one @doCompare tst.w ignoreCase(a6) beq.s @caseSensitive clr.w -(a7) move.w d0, -(a7) move.w d1, -(a7) jsr CharComp ;if not CharComp(c, source[index]) then not.b (a7)+ ;match := false bra.s @checkResult @caseSensitive cmp.w d0, d1 ;if c <> source[index] then ;equal := false @checkResult bne.s @done ADD.W bumpIndexR,(indexR) ;else advance index by appropriate value st match(A6) ;equal := true @done MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'MATCHSUB' ENDWITH ENDP ;============================================================ ; matchingBlocks ; ; trashes a0,d0 (,d1-d2) ; uses/restores a3,a4,d7, and a2 (was a5) for buildLevel >= 2 ; calls MatchingSubString, which trashes a0,d0-d2 ; called by Cond ; matchingBlocks proc ;------------------------------------------------------------ matchingBlocksFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * c ds.l 1 ; VAR WideCharArr oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 j ds.w 1 ; INTEGER i ds.w 1 ; INTEGER garbage2 ds.b 2 ; ? localFrame2 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D7/a2-a4 ; need a5 world here <02/21/89 pke> ff EQU A3 cR EQU A4 ;============================================================ WITH FormStr2XFrame,matchingBlocksFrame, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f2(A6),ff ;outer frame pointer MOVEA.L c(A6),cR ;registerize c's address MOVE.W sIndex(ff),j(A6) ;j is a provisional pointer SF returnValue2(A6) ;assume the worse MOVE.W WideCharArr.size(cR),D7 ;loop to c.size BLT.S @out ;negative size means the array is empty LEA WideCharArr.data(cr),cR ;retrieve beginning of character array IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> ; GetSMgrCore a5 ; setup for vector call <6/17/88ldc> ; move.l sVectMatchingSubString(a5), a5 ; before entering loop GetSMgrCore a2 ; setup for vector call <02/21/89 pke> move.l sVectMatchingSubString(a2), a2 ; before entering loop ENDIF @eqLoop: CLR.W -(A7) ;return space MOVE.W (cR)+,-(A7) ;push the next character PEA j(A6) ;and our provisional index ; added boolean switch to ignore case so 'e' and 'E' are ;treated equally <3/16/88ldc> move.w #1,-(a7) ;ignoreCase := true MOVE.L ff,-(A7) ;not to mention the proper frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> ; jsr (a5) ; now a vector jsr (a2) ; now a vector <02/21/89 pke> ELSE JSR matchingSubString ENDIF MOVE.B (A7)+,D0 ;was it a match? DBEQ D7,@eqLoop ;done if not or if we ran out of chars BEQ.S @out ST returnValue2(A6) ;we matched so say so MOVE.W j(A6),sIndex(a3) ;the provisional index was real after all @out: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'MATCHBLO' ENDWITH endp ;============================================================ ; CheckForDigits ; ; trashes a0-a1,d0-d1 (,d2) ; uses/restores a2-a4,d6-d7 ; calls matchingSubString, which trashes a0,d0-d2 ; CheckForDigits proc ;------------------------------------------------------------ CheckForDigitsFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 k ds.w 1 ; INTEGER ch ds.w 1 ; CHAR matching ds.w 1 ; BOOLEAN garbage2 ds.b 8 ; ? localFrame2 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D5-D7/A2-A4 ; now need D5 (didn't need D4) <05/22/89 pke> ff EQU a4 realR EQU a2 matchingR EQU d6 kR EQU d7 partsTableR EQU a3 ;============================================================ WITH FormStr2XFrame,CheckForDigitsFrame,FormatStringPriv,NumberParts, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f2(A6),ff SF D5 ;assume the worst MOVEA.L myCanonical(ff),A1 ;we only need this once MOVEA.L partsTable(ff),partsTableR ;make use of the empty regs LEA real(ff),realR ADD.W rIndex(ff),realR ;point ourself to our current index MOVEA.L source(ff),A0 ;we only need this one once, too MOVE.W sIndex(ff),D0 ;check to see if this is a digit MOVE.B 0(A0,D0.W),D1 compb #'0',D1 BLT.S @noDigit compb #'9',D1 BGT.S @noDigit MOVE.B D1,(realR) ;but if it is a digit, move it into the current string ADDQ.W #1,rIndex(ff) ;and increment all our indexes ADDQ.W #1,sIndex(ff) ST D5 ; CMP.B #'0',D1 ; BEQ.S @doneRealZeroTest ; MOVE.B #$7F,D5 ; @doneRealZeroTest: BRA.S @out @noDigit: MOVE.B formCount(ff),D0 ;we'll give it a second chance… EXT.W D0 ;…by checking against the alternative digits ADD.W D0,D0 BTST #fIsAltNum,Flags(A1,D0.W) ;do we even allow alternate digits? BEQ.S @out ;nope, so forget it SF matchingR ;otherwise, try matching against alternates MOVE.W #9,kR ;k is the loop counter LEA AltNumTable.data(partsTableR),partsTableR ; <2-25-88med.ldc> IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> ; GetSMgrCore a5 ; setup for vector call <6/18/88ldc> ; move.l sVectMatchingSubString(a5), a5 GetSMgrCore a1 ; ok to reuse a1, can't use a5 <02/21/89 pke> move.l sVectMatchingSubString(a1), a1 ENDIF @altLoop: CLR.W -(A7) ; return space MOVE.W (partsTableR)+,-(A7) ; push the current character PEA sIndex(ff) ; and the index into the source string clr.w -(a7) ; case sensitive is cheaper MOVE.L ff,-(A7) ; oh, don't forget the silly frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> ; jsr (a5) ; call the vector jsr (a1) ; <02/21/89 pke> ELSE JSR matchingSubString ENDIF MOVE.B (A7)+,matchingR ;did we match? DBNE kR,@altLoop ;yes, fall through, or no, dbra BEQ.S @out ;just checking ;; MOVE.B #'9',(realR) ;digit:= '9'-k ;; SUB.W kR,(realR) move.l #'9',d0 ; digit := '9'-k <2-25-88med.ldc> sub.b kR,d0 ; subtract <2-25-88med.ldc> move.b d0,(realR) ; store in array <2-25-88med.ldc> ADDQ.W #1,rIndex(ff) ;update the index ST D5 ; CMP.B #'0',D0 ; BEQ.S @doneAltZeroTest ; MOVE.B #$7F,D5 ; @doneAltZeroTest: @out: MOVE.B D5,returnValue2(A6) ; MOVEM.L (A7)+,localRegs UNLK A6 MOVE.L (A7)+,(A7) RTS CheckDebug 'CHECKDIG' ENDWITH endp ;------------------------------------------------------------ ExpMatchingFrame record {oldA62},decrement returnValue2 ds.w 1 ; BOOLEAN argFrameT2 EQU * plusData ds.l 1 ; VAR WideCharArr oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 garbage2 ds.b 4 localFrame2 EQU * ENDR ;============================================================ ; Cond ; ; trashes a0,d0 (,d1-d2) ; uses/restores a2-a4,d3-d4, plus d5 for buildLevel >= 1, a5 otherwise ; calls matchingBlocks, which trashes a0,d0-d2 ; Cond proc ;------------------------------------------------------------ CondFrame record {oldA63},decrement argFrameT3 EQU * a ds.l 1 ; VAR WideCharArr b ds.l 1 ; VAR WideCharArr aSign ds.b 1 ; CHAR ALIGN 2 bSign ds.b 1 ; CHAR ALIGN 2 oldA6f3 ds.l 1 argFrame3 EQU argFrameT3-* return3 ds.l 1 oldA63 ds.l 1 localFrame3 EQU * ENDR ;============================================================ WITH FormStr2XFrame,ExpMatchingFrame,CondFrame ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D3-D5/A2-A4 ; <02/21/89 pke> fff EQU a3 ; <02/21/89 pke> ff EQU a4 realR EQU a2 abR EQU d4 signR EQU d3 LINK A6,#localFrame3 MOVEM.L localRegs,-(SP) MOVEA.L oldA6f3(A6),ff MOVE.L oldA6f2(ff),fff ;you like these nested procs too? SF returnValue2(ff) LEA real(fff),realR ;this is the real# string we're dealing with ADD.W rIndex(fff),realR ;and this is how far into it we are MOVE.B aSign(A6),signR ;and we sort of need to know its sexual preference MOVE.L a(A6),abR ;check against one version of the exponent moveq #1,d5 ;set firstTime flag <02/21/89 pke> @compare: CLR.W -(A7) ;return space MOVE.L abR,-(A7) ;push whatever we are comparing MOVE.L fff,-(A7) ;and the frame pointer JSR matchingBlocks MOVE.B (A7)+,D0 ;how'd we do? BNE.S @matched ;that's a sigh of relief tst.l d5 ; <02/21/89 pke> beq @out ; <02/21/89 pke> @take2: MOVE.B bSign(A6),signR ;try matching against the other flavor of exponent MOVE.L b(A6),abR moveq #0,d5 ;not firstTime <02/21/89 pke> BRA.S @compare @matched: MOVE.B #'E',(realR)+ ;the canonical 'E' MOVE.B signR,(realR) ;and whatever sign we need ADDQ.W #2,rIndex(fff) ;update the index ST returnValue2(ff) ;and brag about the results @out: MOVEM.L (A7)+,localRegs move #argFrame3, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'COND ' ENDWITH endp ;============================================================ ; ExpMatching ; ; trashes a0,a1,d0 ; uses/restores a3,a4 ; calls Cond, which trashes a0,d0-d2 ; ExpMatching func ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg A3/A4 ff EQU a3 partsTableR EQU a4 ;============================================================ WITH FormStr2XFrame,ExpMatchingFrame,NumberParts,FormatStringPriv, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f2(A6),ff MOVEA.L partsTable(ff),partsTableR ;WITH partsTable LEA PeMinus(partsTableR),A1 IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore partsTableR ;recycle a4 & setup for vector call move.l sVectCond(partsTableR), partsTableR ; <6/21/88ldc> ENDIF MOVEA.L plusData(A6),A0 ;Check which of E+ and E- is larger… MOVE.W WideCharArr.size(A0),D0 ;…it's important because one could be a substring of the other compw WideCharArr.size(A1),D0 BLT.S @bigEMinus MOVE.L A0,-(A7) MOVE.L A1,-(A7) MOVE.L #((('-')<<16)+'+'),-(A7) ;push + then - MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (partsTableR) ; call vect <6/17/88ldc> ELSE JSR Cond ;try matching against exponents ENDIF BRA.S @out @bigEMinus: MOVE.L A1,-(A7) MOVE.L A0,-(A7) MOVE.L #((('+')<<16)+'-'),-(A7) ;push - then + MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (partsTableR) ; call vect <6/17/88ldc> ELSE JSR Cond ENDIF @out: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'EXPMATCH' ENDWITH endp ;============================================================ ; xFormStr2X ; ; trashes a0-a1,d0-d2 ; uses/restores a2-a4,d3-d7 ; calls MatchingSubString trashes a0,d0-d2 ; CheckForDigits trashes a0-a1,d0-d2 ; ExpMatching trashes a0,a1,d0 ; CharComp here trashes a0,d0-d1 ; NextFormatClass changes d0 ; _CharByte (may trash a0-a1,d0-d2) ; FPSTR2DEC (_PACK7) ; FDEC2X (_FP68K) ; FDIVX (_FP68K) ; ; NOTE: UprString (called by CharComp) now depends on the a5 world, ; so don't muck around with a5 before calling CharComp! <02/21/89 pke> ; Actually, UprString is again independent of a5 world, but now we're ; using LwrString instead, which DOES depend on a5 world. <06/30/89 pke> ; xFormStr2X proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D3-D7/A2-A5 ; a5 not used, change to not save <02/21/89 pke> myCanonicalR EQU a3 partsTableR EQU a4 formCountR EQU a2 cIndexR EQU d7 tempR EQU d6 goingR EQU d5 cR EQU d4 saveCIndexR EQU d3 ;============================================================ WITH FormStr2XFrame,FormatStringPriv,NumberParts, SMgrRecord LINK A6,#localFrame1 MOVEM.L localRegs,-(A7) SF doPercent(A6) ;do a bunch of initializations MOVEA.L source(A6),A0 ;move the source length into local space CLR.W D0 MOVE.B (A0),D0 MOVE.W D0,Ssize(A6) MOVE.B #'1',(real+1)(A6) ;assume '1' as a default in case there are no digits on input MOVEA.L myCanonical(A6),myCanonicalR ; test for empty format string <9/7/88ldc> MOVEA.L partsTable(A6),partsTableR LEA formCount(A6),formCountR CLR.W D0 ;move the length of the form string into local space MOVE.B formString(myCanonicalR),D0 MOVE.W D0,Fsize(A6) SF goingR ; needs initialization <9/7/88ldc> SF possible+fNegative(A6) ;more obvious initializations SF possible+fZero(A6) ST possible+fPositive(A6) MOVE.W #fPositive,(formCountR) BTST.B #fExists,(flags+2*fPositive)(myCanonicalR) BEQ @bestGuess ; replaced #1 with fFormatOK <2/23/88:ldc> MOVE.W #fFormatOK, returnValue1(A6) MOVEQ #1,D0 MOVE.W D0,sIndex(A6) MOVE.L D0,cIndexR MOVE.W D0,rIndex(A6) SF pastDecimal(a6) ST checkFDmask(A6) ;any digit is OK CLR.W saveCIndexR ;saveCIndex is for backtracking when we have optional digits MOVE.W (((tokMinusSign-tokLeftQuote)*2)+data)(partsTableR),D0 BSR @matchSS ;check if the very first character is a minus sign MOVE.B D0,isNeg(A6) ;and if it is, say so move.w FSize(a6), d0 ; get format string size <9/7/88ldc> beq @emptyFormatString ; best guess compw d0,cIndexR ;make sure we've got something in the format string SLE goingR MOVE.W sIndex(A6),D1 ;and also in the source string compw Ssize(A6),D1 SLE D1 AND.B D1,goingR @whileGoing: MOVE.B goingR,D0 BEQ @doneGoing CLR.W cR MOVE.B formString(myCanonicalR,cIndexR.W),cR ;update c to next format symbol compw #(tokMaxSymbols+1),cR ;upper limit of control codes BGE @noJump MOVE.W cR,D0 SUBQ.W #tokLeader,D0 ;upper limit of jump table BMI @endJump compw #(tokEMinus-tokLeader),D0 BGT @endJump ADD.W D0,D0 MOVE.W @jTab(D0.W),D0 JMP *+2(D0.W) @jTab: DC.W @leads-@jTab+2, @nonLeads-@jTab+2, @leads-@jTab+2 DC.W @others-@jTab+2, @others-@jTab+2, @others-@jTab+2 DC.W @others-@jTab+2, @empty-@jTab+2, @empty-@jTab+2 DC.W @empty-@jTab+2, @decPoint-@jTab+2, @ePlus-@jTab+2 DC.W @eMinus-@jTab+2 @leads: BSR @checkFD ;check for digit BNE.S @leadMatch ;sure enough got one MOVE.W cR,D0 ;if we didn't get one then check for the lead character ADD.W D0,D0 MOVE.W -(tokLeftQuote*2)+data(partsTableR,D0.W),D0 BSR.S @matchSS BEQ @notThisForm ;if we didn't get one then we just aren't a match @leadMatch: BRA @mergeJump @nonLeads: TST.W saveCIndexR ;if this is the first of a string of nonLeads, BNE.S @noReset ;then we need to fill the state holders. MOVE.W cIndexR,saveCIndexR ;these variables allow handling optional digits MOVE.W rIndex(A6),saveRIndex(A6) MOVE.W sIndex(A6),saveSIndex(A6) @noReset: BSR.S @checkFD ;check for a digit BEQ @notThisForm ;if we didn't get one then we just aren't a match BRA @mergeJump ;and finish @decPoint: ST pastDecimal(a6) ;pastDecimal is necessary info when handling optional digits CLR.W saveCIndexR ;start anew on the optional digit state ; added data offset <3/14/88ldc> MOVE.W (((tokDecPoint-tokLeftQuote)*2)+data)(partsTableR),D0 BSR.S @matchSS ;match against a decimal point BEQ @notThisForm ;(or at least try, that is) MOVE.W rIndex(A6),D0 ;insert a decimal point into the real# string LEA real(A6),A0 MOVE.B #'.',0(A0,D0.W) ADDQ.W #1,rIndex(A6) ;update the real# string index BRA.S @endJump @others: MOVE.W cR,D0 ;try matching source string against format string ADD.W D0,D0 MOVE.W -(tokLeftQuote*2)+data(partsTableR,D0.W),D0 BSR.S @matchSS BEQ.S @notThisForm ;failure if no match BRA @mergeJump @ePlus: LEA PePlus(partsTableR),A0 BSR.S @expM ;match against ePlus BEQ.S @notThisForm ;failure if no match ; changed branch from @mergeJump to @mergeExp <1/23/88drs> BRA.S @mergeExp @eMinus: LEA PeMinusPlus(partsTableR),A0 JSR @expM ;match against eMinusPlus BEQ.S @notThisForm ; inserted @mergeExp and following two lines to correct bug. <1/23/88drs> ;After the exponent is reached, the parsing algorithm should treat ;exponent digits as if they were pre-decimal significand. @mergeExp: MOVEQ #0,SaveCIndexR ;reset saveCIndex CLR.B pastDecimal(A6) ST checkFDmask(A6) ;any digit is OK as exponent @endJump: @empty: BRA.S @mergeJump @matchSS: ;standard module for calling matchingSubString CLR.W -(A7) ;room for return parameter MOVE.W D0,-(A7) ;register based parameter to matchSS PEA sIndex(A6) ;position into the source clr.w -(a7) ;case sensitive is cheaper MOVE.L A6,-(A7) ;the ubiquitous frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; set up for vector call <6/18/88ldc> move.l sVectMatchingSubString(a0), a0 jsr (a0) ; call it <6/18/88ldc> ELSE JSR matchingSubString ENDIF MOVE.B (A7)+,D0 ;result is passed back in D0 (and SR) RTS @checkFD: CLR.W -(A7) ;common call to CheckForDigits MOVE.L A6,-(A7) ;no parameters; only frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; setup for vector call move.l sVectCheckForDigits(a0), a0 ; call vect <6/17/88ldc> jsr (a0) ELSE JSR CheckForDigits ; This was commented out; shouldn't be. ; fixed <1/31/89 pke> ENDIF MOVE.B (A7)+,D0 AND.B checkFDmask(A6),D0 RTS ;result in D0 (and SR) ;------------------------------------------------------------------------------------ @expM: CLR.W -(A7) ;common call to expMatching MOVE.L A0,-(A7) ;which exponent is passed here in A0 MOVE.L A6,-(A7) ;frame pointer again IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; intlSpec for vector move.l sVectExpMatching(a0), a0 ; call vector <6/17/88ldc> jsr (a0) ; <6/21/88ldc> ELSE JSR ExpMatching ENDIF MOVE.B (A7)+,D0 ;result in D0 (and SR) RTS ;------------------------------------------------------------------------------------ @notThisForm: ;common entry for failed match: MOVE.B (FormCountR),D0 ;tentatively declare that the source doesn't match format EXT.W D0 CLR.B possible(A6,D0.W) ;possible[formCount] := FALSE; BRA.S @mergeJump @noJump: ;check source text against form string ; convert form string and c to upper case before comparison <3/15/88ldc> ; clr.w -(a7) move.w cR, -(a7) movea.l source(A6),A0 adda.w sIndex(a6),A0 move.b (a0), d0 move.w d0, -(a7) jsr CharComp ;if not CharComp(source[sIndex], c) then tst.b (a7)+ beq.S @notThisForm ;possible[formCount] := FALSE ADDQ.W #1,sIndex(A6) ;otherwise increment source pointer @mergeJump: MOVE.B (FormCountR),D0;the beginning of the next format in the format string… JSR NextFormatClass ;…is important enough to dedicate a register to ADD.W D0,D0 MOVE.W startLocs(myCanonicalR,D0.W),tempR MOVE.B (FormCountR),D1 ;we'll need formcount in a moment EXT.W D1 ;as an integer, that is MOVE.W sIndex(A6),D0 ;if we've ran out of source but not format string… compw Ssize(A6),D0 ;…then potentially we don't match BLE.S @stillMatch MOVE.W tempR,D0 SUBQ.W #1,D0 compw cIndexR,D0 BLE.S @stillMatch SF possible(A6,D1.W) ;the format string was indeed too long @stillMatch: TST.B possible(A6,D1.W) ;now check if we provisionally don't match BNE @mergeMatch ; Changed testing sequence slightly. <1/23/88drs> ;We need to drop into this code section whenever pastDecimal also. TST.B pastDecimal(a6) ;this gets into complex checks about whether… BNE.S @mergeDecCheck ;…we really match or not after provisionally failing TST.W saveCIndexR ;if saveCIndex is zero then there were no optional… BNE.S @notPastDecimal ;…digits, and we definitely don't match BRA @mergeMatch ;final decision of no match @mergeDecCheck: MOVE.W tempR,saveCIndexR ;push saveCIndex to end of format string for now clr.b afterEFormat(a6) ; assume before the exponetial format <88.09.19ldc> @pdLoop: ;this loop forgives material between optional digits compw tempR,cIndexR ;make sure we're not beyond end of format string BGE.S @setTrue ;and if we are, then we actually did match MOVE.W cIndexR,D1 ;see if the next format string code is a nonLeader ADDQ.W #1,D1 CMP.B #tokNonLeader,formString(myCanonicalR,cIndexR.W) BNE.S @testEFormat ;ignore if not, but first check for EFormat <88.09.19ldc> ; added 3 lines to fix bug. <1/23/88drs> ;If pastDecimal then the only time it doesn't match is when there is ;something after the last nonLeader MOVE.B (FormCountR),D0 ;go ahead and decide that a match is still possible EXT.W D0 ST possible(A6,D0.W) ; added following to allow acceptance of 3.0E+0 with #.##E+# format <88.09.19ldc> tst.b afterEFormat(a6) ; skip non-leads after the EFormat bne.s @mergePdLoop MOVE.W D1,saveCIndexR ;and set save index to this nonLeader BRA.s @mergePdLoop ; <88.09.19ldc> ; are we past the exponential form? Need this test to accept 3.0E+0 with #.##E+# format. <88.09.19ldc> @testEFormat cmp.b #tokEPlus, formString(myCanonicalR,cIndexR.W) ; <88.09.19ldc> beq.s @setAfterE ; <88.09.19ldc> cmp.b #tokEMinus, formString(myCanonicalR,cIndexR.W) ; <88.09.19ldc> bne.s @mergePdLoop ; <88.09.19ldc> @setAfterE st afterEFormat(a6) ; <88.09.19ldc> ST checkFDmask(A6) ;any digit is OK after exp <05/22/89 pke> @mergePdLoop: MOVE.W D1,cIndexR ;advance the format string index BRA.S @pdLoop @notPastDecimal: ADDQ.W #1,saveCIndexR ;gobble up all but leaders, exps, decPoints, pos/neg compw tempR,saveCIndexR ;but make sure we've not reached next format BGE.S @setTrue ;if we have, then we match MOVE.B formString(myCanonicalR,saveCIndexR.W),D0 CMP.B #tokMaxSymbols,D0 ;check for ascii character… BGT.S @notPastDecimal ;…and continue looping if it is one MOVE.L #((((((((1< MOVE.B #$80,checkFDmask(A6) ;for digits, accept only 0 until exponent BRA.S @doneSpecialSetup ; @nonZeroSetup: ; MOVE.B #'1',(real+1)(A6) ; ST checkFDmask(A6) ; @doneSpecialSetup: MOVE.B #'1',(real+1)(A6) ;default value SF pastDecimal(a6) CLR.W saveCIndexR MOVE.B D2,possible(A6,D1.W) MOVE.W D2,sIndex(A6) MOVE.W startLocs(myCanonicalR,D0.W),cIndexR MOVE.W D2,rIndex(A6) BRA.S @mergeMTest @noNext: CLR.B goingR @mergeMTest: compw Fsize(A6),cIndexR SLE D0 MOVE.W sIndex(A6),D1 compw Ssize(A6),D1 SLE D1 AND.B D1,D0 AND.B D0,goingR BRA @whileGoing @doneGoing: MOVE.B (FormCountR),D0 EXT.W D0 MOVE.B possible(A6,D0.W),D1 ;the eternal question: did we match? BEQ.S @bestGuess ;no, so try free-form input ADD.W D0,D0 ;yes, so see if we have a percentage to deal with BTST #fIsPercent,flags(myCanonicalR,D0.W) SNE D0 MOVE.B D0,doPercent(A6) ;and set the flag if we do BRA @toReal ;go on to convert to real @bestGuess: ;xxx<2/24/88:ldc> ; at this point we go back through the source and make a best guess ;FormatStr2X := bestGuess. MOVE.W #fBestGuess, returnValue1(A6) @freeForm sf doPercent(a6) ; <9/22/88ldc> sf isNeg(a6) ; <9/22/88ldc> SF pastDecimal(a6) ; <9/20/88ldc> ST checkFDmask(A6) ;any digit is OK now <05/22/89 pke> MOVE.W #fPositive,(FormCountR) ;assume positive MOVE.W #1,sIndex(A6) ;reset the vitals MOVE.W #1,rIndex(A6) @freeFormLoop: @whileFF: MOVE.W sIndex(A6),D0 ;have we run out of source? compw Ssize(A6),D0 BGT @exitFreeForm BSR @checkFD ; if it's not a digit, then just what is it BNE @endFreeFormLoop ; was digit so loop to get the next char CLR.W tempR ; not digit see which syntactical entity it matches ; loop through the parts table, index to each component in tempR @pTabLoop: ADDQ.W #1,tempR compw #tokDecPoint,tempR ;if it's beyond decimal point, go to case BGT.S @ffCase MOVE.W tempR,D1 ;otherwise check against syntactical entry ADD.W D1,D1 ; added data offset <3/14/88ldc> MOVE.W (-(tokLeftQuote*2)+data)(partsTableR,D1.W),D0 BSR @matchSS BEQ.S @pTabLoop ;if there's no match then ignore it @ffCase: ;jump table MOVE.W tempR,D0 SUBQ.W #tokPercent,D0 BEQ.S @isPercent SUBQ.W #(tokMinusSign-tokPercent),D0 BEQ.S @isMinus SUBQ.W #(tokDecPoint-tokMinusSign),D0 BEQ.S @isDecPoint SUBQ.W #1,D0 ; check fIsDecPoint-1 BEQ.S @isPastDecPoint BRA @endFreeFormLoop ; ain't nothing @isDecPoint: ; check for multiple decimals <9/20/88ldc> tst.b pastDecimal(a6) ; have we already seen a decimal? <9/20/88ldc> bne @setExtraDecimal ; yes, note error and exit <9/20/88ldc> st pastDecimal(a6) MOVE.W rIndex(A6),D0 ;tack on a decimal point LEA real(A6),A0 MOVE.B #'.',0(A0,D0.W) ADDQ.W #1,rIndex(A6) BRA @endFreeFormLoop @isMinus: tst.b isNeg(a6) ; have we already seen a minus? <9/20/88ldc> bne @setSpuriousChars ; yes, note error and exit <9/20/88ldc> st isNeg(a6) ; else, just note that we have seen one ; Note that the convention used in the format scanner above is that negative is ; indicated if either isNeg is set (when '-' is seen in positive fmt) or formCount ; is fNegative;'-' is never added into the real number string. Change to use same ; convention here. <05/22/89 pke> BRA.S @endFreeFormLoop @isPercent: tst.b doPercent(a6) ; only allow one percent symbol <9/22/88ldc> IF forRom THEN bne.s @setExtraPercent ELSE bne @setExtraPercent ENDIF st doPercent(A6) BRA.S @endFreeFormLoop @isPastDecPoint: LEA PePlus(partsTableR),A0 BSR @expM ;check on E+ BNE.S @endFreeFormLoop ;it was E+ LEA PeMinusPlus(partsTableR),A0 JSR @expM ;check on E- BNE.S @endFreeFormLoop ;it was E- ; <9/21/88ldc>flag spurious chars (e.g., "1x2") per bug #30677 ; first compare it against the unquoted characters, may be two byte clr.w -(a7) ; room for result move.l source(a6), -(a7) ; source string and move.w sIndex(a6), -(a7) ; source index _CharByte ; for charbyte movea.l source(a6), a0 ; get source move.w sIndex(a6), d0 ; get index adda.w d0, a0 ; current offset move.b (a0)+, d0 ; get the first byte tst.w (a7)+ ; one or two byte? beq.s @singleByte ; one, so don't need to get next byte lsl.w #8, d0 ; move into upper byte move.b (a0)+, d0 ; lower byte of 2 byte char @singleByte LEA ((tokMaxSymbols-1)*2)(partsTableR),a0 ; unquoteds table in a0 MOVEQ #(tokEMinus-1),d1 ; loop counter ; <9/21/88ldc> loop through the unquoted characters in the number parts table @unquotedLoop: compw -(a0), d0 ; check against source table chars dbeq d1, @unquotedLoop ; stop if we match bne.s @setSpuriousChars ; this character not found in unquoted table @bumpSourceString: ADDQ.W #1,sIndex(A6) ;use CharByte to check for 2 byte char CLR.W -(A7) MOVE.L source(A6),D0 ADDQ #1,D0 MOVE.L D0,-(A7) MOVE.W sIndex(A6),D0 ;<1/23/88drs> Changed 1 line to fix bug ;Was subtracting 2 instead of 1 SUBQ.W #1,D0 MOVE.W D0,-(A7) _CharByte TST.W (A7)+ ;<1/23/88drs> Changed 1 line to fix bug ;Was doing BLT.S instead of BGT.S BGT.S @bumpSourceString ;get lower byte of two byte character @endFreeFormLoop: BRA @freeFormLoop ;<9/20/88ldc> flag errors @emptyFormatString MOVE.W #fEmptyFormatString, returnValue1(A6) bra.s @toReal @setExtraPercent move.w #fExtraPercent, returnValue1(a6) bra.s @toReal @setExtraDecimal move.w #fExtraDecimal, returnValue1(a6) bra.s @toReal @setSpuriousChars move.w #fSpuriousChars, returnValue1(a6) @toReal: @exitFreeForm: MOVE.W rIndex(A6),D0 ;set length of real# string SUBQ.W #1,D0 BNE.S @rMerge MOVEQ #1,D0 ;successfully matched literal string guaranteed to ;contain at least one digit: 1, -1, or 0 ;<1/28/88drs> need check to see if we got anything useful from the source stirng at all ;<4/14/88ldc> added test for empty source tst.w Ssize(A6) ;make sure we don't have an empty source string beq.s @isNAN ;<3/31/88ldc> changed d0 to d1 to prevent trashing of #1 in d0 MOVE.B (FormCountR),D1 ;check if we had a match EXT.W D1 TST.B possible(A6,D1.W) ;if no match and no digits, declare error ;<4/14/88ldc> changed branch target to @isNAN BEQ.S @isNAN ; BNE.S @rMerge ; MOVE.W #fSpuriousChars, returnValue1(A6) @rMerge: MOVE.B D0, real(A6) compb #fZero,(FormCountR) ;if formCount was zero then clear out x BNE.S @isNonZero MOVEA.L xOrig(A6),A0 CLR.L (A0)+ CLR.L (A0)+ CLR.W (A0) BRA @zzMerge ;<4/14/88ldc> added @isNAN + 2 lines @isNAN: pea #'nan(17)' bra.s @setupStr2Dec @isNonZero: ;<4/14/88ldc> moved the following line to here from below PEA real(A6) ; use the real string address ;<4/14/88ldc> added setupStr2Dec @setupStr2Dec: MOVE.W #1,indexF(A6) ; initial index into string ; PEA real(A6) ; use the real string address PEA indexF(A6) ; index address PEA decRecF(A6) ; decimal record address PEA prefixF(A6) ; valid prefix address FPSTR2DEC ; convert to extended PEA decRecF(A6) ; decimal record address MOVE.L xOrig(A6),-(SP) ; x address FDEC2X ;<9/8/88ldc> use SANE to determine nan (cf bug #30678) ; result in d0 move.l xOrig(a6), a1 bsr GetSANEClass cmp.w #posQNAN, d0 beq.s @returnNAN cmp.w #negQNAN, d0 beq.s @returnNAN cmp.w #posSNAN, d0 beq.s @returnNAN cmp.w #negSNAN, d0 beq.s @returnNAN cmp.w #posInf, d0 beq.s @returnOverflow cmp.w #negInf, d0 beq.s @returnOverflow MOVE.B doPercent(A6),D0 ;check if we need a percentage computation BEQ.S @pMerge PEA @hundredC MOVE.L xOrig(A6),-(SP) FDIVX ;divide by 100 @pMerge: compb #fNegative,(FormCountR) ;if we picked up a negative somewhere… BEQ.S @doNeg ;…then negate it TST.B isNeg(A6) ;this is an informal negative BEQ.S @zzMerge @doNeg: MOVEA.L xOrig(A6),A0 TST.L (A0) BEQ.S @zzMerge ;don't negate a zero EORI.B #$80,(A0) bra.s @zzMerge ;<9/8/88ldc> @returnNAN MOVE.W #fFormStrIsNAN, returnValue1(A6) ; <9/8/88ldc> bra.s @zzMerge @returnOverflow move.w #fFormatOverflow, returnValue1(a6) ; <9/8/88ldc> @zzMerge: MOVEM.L (A7)+,localRegs move #argFrame1, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'FORMSTR2' @hundredC: DC.W $4005, $C800, $0000, $0000, $0000 ENDWITH endp maxStringLen EQU 50 ;internal strings ;------------------------------------------------------------ decForm record 0,increment style ds.w 1 ; INTEGER digits ds.w 1 ; INTEGER ENDR ;------------------------------------------------------------ Decimal record 0,increment sgn ds.w 1 ; 0..1 exp ds.w 1 ; INTEGER sig ds.b 21 ; STRING[20] ENDR maxSANEsig EQU 20 ; max length of sig <05/22/89 pke> ;------------------------------------------------------------ FormX2StrFrame record {oldA61},decrement returnValue1 ds.w 1 ; INTEGER argFrameT1 EQU * xOrig ds.l 1 ; VAR EXTENDED myCanonical ds.l 1 ; VAR NumFormatString partsTable ds.l 1 ; VAR NumberParts out ds.l 1 ; VAR str255 selector1 ds.l 1 argFrame1 EQU argFrameT1-* return1 ds.l 1 oldA61 ds.l 1 x ds.w 5 ; EXTENDED formCount ds.b 1 ; FormatClass negExp ds.b 1 ; BOOLEAN doNegative ds.b 1 ; BOOLEAN ALIGN 2 exp ds.b maxStringLen ; string postDec ds.b maxStringLen ; string preDec ds.b maxStringLen ; string expFinal ds.b maxStringLen ; string postDecFinal ds.b maxStringLen ; string preDecFinal ds.b maxStringLen ; string formStart ds.w 1 ; INTEGER destPos ds.w 1 ; INTEGER formPos ds.w 1 ; INTEGER digCnt ds.w 1 ; INTEGER ;<3/30/88ldc> count the number of literal characters we have seen in the format string litCnt ds.w 1 ; INTEGER mantissa ds.b 1 ; BOOLEAN oversized ds.b 1 ; BOOLEAN res ds.w 1 ; INTEGER expEnd ds.w 1 ; INTEGER Nflags ds.w 1 ; BitPack penLastLead ds.w 1 ; INTEGER lastLead ds.w 1 ; INTEGER startCut ds.w 1 ; INTEGER lastSig ds.w 1 ; INTEGER hold ds.w 1 ; INTEGER ch ds.w 1 ; CHAR while1 ds.w 1 ; INTEGER tempInt ds.w 1 ; INTEGER <9/7/88ldc> localFrame1 EQU * ENDR ;------------------------------------------------------------ ConvertToStringFrame record {oldA62},decrement argFrameT2 EQU * xOrig ds.l 1 ; VAR EXTENDED doExp ds.w 1 ; BOOLEAN preDig ds.w 1 ; INTEGER postDig ds.w 1 ; INTEGER oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 formatRecord ds decForm y ds Decimal j ds.w 1 ; INTEGER i ds.w 1 ; INTEGER localFrame2 EQU * ENDR ;============================================================ ; Num2Dec ; ; changes (whatever is changed by FX2DEC - could be a0-a1,d0-d2) ; calls FX2DEC (_FP68K) ; Num2Dec proc ;============================================================ WITH FormX2StrFrame,ConvertToStringFrame PEA formatRecord(A6) MOVE.L xOrig(A6),-(SP) PEA y(A6) FX2DEC RTS ENDWITH endp ;============================================================ ; Int2String ; ; changes a0-a1,d0-d1 ; uses/restores -- ; calls -- ; Int2String proc ; Convert the postive integer in D0 to a string at a0 ; i:= 1; str:= '0'; ; WHILE D0 <> 0 DO BEGIN str[i]:= (x MOD 10) + '0'; x:= x DIV 10; END; ; str[0]:= i; EXT.L D0 MOVE.L A0,A1 MOVE.B #1,(A0)+ MOVE.L A0,D1 @L1 DIVU #10,D0 SWAP D0 ADD.B #'0',D0 MOVE.B D0,(A0)+ SWAP D0 EXT.L D0 BNE.S @L1 SUB.L A0,D1 NEG.W D1 MOVE.B D1,(A1) RTS endp ;============================================================ ; ConvertToString ; ; trashes a0-a1,d0-d1 (d2) ; uses/restores a2-a4,d4-d7 ; calls Num2Dec (may change a0-a1,d0-d2) ; Int2String changes a0-a1,d0-d1 ; ConvertToString proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D4-D7/A2-A4 postDigR EQU d6 ; number of digits after dec point preDigR EQU d4 ; number of digits before dec pt ff EQU a4 ; old a6 value FormX2StrFrame yExpR EQU a2 fixedDecimal EQU 1 ;============================================================ WITH FormX2StrFrame,ConvertToStringFrame LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVE.W postDig(A6),postDigR ;load up the registers MOVE.W preDig(A6),preDigR MOVEA.L oldA6f2(A6),ff MOVE.B postDigR,postDec(ff) ;initialize the preDec,postDec string lengths MOVE.B preDigR,preDec(ff) MOVE.W postDigR,lastSig(ff) ;lastSig is the position of the last significant digit MOVE.B doExp(A6),D0 ;check for exponent BEQ @noExp ;…no exponent LEA y.exp(A6),yExpR ;this is frequently enough used to warrant a register CLR.B formatRecord.style(A6) ;= floatDecimal style MOVE.W preDigR,D0 ;total digits is simply pre & post decimal counts ADD.W postDigR,D0 MOVE.W D0,formatRecord.digits(A6) JSR Num2Dec ;convert x to decimal string ; for 0, exp is undefined and sig = '0' (i.e., only one digit char). (See Apple ; Numerics Manual, 2nd ed., p. 28). So, the normal code for adjusting exp and ; setting the preDec and postDec strings doesn't work (BRC #39590) CMPI.B #'0',y.sig+1(A6) ;DecRec=0 if sig[1]='0' (Numerics Manual p.28) BNE.S @fixForZeroDone ;if DecRec=0, set exp, preDec, postDec appropriately MOVE.B #'0',D0 ;we'll be setting preDec/postDec with '0' LEA (preDec+1)(ff),A0 ;address of preDec string… MOVE.W preDigR,D7 ;D7 is the number of digits to transfer SUBQ.W #1,D7 ; BLT.S @fixForZeroPreDone ; @fixForZeroPre: ; MOVE.B D0,(A0)+ ;put correct # of '0's into preDec string DBRA D7,@fixForZeroPre ; @fixForZeroPreDone: ; LEA (postDec+1)(ff),A0 ;address of preDec string… MOVE.W postDigR,D7 ;D7 is the number of digits to transfer SUBQ.W #1,D7 ;courtesy DBRA BLT.S @fixForZeroPostDone ;the zero case @fixForZeroPost: ; MOVE.B D0,(A0)+ ;put correct # of '0's into postDec string DBRA D7,@fixForZeroPost ; @fixForZeroPostDone: ; CLR.W (yExpR) ;now set exp to 0 CLR.B negExp(ff) ;indicate not a negative exp BRA.S @pastPostDec ; @fixForZeroDone: ; MOVEQ #0,D1 ;default: no negative exponent MOVE.W (yExpR),D0 ;check if the exponent will be negative ADD.W postDigR,D0 ;yExp:= yExp + postDig BPL.S @noNegate ;negExp:= yExp + postDig < 0 NEG.W D0 ;yExp:= ABS(yExp); ST D1 ;negExp:= TRUE @noNegate: MOVE.B D1,negExp(ff) ;set the flag MOVE.W D0,(yExpR) ;give yExpR its final value LEA (preDec+1)(ff),A0 ;load preDec with the digits from y's significand, LEA y.Sig+1(A6,preDigR.W),A1 ;…but do it in reverse order:A1 is the decimal point position MOVE.L A1,A3 ;A3 will be our local counter MOVE.W preDigR,D7 ;D7 is the number of digits to transfer SUBQ.W #1,D7 ;courtesy DBRA BLT.S @preDecDone ;the zero case @preDecLoop: MOVE.B -(A3),(A0)+ ;load 'em up DBRA D7,@preDecLoop @preDecDone: LEA (postDec+1)(ff),A0 ;now do the same for postDec MOVE.W postDigR,D7 ;again D7 is the number of digits to transfer SUBQ.W #1,D7 BLT.S @pastPostDec @postDecLoop: MOVE.B (A1)+,(A0)+ ;this time, don't reverse the order DBRA D7,@postDecLoop @pastPostDec: MOVE.W (yExpR),D0 ;now convert the exponent to an integer string LEA exp(ff),A0 JSR Int2String BRA.S @donePreDec @noExp: SF negExp(ff) ;when there's no exponent, I guess it's not negative CLR.B exp(ff) ;needs some size MOVE.B #fixedDecimal,formatRecord.style(A6) ;set up style and digit count MOVE.W postDigR,formatRecord.digits(A6) ;fixed style only wants to know… ;Num2Dec(formatRecord, x, y); ;result is in y(A6) JSR Num2Dec ;…how many digits after the decimal point LEA (postDec+1)(ff),A0 ;@postDec[1] CLR.W D0 ; j := ORD(y.sig[0])-postDig+1; LEA y.sig(A6),A3 ;we may not have enough digits to fill the request, MOVE.B (A3)+,D0 ;and here's how we find out. MOVE.W postDigR,D7 ;first see how many is requested SUBQ.W #1,D7 ;if none, then… BLT.S @donePost ;…fine, forget it SUB.W postDigR,D0 ;then see if Num2Dec met the request BGE.S @canCopy ;yes, it did ;FOR i := 1 to postDig DO BEGIN ; IF j <= 0 THEN BEGIN ; postDec[i] := '0'; ; postDig := postDig - 1; ; END ELSE BEGIN ; postDec[i] := y.sig[j]; ; END; ; j := j+1; ;END @makeZeroes: ;no, so fill with zeroes MOVE.B #'0',(A0)+ SUBQ.W #1,postDigR ;these zeroes weren't originally taken into account… ADDQ.W #1,D0 ;…when making preDig computation so we have to dec postDig DBGE D7,@makeZeroes ;fill until D0 has made up the deficit SUBQ.W #1,D7 ;decrement because the DBGE didn't the last time @canCopy: ;and go for the real digits ADDA.W D0,A3 ;this is the position into the decimal string @copyPost: MOVE.B (A3)+,(A0)+ DBRA D7,@copyPost ;IF preDig <> 0 THEN BEGIN ; j := ORD (y.sig[0])-postDig; ; preDec[0] := CHR[j]; ; FOR i := 1 TO j DO ; preDec[i] := y.sig[j-i+1]; ;END; @donePost: ;; TST.W preDigR ;now check if we need pre-decimal digits <2/25/88med/ldc> ;; BEQ.S @donePreDec ;not today <2/25/88med/ldc> LEA y.sig(A6),A3 ;put A3 to work MOVEQ #0,D5 ;clear out D5 MOVE.B (A3)+,D5 ;and find out how many digits in significand SUB.W postDigR,D5 ;postDigR reflects how many we've used up ADDA.W D5,A3 ;move A3 beyond that point to copy backwards LEA preDec(ff),A0 ;A0 was idle also MOVE.B D5,(A0)+ ;so give it a length SUBQ.W #1,D5 ;and accommodate DBRA BLT.S @noPreDec @preDecLoop1: MOVE.B -(A3),(A0)+ ;copy reverse DBRA D5,@preDecLoop1 ;IF postDec[lastSig] = '0' THEN BEGIN ; REPEAT ; lastSig := lastSig-1; ; UNTIL (lastSig = 1) OR (postDec[lastSig] <> '0'); ;END @noPreDec: @donePreDec: MOVE.W lastSig(ff),D0 ;now knock off trailing zeroes we don't need SUB.W #((-postDec)-1),D0 ;find the end of the postDec string we made LEA (ff,D0.W),A0 ;and point A0 past it for predecrement @eatZeroes: CMP.B #'0',-(A0) ;is it a trailing zero? BNE.S @LOUT ;no; we're done ;<2/25/88drs> Added two lines because we need to preserve one zero beyond the decimal point. CMP.W #1,lastSig(ff) BEQ.S @LOUT SUBQ.W #1,lastSig(ff) ;otherwise, eat it and smile ;<2/25/88drs> Changed this line to branch always instead of checking for zero. The check is now for one BRA.S @eatZeroes ;someday we have to run out of digits @LOUT: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'CONVERTT' ENDWITH endp ;------------------------------------------------------------ AppendSymbolFrame record {oldA62},decrement argFrameT2 EQU * c ds.w 1 ; CHAR source ds.l 1 ; VAR str255 dest ds.l 1 ; VAR str255 DoSendChar ds.l 2 ; FUNCTION(x:WideChar;VAR y:str255;VAR z:INTEGER):INTEGER oldA6f2 ds.l 1 argFrame2 EQU argFrameT2-* return2 ds.l 1 oldA62 ds.l 1 res ds.w 1 ; INTEGER holdMyCanonical ds.l 1 localFrame2 EQU * ENDR ;============================================================ ; ExpHandling ; ; trashes a0,d0 (a1, d1-d2) ; uses/restores a2-a4,d5-d7 ; calls SendChar here trashes a0-a1,d0-d2 ; ExpHandling proc ;------------------------------------------------------------ ExpHandlingFrame record {oldA63},decrement argFrameT3 EQU * plusData ds.l 1 ; VAR WideCharArr oldA6f3 ds.l 1 argFrame3 EQU argFrameT3-* return3 ds.l 1 oldA63 ds.l 1 i ds.w 1 ; INTEGER k ds.w 1 ; INTEGER temp ds.l 1 ; ^WideCharArr localFrame3 EQU * ENDR ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D5-D7/A2-A4 af EQU a2 ff EQU a4 destR EQU a2 partsTableR EQU a0 plusDataR EQU a3 ;============================================================ WITH ExpHandlingFrame, AppendSymbolFrame, FormX2StrFrame,FormatStringPriv, NumberParts LINK A6,#localFrame3 MOVEM.L localRegs,-(A7) MOVEA.L oldA6f3(A6),af ;AppendSymbol frame MOVEA.L oldA6f2(af),ff ;FormatX2Str frame MOVE.L dest(af),destR ;load up a few lazy registers MOVEA.L partsTable(ff),partsTableR SF mantissa(ff) ;mantissa flag says we're into the exponent MOVE.B negExp(ff),D0 ;if negExp, then we know we need E- BEQ.S @needEPlus LEA PeMinus(partsTableR),A3 ;grab the E- format BRA.S @EMerge ;and continue @needEPlus: MOVEA.L plusData(A6),plusDataR ;otherwise retrieve E+ or E, whichever came @EMerge: MOVE.W WideCharArr.size(plusDataR),D5 ;set up D5 as loop end CLR.W D7 ;and D7 as loop counter BRA.S @loopTest ;start loop @loopStart: ;loop for sending exponent characters to output stream CLR.W -(A7) ;result MOVE.W D7,D0 ADD.W D0,D0 MOVE.W WideCharArr.data(plusDataR,D0.W),-(A7) ;the character itself MOVE.L destR,-(A7) ;what string the character is going to PEA destPos(ff) ;and how far into the string JSR SendChar MOVE.W (A7)+,D6 ;just ignore the result. Apathy, I guess. ADDQ.W #1,D7 ;loop counter increment @loopTest: compw D5,D7 ;done yet? BLE.S @loopStart @L168: MOVEM.L (A7)+,localRegs move.w #argFrame3, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'EXPHANDL' ENDWITH endp ;============================================================ ; AppendSymbol ; ; trashes a0-a1,d0-d1 ; uses/restores a3-a4,d4-d7 ; calls ExpHandling trashes a0,d0 (a1,d1-d2) ; ? some procedure with a handle at DoSendChar(A6) + 2 - trashes ? ; AppendSymbol proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D5-D7/A2-A4 ; why was a2 added? -pke, 02/21/89 cR EQU d6 sourceR EQU d5 ff EQU a4 resR EQU d7 partsTableR EQU a3 ;============================================================ WITH AppendSymbolFrame, FormX2StrFrame,FormatStringPriv, NumberParts, SMgrRecord LINK A6,#localFrame2 MOVEM.L localRegs,-(A7) MOVE.W c(A6),cR ;load up some registers MOVE.L source(A6),sourceR MOVEA.L oldA6f2(A6),ff ;FormatX2Str frame ;xxx <2/23/88:ldc> replaced #1 with #fFormatOK MOVEQ #fFormatOK, resR ;register storage for return value MOVE.L myCanonical(ff),holdMyCanonical(A6) MOVEA.L partsTable(ff),partsTableR compw #32,cR ;printable character? BLT.S @doFormByte ;no. It's a format byte MOVEA.L dest(A6),A0 ;yes, it's printable; copy it verbatim MOVE.W destPos(ff),D0 ;dest[destPos]:= c MOVE.B cR,0(A0,D0.W) ADDQ.W #1,destPos(ff) ;and don't forget to increment destPos ;<3/30/88ldc> track the number of literal chars in format string ADDQ.W #1,litCnt(ff) BRA @almostDone @doFormByte: MOVE.W cR,D0 ;CASE ORD(c):jump table computations SUBQ.W #tokLeader,D0 ;tokLeader is lowest entry in the table BMI @outOfRange compw #(tokEMinus-tokLeader),D0 ;tokEMinus is highest entry BGT @outOfRange ADD.W D0,D0 ;these are word offsets of course MOVE.W @jTab(D0.W),D0 JMP *+2(D0.W) @jTab: DC.W @leads-@jTab+2, @leads-@jTab+2, @leads-@jTab+2 DC.W @noEntry-@jTab+2, @others-@jTab+2, @others-@jTab+2 DC.W @others-@jTab+2, @noEntry-@jTab+2, @noEntry-@jTab+2 DC.W @noEntry-@jTab+2, @noEntry-@jTab+2, @ePlus-@jTab+2 DC.W @eMinus-@jTab+2 @ePlus: PEA PePlus(partsTableR) ;create the exponent with PePlus MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; intlSpec for vector move.l sVectExpHandling(a0), a0 ; <6/21/88ldc> jsr (a0) ; call vector <6/17/88ldc> ELSE JSR ExpHandling ENDIF BRA @almostDone @eMinus: PEA PeMinusPlus(partsTableR) ;create the exponent with PeMinusPlus MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; intlSpec for vector move.l sVectExpHandling(a0), a0 ; <6/21/88ldc> jsr (a0) ; call vector <6/17/88ldc> ELSE JSR ExpHandling ENDIF BRA @almostDone @leads: ;This gets complicated. MOVEA.L sourceR,A0 ;first find out if we have any digits left CLR.W D0 MOVE.B (A0),D0 compw digCnt(ff),D0 BLT.S @noDigsLeft LEA Nflags(ff),A1 ;yes, so decide whether to send a Roman digit or other BTST #fIsAltNum,(A1) BEQ.S @isRoman CLR.W -(A7) ;result space for DoSendChar MOVE.W digCnt(ff),D0 ;get the roman digit into D1 CLR.W D1 MOVE.B 0(A0,D0.W),D1 SUB.W #'0',D1 ;now subtract '0' to get an index ADD.W D1,D1 ;word index, that is LEA (altNumTable.data)(partsTableR),A0 ;altNumTable address MOVE.W 0(A0,D1.W),-(A7) ;push the foreign digit MOVE.L dest(A6),-(A7) ;and the destination address PEA destPos(ff) ;and the destination position LEA DoSendChar(A6),A0 ;go through the cranky procedure variable computations MOVE.L (A0)+,D0 BEQ.S @L181 MOVE.L D0,-(A7) @L181: MOVEA.L (A0),A0 JSR (A0) ;and finally ship off the character MOVE.W (A7)+,resR BRA.S @mergeHadLead @isRoman: MOVEA.L dest(A6),A0 ;roman digits are roman digits; just copy them MOVE.W destPos(ff),D0 MOVEA.L sourceR,A1 MOVE.W digCnt(ff),D1 MOVE.B 0(A1,D1.W),0(A0,D0.W) ADDQ.W #1,destPos(ff) ;and increment the destination pointer @mergeHadLead: ADDQ.W #1,digCnt(ff) ;since we've tacked on another digit, up digCnt also MOVE.W destPos(ff),lastLead(ff) ;this little obscurity is bookkeeping for the… ;…possibility that we may have to backtrack because of optional digits BRA.S @mergeLead ;basically, let's get out of here @noDigsLeft: compw #tokNonLeader,cR ;find out if this is a nonLeader or not BNE.S @notNonLeader MOVE.W destPos(ff),penLastLead(ff) ;if it is, then save the position because… ;…we may need to clip back to it because of optional characters BRA.S @mergeLead ;and stay out! ;<3/25/88ldc> added common call to DoSendChar to clean up code @DoDoSendChar: MOVE.W cR,D0 ADD.W D0,D0 CLR.W -(A7) MOVE.W -(tokLeftQuote*2)+data(partsTableR,D0.W),-(A7) MOVE.L dest(A6),-(A7) PEA destPos(ff) LEA DoSendChar(A6),A0 MOVE.L (A0)+,D0 BEQ.S @skipIt MOVE.L D0,-(A7) @skipIt: MOVEA.L (A0),A0 JSR (A0) MOVE.W (A7)+,resR RTS @notNonLeader ;<3/25/88ldc> made proc call to reduce code size JSR @DoDoSendChar ;res:= DoSendChar(data[ORD(c)],dest,destPos); ;<3/25/88ldc> added this line to fix problem of stripping off of leaders MOVE.W destPos(ff),lastLead(ff) CLR.W penLastLead(ff) ;reset penultimate LastLead because only junk between… ;…nonLeaders is optional BRA.s @mergeLead @others: ;<3/25/88ldc> changed to proc call JSR @DoDoSendChar ;res:= DoSendChar(data[ORD(c)],dest,destPos); @mergeLead: @almostDone: @outOfRange: @noEntry: compw #fFormatOK,resR ;has resR been modified? BEQ.S @noResChange MOVEA.L oldA6f2(A6),A0 ;update the function result if it has MOVE.W resR, returnValue1(A0) @noResChange: MOVEM.L (A7)+,localRegs move #argFrame2, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'APPENDSY' ENDWITH endp ;============================================================ ; xFormX2Str ; ; trashes a0-a1,d0-d1 ; uses/restores a2-a5,d4-d7 ; calls ConvertToString here trashes a0-a1,d0-d1 (d2?) ; SendCharRev here trashes a0-a1,d0-d2 ; AppendSymbol here trashes a0-a1,d0-d2 + ? ; NextFormatClass here changes d0 ; SendChar here trashes a0-a1,d0-d2 ; xFormX2Str proc ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - localRegs reg D4-D7/A2-A5 destPosR EQU a5 resR EQU d5 myCanonicalR EQU a4 partsTableR EQU a3 oversizedR EQU d4 formCountR EQU d6 NflagsR EQU a2 formPosR EQU d7 ;============================================================ WITH FormX2StrFrame,FormatStringPriv, NumberParts, SMgrRecord LINK A6,#localFrame1 MOVEM.L localRegs,-(A7) MOVEA.L xOrig(A6),A0 LEA destPos(A6),destPosR LEA x(A6),A1 MOVE.L A1,A2 MOVE.L (A0)+,(A2)+ ;need a local copy because it might change MOVE.L (A0)+,(A2)+ MOVE.W (A0),(A2) ;xxx<2/23/88:ldc> replaced #1 with symbolic constant #fFormatOK MOVEQ #fFormatOK,resR ;the original idea was to update returnValue1… ;…if resR was ever modified. I'm not through yet MOVE.W #fFormatOK, returnValue1(A6) MOVEA.L myCanonical(A6),myCanonicalR ;make use of the hired hands tst.b formString(myCanonicalR) ; check for empty format string <9/7/88ldc> beq @emptyFormatString MOVEA.L partsTable(A6),partsTableR SF oversizedR ;initialize the hell out of everything ST mantissa(A6) SF doNegative(A6) MOVE.W #(maxStringLen-1),D0 MOVE.B D0,preDecFinal(A6) MOVE.B D0,postDecFinal(A6) MOVE.B D0,expFinal(A6) ;<9/7/88ldc> test for minus zero, overflow or NAN cf bug # 30675, 33761 bsr GetSaneClass ; get the class of xOrig cmp.w #negZero, d0 ; negative zero? beq.s @isZero ; yes cmp.w #posQNAN, d0 beq @returnNAN cmp.w #negQNAN, d0 beq @returnNAN cmp.w #posSNAN, d0 beq @returnNAN cmp.w #negSNAN, d0 beq @returnNAN cmp.w #posInf, d0 beq @returnOverflow cmp.w #negInf, d0 beq @returnOverflow ; if positive format is not valid, give up <05/22/89 pke> BTST.B #fExists,(flags+2*fPositive)(myCanonicalR) BEQ @emptyFormatString TST.B (A1) ;xOrig > 0? BPL.S @noNeg MOVEQ #fNegative,formCountR EORI.B #$80,(A1) ;flip top order bit to negate BRA.S @endXTest ;NOTE: don't modify A1 until @donePercent!! @noNeg: BNE.S @isPos ;is it negative? @isZero MOVEQ #fZero,formCountR BRA.S @endXTest @isPos: MOVEQ #fPositive,formCountR ;it is positive @endXTest: MOVE.W formCountR,D0 ;Do we have a format corresponding to x? ADD.W D0,D0 BTST #fExists,flags(myCanonicalR,D0.W) BNE.S @doneFormat compb #fNegative,formCountR ;is x negative? SEQ doNegative(A6) ;let everyone know; in any case, positive is default MOVEQ #fPositive,formCountR @doneFormat: MOVE.W formCountR,D0 ;now make sure the format doesn't specify percents ADD.W D0,D0 LEA Nflags(A6),NflagsR LEA flags(myCanonicalR,D0.W),A0 MOVE.W (A0),(NflagsR) BTST #fIsPercent,(NflagsR) BEQ.S @donePercent PEA @c100 ;its a constant 100 to multiply by MOVE.L A1,-(A7) FMULX @donePercent: PEA x(A6) ;set up params for ConvertToString MOVEQ #0,D0 ;determine if either EMinus or EPlus is applicable MOVE.W (NflagsR),D0 AND.L #fEMEP,D0 SNE D0 MOVE.B D0,-(A7) MOVE.W formCountR,D0 ;push preDig[formCount] and postDig[formCount] ADD.W D0,D0 MOVE.W PreDig(myCanonicalR,D0.W),-(A7) MOVE.W PostDig(myCanonicalR,D0.W),-(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> GetSMgrCore a0 ; set up vectorized ConvertToString move.l sVectConvertToString(a0), a0 jsr (a0) ; call vector <6/17/88ldc> ELSE JSR ConvertToString ;and finally convert x to a string ENDIF MOVE.W #1,(destPosR) ;initialize all these silly indices MOVE.W #1,digCnt(A6) ; initialize the number of literal chars <3/30/88ldc> MOVE.W #1, litCnt(a6) MOVE.W formCountR,D0 ;formPosR:= decLocs[formCount]-1 ADD.W D0,D0 MOVE.W decLocs(myCanonicalR,D0.W),formPosR SUBQ.W #1,formPosR CMP.B #fPositive,formCountR ;set formStart. If formCount is positive, formStart is just 1 BNE.S @notPositive MOVE.W #1,formStart(A6) BRA.S @mergeFormStart @notPositive: ;otherwise, it's startLocs[formCount] MOVE.W startLocs(myCanonicalR,D0.W),formStart(A6) @mergeFormStart: BTST #fIsDecimal,(NflagsR) ;do we have a decimal point to worry about? BEQ.S @endDecPoint CLR.W -(A7) ;go ahead a start preDecFinal with a decimal point MOVE.W data+((tokDecPoint-tokLeftQuote)*2)(partsTableR),-(A7) PEA preDecFinal(A6) ;(because preDecFinal is a reversed string) MOVE.L destPosR,-(A7) ;push the position within preDecFinal JSR SendCharRev ;the reversed version of sendChar MOVE.W (A7)+,resR ;accumulate result @endDecPoint: CLR.W penLastLead(A6) ;so far, no nonLeaders that can bracket optional material ;<1/23/88drs> Changed 1 line to fix bug. ;destPos, rather than 0, must be moved into lastLead to handle numbers ;less than 1 with only nonLeaders to the left of the decimal point. MOVE.W (destPosR),lastLead(A6) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l NFlagsR, -(sp) ; save this little mother <6/17/88ldc> GetSMgrCore NflagsR ; get this for jump to AppendSymbol <6/17/88ldc> move.l sVectAppendSymbol(NflagsR), NflagsR ENDIF @preDecLoop: compw formStart(A6),formPosR ;WHILE formPosR >= formStart BLT.S @endPreDecLoop CLR.W D1 MOVE.B formString(myCanonicalR,formPosR.W),D1 MOVE.W D1,-(A7) ;push current format code PEA preDec(A6) ;push source PEA preDecFinal(A6) ;push destination PEA SendCharRev ;push SendCharRev procedure CLR.L -(A7) MOVE.L A6,-(A7) ;and the silly frame pointer IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (NflagsR) ; get from intlSpec <6/17/88ldc> ELSE JSR AppendSymbol ; vectorized <6/17/88ldc> ENDIF TST.W penLastLead(A6) ;if bracketed by nonLeaders, cut out the optional material BEQ.S @mergePenTest MOVE.W lastLead(A6),(destPosR) ;snip it off by moving destPos back CLR.W penLastLead(A6) ;and reset penLastLead @mergePenTest: SUBQ.W #1,formPosR ;in any case, decrement the form index BRA.S @preDecLoop @endPreDecLoop: IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l (sp)+, NflagsR ; restore the saved register <6/17/88ldc> ENDIF CLR.W D0 MOVE.B preDec(A6),D0 ;check if our digit count <= the available digits compw digCnt(A6),D0 BLT.S @mergeDigCheck ; destPos = litCnt means we have exactly matched the literal chars <3/30/88ldc> ; in the format string, hence no overflow move.w destPos(a6), d0 compw litCnt(a6), d0 beq.s @mergeDigCheck ST oversizedR ;we're a wreck MOVE.W #fFormatOverflow,returnValue1(A6) @mergeDigCheck: MOVE.W (destPosR),D0 ;now set the size of preDecFinal SUBQ.W #1,D0 MOVE.B D0,preDecFinal(A6) MOVE.B oversizedR,D0 ;did we overflow our available number size? BNE @mergePreDecV MOVE.B formCountR,D0 ;find the location of the decimal point in form string EXT.W D0 ADD.W D0,D0 MOVE.W decLocs(myCanonicalR,D0.W),formPosR ;set formPos to that location BTST #fIsDecimal,(NflagsR) ;if we had a decimal point then increment our position BEQ.S @mergeDecPoint ADDQ.W #1,formPosR @mergeDecPoint: MOVE.W #1,(destPosR) ;again go crazy initializing things MOVE.W #1,digCnt(A6) CLR.W startCut(A6) ;startCut tells where to chop off trailing zeroes IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l NFlagsR, -(sp) ; save this little mother <6/17/88ldc> GetSMgrCore NflagsR ; get this for jump to AppendSymbol <6/17/88ldc> move.l sVectAppendSymbol(NflagsR), NflagsR ; <6/21/88ldc> ENDIF @postDecWhile: MOVE.B formCountR,D0 ;WHILE i < startLocs[nextFormatClass(formCount)]… JSR NextFormatClass ADD.W D0,D0 compw startLocs(myCanonicalR,D0.W),formPosR SLT D0 AND.B mantissa(A6),D0 ;…AND mantissa DO BEQ.S @endPosDecWhile MOVE.W (destPosR),hold(A6) ;save our current destination position in case we need to cut CLR.W D1 MOVE.B formString(myCanonicalR,formPosR.W),D1 ;get formString[formPosR] MOVE.W D1,ch(A6) ;save it in ch MOVE.W D1,-(A7) ;and push it for AppendSymbol PEA postDec(A6) PEA postDecFinal(A6) PEA SendChar ;this time, it's not reversed CLR.L -(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (NflagsR) ; get from vector <6/17/88ldc> ELSE JSR AppendSymbol ENDIF MOVE.W lastSig(A6),D0 ;if our digit count has gone beyond lastSig, compw digCnt(A6),D0 ;then we may have to cut BGE.S @mergeAfterCut MOVE.W ch(A6),D1 CMP.B #tokLeader,D1 ;if it's a leader but not nonLeader, then no cut BEQ.S @noCutting CMP.B #tokZeroLead,D1 BNE.S @maybeCut @noCutting: CLR.W startCut(A6) ;reset startCut because leaders nullify it BRA.S @mergeAfterCut @maybeCut: CMP.B #tokNonLeader,D1 ;the only cutting possibility is if D1 is a nonLeader BNE.S @setUpHold ADDQ.W #1,D0 compw digCnt(A6),D0 ;but no cut if digCount has not exceeded lastSig BGE.S @mergeAfterCut MOVE.W startCut(A6),D1 ;if startCut is clear because somewhere along the line… BNE.S @mergeSetSC ;…we hit a leader other than nonLead, we need to… MOVE.W hold(A6),D1 ;…set the new startCut to the character we just appended MOVE.W D1,startCut(A6) @mergeSetSC: MOVE.W D1,(destPosR) ;in any case, do the cut BRA.S @mergeAfterCut @setUpHold: TST.W startCut(A6) ;test if startCut is zero BNE.S @mergeAfterCut ;and if it's not then leave it alone MOVE.W hold(A6),startCut(A6) ;otherwise set it to the character we just appended @mergeAfterCut: ADDQ.W #1,formPosR ;and finally, increment the position within the form string BRA @postDecWhile @endPosDecWhile: IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l (sp)+, NflagsR ; restore after using for intlSpec <6/17/88ldc> ENDIF MOVE.W (destPosR),D0 ;now give a length to postDecFinal SUBQ.W #1,D0 MOVE.B D0,postDecFinal(A6) MOVE.W formPosR,expEnd(A6) ;expEnd is actually the beginning MOVE.B formCountR,D0 ;formPos:= startLocs[nextFormatClass(formCount)] JSR NextFormatClass ;that is the end of the formString for this format ADD.W D0,D0 MOVE.W startLocs(myCanonicalR,D0.W),formPosR SUBQ.W #1,formPosR MOVE.W #1,(destPosR) MOVE.W #1,digCnt(A6) ;<1/23/88drs> Added following 2 lines to correct bug. ;Optional digits in the exponent should act like digits in ;the pre-decimal significand CLR.W penLastLead(A6) CLR.W lastLead(A6) MOVE.B mantissa(A6),D0 ;if we never hit the exponent then skip it BEQ.S @doExponent CLR.B expFinal(A6) BRA.S @pastExponent @doExponent: IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l NflagsR, -(sp) ; store reg and get intlSpec <6/17/88ldc> GetSMgrCore NflagsR ; AppendSymbol is now a vector <6/21/88ldc> move.l sVectAppendSymbol(NflagsR), NflagsR ENDIF @expWhile: compw expEnd(A6),formPosR ; WHILE formPosR >= expEnd BLT.S @pastExpWhile CLR.W D1 MOVE.B formString(myCanonicalR,formPosR.W),D1 MOVE.W D1,-(A7) ;push formString[formPos] PEA exp(A6) PEA expFinal(A6) PEA SendCharRev ;reversed this time CLR.L -(A7) MOVE.L A6,-(A7) IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> jsr (NflagsR) ; <6/17/88ldc> ELSE JSR AppendSymbol ;send off this character ENDIF ;<1/23/88drs> Added the following 5 lines to fix bug. ;Digits in the exponent should act like pre-decimal digits. TST.W penLastLead(A6) ;if bracketed by nonLeaders then snip of the optional stuff BEQ.S @noSnipExp MOVE.W lastLead(A6),(destPosR) CLR.W penLastLead(A6) @noSnipExp: SUBQ.W #1,formPosR ;decrement position in formString BRA.S @expWhile @pastExpWhile: IF forRom THEN ; changed buildLevel>=2 to forRom <06/30/89 pke> move.l (sp)+, NflagsR ; restore ENDIF MOVE.W (destPosR),D0 ;set the length of the expFinal string SUBQ.W #1,D0 MOVE.B D0,expFinal(A6) CLR.W D0 MOVE.B exp(A6),D0 ;if digCnt < ORD(exp[0]) then we blew it compw digCnt(A6),D0 BLT.S @expOkSize ST oversizedR @mergePreDecV: @pastExponent: @expOkSize: MOVE.B oversizedR,D0 ;did we ever get blimped? BEQ.S @noSizeProblem MOVE.W #fFormatOverflow,returnValue1(A6) BRA @outTheDoor @noSizeProblem: MOVEA.L out(A6),A0 ;give out a maximum size to start with MOVE.B #255,(A0) MOVE.W #1,(destPosR) ;and reset destPosR MOVE.B doNegative(A6),D0 ;if we need a negative sign then get one BEQ.S @pastNegSign CLR.W -(A7) MOVE.W data+((tokMinusSign-tokLeftQuote)*2)(partsTableR),-(A7) MOVE.L out(A6),-(A7) MOVE.L destPosR,-(SP) JSR SendChar MOVE.W (A7)+,resR @pastNegSign: ;the next 50,000 lines only copy… ;…preDecFinal,postDecFinal,and expFinal into out CLR.W D0 MOVE.B preDecFinal(A6),D0 MOVE.W D0,formPosR BRA.S @L227 @L228: MOVEA.L out(A6),A0 MOVE.W (destPosR),D0 LEA preDecFinal(A6),A1 MOVE.B 0(A1,formPosR.W),0(A0,D0.W) ADDQ.W #1,(destPosR) SUBQ.W #1,formPosR @L227: compw #1,formPosR BGE.S @L228 CLR.W D0 MOVE.B postDecFinal(A6),D0 MOVE.W D0,while1(A6) MOVEQ #1,formPosR BRA.S @L229 @L231: MOVEA.L out(A6),A0 MOVE.W (destPosR),D0 LEA postDecFinal(A6),A1 MOVE.B 0(A1,formPosR.W),0(A0,D0.W) ADDQ.W #1,(destPosR) ADDQ.W #1,formPosR @L229: compw while1(A6),formPosR BLE.S @L231 @L230: CLR.W D0 MOVE.B expFinal(A6),D0 MOVE.W D0,formPosR BRA.S @L232 @L233: MOVEA.L out(A6),A0 MOVE.W (destPosR),D0 LEA expFinal(A6),A1 MOVE.B 0(A1,formPosR.W),0(A0,D0.W) ADDQ.W #1,(destPosR) SUBQ.W #1,formPosR @L232: compw #0,formPosR bgt.s @L233 ; was bge 1 <2/7/88med> BTST #fIsPercent,(NflagsR) ;are we dealing with a percent? BEQ.S @afterPercent ;thank God no CLR.W -(A7) ;otherwise tack it on too MOVE.W data+((tokPercent-tokLeftQuote)*2)(partsTableR),-(A7) MOVE.L out(A6),-(A7) MOVE.L destPosR,-(SP) JSR SendChar MOVE.W (A7)+,resR @afterPercent: MOVEA.L out(A6),A0 ;give out a length MOVE.W (destPosR),D0 SUBQ.W #1,D0 MOVE.B D0,(A0) bra.s @outTheDoor ; <9/7/88ldc> @returnNAN move.w #fFormStrIsNAN, resR ; <9/8/88ldc> bra.s @outTheDoor ; <9/8/88ldc> @returnOverflow move.w #fFormatOverflow, resR ; <9/8/88ldc> bra.s @outTheDoor ; <9/8/88ldc> @emptyFormatString move.w #fEmptyFormatString, resR ; flag empty format string <9/7/88ldc> @outTheDoor: compw #fFormatOK, resR ;see if we ever blew it anywhere BEQ.S @afterRes MOVE.W resR,returnValue1(A6) @afterRes: MOVEM.L (A7)+,localRegs move.w #argFrame1, d0 ; for StdUnlink bra StdUnlink ; standard exit CheckDebug 'FORMX2ST' @c100: ;constant 100.0 DC.W $4005, $C800, $0000, $0000, $0000 ENDWITH endp end