mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2025-01-01 11:29:27 +00:00
0ba83392d4
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
4497 lines
128 KiB
Plaintext
4497 lines
128 KiB
Plaintext
;
|
||
; 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+postDig0, 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+postDig0, 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
|
||
|