Macintosh-SW/supermario
1
0
Fork 0
mirror of https://github.com/elliotnunn/supermario.git synced 2024-12-01 18:50:30 +00:00
Code Issues Projects Releases Wiki Activity
7627be1e6d
supermario/base/SuperMarioProj.1994-02-09/Toolbox/ScriptMgr/ScriptMgrUtilNum.a

4497 lines
128 KiB
Plaintext
Raw Normal View History

Bring in sources, and document
2019-06-29 15:17:50 +00:00
;
; 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):
;
; <SM3> 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<<tokLeader++1<<tokZeroLead
TransSendMask set TransSendMask++1<<tokNonLeader++1<<tokDecPoint++1<<tokPercent
TransSendMask set TransSendMask++1<<tokPlusSign++1<<tokMinusSign++1<<tokThousands
; remove 1<<tokLeftQuote++1<<rightQuote++1<<escape-- they should not occur
compw #(tokMaxSymbols+1),sourceR
BGE @TransLiteral ; changed branch from short <3/14/88ldc>
; 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<<tokNonLeader)++(1<<tokLeader))++(1<<tokZeroLead))++(1<<tokDecPoint))++(1<<tokPlusSign))++(1<<tokMinusSign))++(1<<tokEPlus))++(1<<tokEMinus)),D1
BTST.L D0,D1 ;is it any of those listed above?
BEQ.S @notPastDecimal ;no, so continue looping
@setTrue:
compw saveCIndexR,tempR ;make sure we haven't overflowed
BLE.S @fMerge
MOVE.W saveCIndexR,cIndexR ;since we matched, set position in format string
MOVE.B (FormCountR),D0 ;and set the possible flag back to true
EXT.W D0
ST possible(A6,D0.W)
TST.B pastDecimal(a6) ;if we're not past the decimal…
BNE.S @fMerge
CLR.W saveCIndexR ;…then reset the status keepers
MOVE.W saveSIndex(A6),sIndex(A6)
MOVE.W saveRIndex(A6),rIndex(A6)
BRA.S @fMerge
@mergeMatch:
ADDQ.W #1,cIndexR ;update cIndex
@fMerge: ;this entry avoids update; it already happened
MOVE.B (FormCountR),D0 ;now check if format string is done but source isn't
EXT.W D0
compw cIndexR,tempR
BGT.S @cMerge ;no, format is not done
MOVE.W sIndex(A6),D1
compw Ssize(A6),D1
BGT.S @cMerge ;yes, format is done, but so is source
SF possible(A6,D0.W) ;this source just doesn't match
@cMerge:
MOVE.B possible(A6,D0.W),D1 ;so, well, did we finally match or not
BNE.S @mergeMTest
compb #fZero,(FormCountR) ;if this is zero format, we're done
BNE.S @zMerge ;otherwise give it another try with next format
SF goingR ;none of the formats match
BRA.S @mergeMTest
@zMerge:
CLR.B isNeg(A6) ;increment the format counter and reset…
MOVE.B (FormCountR),D0 ;…so we can try matching against next format
EXT.W D0
ADDQ.W #1,D0
MOVE.B D0,(FormCountR)
MOVE.W D0,D1 ;but if the next format doesn't exist,…
ADD.W D0,D0 ;…we're up a creek
BTST #fExists,flags(myCanonicalR,D0.W)
BEQ.S @noNext
MOVEQ #1,D2 ;reset all the status and flags
CMP.W #fZero,D1
BNE.S @nonZeroSetup
; MOVE.B #'0',(real+1)(A6) ;<don't use form-dependent default for now>
MOVE.B #$80,checkFDmask(A6) ;for digits, accept only 0 until exponent
BRA.S @doneSpecialSetup ;
@nonZeroSetup:
; MOVE.B #'1',(real+1)(A6) ;<don't use form-dependent default for now>
ST checkFDmask(A6) ;
@doneSpecialSetup:
MOVE.B #'1',(real+1)(A6) ;default value <leave it always 1 for now>
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
Reference in New Issue Copy Permalink