Macintosh-SW/supermario
1
0
Fork 0
mirror of https://github.com/elliotnunn/supermario.git synced 2024-11-29 05:49:19 +00:00
Code Issues Projects Releases Wiki Activity
caf4716632
supermario/base/SuperMarioProj.1994-02-09/Toolbox/ScriptMgr/ScriptMgrUtilNum.a
Elliot Nunn 2e16381318 Bring in sources, and document
2019-06-29 23:17:50 +08:00

4497 lines
128 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;
; 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 View Git Blame Copy Permalink