mac-rom/Toolbox/ScriptMgr/ScriptMgrROMPatch.a
Elliot Nunn 4325cdcc78 Bring in CubeE sources
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.
2017-12-26 09:52:23 +08:00

2313 lines
85 KiB
Plaintext

;
; File: ScriptMgrROMPatch.a
;
; Contains: Patches for the IIci/Portable ROM version of the Script Manager
;
; Written by: PKE Peter Edberg
; SMB Sue Bartalo
; JH John Harvey
;
; Copyright: © 1989-1992 by Apple Computer, Inc., all rights reserved.
;
; Change History (most recent first):
;
; <27> 6/10/92 FM Replace obsolete equate smgrVerPTCHRom with smgrVersPriv.
; <26> 4/30/92 FM Get rid of conditionals: SysVers, smgrSysVers,
; doScriptMgrStr2DatFix
; <25> 4/22/92 PKE #1027368,<FM>: Now Roman CharType is patched out entirely to
; handle the direction bit too, so it is moved to ptch 27 - delete
; it here.
; <24> 4/14/92 PKE #1026778,<yds>: To make FindWord not depend on having script
; code passed in d2 (script code will not be in d2 when it is
; called from one-byte extension), change Roman dispatcher to
; replace selector on stack with ScriptRecord pointer, and get
; script code from new scriptID field of ScriptRecord instead of
; from d2. Do this for CharType & Transliterate too.
; <23> 4/8/92 PKE #1026515,<cv>: Patch Roman FindWord to not require that itl2 be
; in new format in order to handle custom break tables (passed by
; pointer). We patch enough so we no longer need FindWord part of
; PACK 6 patch in this file, so remove it. Then the CharType part
; of the PACK 6 patch can be eliminated by just patching out the
; beginning of CharType (this way is shorter too), so do that
; also. Eliminates half of PACK 6 patch, makes it cleaner and
; faster. Finally: eliminate some pre-7.0 conditionalized code.
; <22> 3/16/92 csd #1017570,<gbm>: Removed the MoveHHi call on the itl0 and itl1
; resources to avoid System heap fragmentation.
; <21> 2/13/92 PKE #1021419, Cube-E: Make Roman dispatcher handle nil entries in
; dispatcher table.
; <20> 12/17/91 PKE #1018346: Fix bug introduced in <19>. Call IUGetScriptItl with
; script code passed from ScriptMgr dispatcher, so it works for
; simple scripts too (don't assume script is smRoman).
; <19> 10/8/91 PKE For Cube-E (and Bruges): PACK 6 patch no longer applies to
; LwrString, since we patch it out entirely. Change PACK 6 patch
; to just call IUGetScriptItl instead of forcing IntlForce off.
; Part of fix for bug #1013149. Clean up a few more conditionals.
; <18> 9/20/91 PKE Remove CubeE conditional, since the new plan (according to
; Darin) is that everything for Cube-E goes in without
; conditionals. While I'm at it, get rid of some ">= $700"
; conditionals, and get rid of some code that was only for
; pre-7.0.
; <17> 9/15/91 PKE smb, #1011961: For Bruges/Cube-E, roll in from 6.1 - Fix
; trashing of d3 by GetFormatOrder (replace ROM version of
; GetFormatOrder with version in this file).
;
; <16> 2/19/91 PKE smb,#DTS FT: ToggleDate trashes one word past the end of its
; ÒVAR lSecs: LongDateTimeÓ parameter (reported by a developer).
; <15> 2/15/91 PKE JSM,#54736: Redo conditionals to move change <14> to Post 7.0.
; Object compare identical to <13>.
; <14> 1/28/91 JH PKE,#54736: Added changes to mirror changes in
; ScriptMgrUtilDate. So changes to date cache, changes in
; InitDateCache to add date separators to the cache, moved
; ValidLong, MatchString over to this file so that String2Date
; could use the new cache. And added slightly tougher requirements
; for date separators.
; <13> 12/15/90 PKE (gbm) Move ÔitlkÕ loading from KeyScript into SwapKybd patch.
; Fixes bugs with some European keyboards when using Keyboard
; menu, etc.
; <12> 12/14/90 PKE (DC) DonÕt install GetOSEvent patch if A/UX is running. A/UX
; folks will figure out how to handle the Script Mgr key
; combinations another way. Patch out rest of Script Mgr extension
; to GetOSEvent, and change it to use smgrKeyScriptResult to
; determine whether or not to strip event from queue (in a future
; build, this patch will be reduced in size by using a come-from
; patch in KeyScript). Patch KeyTrans to skip itlk handling if
; KeyTrans is called with a special KCHR (not the one emKeyCache
; points to). Patch internal SwapKybd routine to force it to load
; ÔKCHRÕ resources from System file.
; <11> 12/5/90 BBM (JSM) Protect the come-from patches
; <10> 10/30/90 PKE (stb) Patch out GetOSEvent and change it to permit switching
; keyboards within scripts using key combos defined in 'KSWP'
; resource.
; <9> 8/7/90 PKE Just altered the previous comment to say needed for SixPack.
; <8> 8/5/90 PKE NEEDED FOR SIXPACK: Since this patch may now be installed for
; A/UX, we need to branch around the installations in here that
; shouldnÕt be done for A/UX. Search for <8> to find changes.
; <7> 7/5/90 PKE NEEDED FOR SIXPACK: Rearrange InitDateCache to fix old problem:
; itl0 and itl1 may be purged before we try to use them. Patch out
; GetScript for 6.x systems to fix its handling of unimplemented
; verbs (old bug, fix needed for Sound Cdev). Removed local
; definition of smgrSixPack since it is now defined in
; ScriptPriv.a.
; <6> 6/11/90 PKE NEEDED FOR SIXPACK: Fix Script Mgr InitResources patch in ROM to
; save and restore all regs; only needed for 6.x. Changes are
; flagged with <6>. ALSO: Removed some superfluous with/endwith
; pairs.
; <5> 5/13/90 SMB Doing an ÔrtsÕ for NewSwapIcon since now using Keyboard Menu.
; Installing a tail patch to InitMenus to set smgrRect to 0 so
; that keyboard/script toggling in the system menu is no longer
; available.
; <4> 3/26/90 PKE Moved definition of symbols that control Script Mgr patches into
; ScriptPriv.a. Renamed symbols and added some.
; <3> 3/4/90 PKE Changed _UprText to _UpperText to match new Traps.a.
; <2> 2/28/90 PKE Moved FixRomAddresses macro to end and bsr to it; fixes problems
; that occur with BIND macros that are located after it.
; <1> 2/27/90 PKE New today, created from common patch code extracted from
; PatchIIciROM.a and PatchPortableROM.a. Relevant comments from
; those files are copied below.
;___________________________________________________________________________________________________
; Here are the relevant comments copied from PatchIIciROM.a; in body, these are marked <aX.X>
;
; <39> 2/22/90 PKE Replaced obsolete _LwrStringToUpr opword with _UprText. Removed
; setting of temporary sVectFixSpExtra vector (see <12>); we no
; longer need it.
; <12> 1/11/90 PKE Initialize Script Manager's new sVectFixSpExtra vector.
; <8.0> 11/17/89 PKE Tail patch on _GetIndADB to fix Script Mgr SwapKybd routine,
; which cleared ADB keyboard driver dead state as a word: should
; be a long.
; <7.8> 11/6/89 PKE NEEDED FOR 6.0.5!! Bug fixes for InitDateCache and String2Date
; needed for HyperCard. InitDateCache: Fixed CopyArray to use
; correct register (A4) for source pointer, and to initialize all
; relevant bytes of length register (D0). String2Date: if first
; relevant (i.e., day or month name) alpha token is a month name,
; we now search the day name list if we find another alpha token
; (fixes BRC #54946). Rearranged Cache structure to fix invalid
; use of month/day name index.
; <6.2> 9/18/89 PKE For 7.0, patch Script Manager internal routine SwapIcon to use
; new 'kscn' resource type instead of 'SICN'.
; <5.4> 8/28/89 PKE For 7.0, initialize additional Script Mgr vectors for
; SMgrCalcRect and SMgrInitFonts.
; <5.3> 8/27/89 PKE NEEDED FOR Scripts604, 6.0.5: Bump Script Manager version for
; Scripts604 or SysVers > $604, since IntlForce bug fix (4.5) is
; installed.
; <4.7> 8/21/89 PKE NEEDED FOR 6.0.4:
; ¥ Conditionalize 4.5 for Scripts604 OR (SysVers > $604)
; <4.5> 8/21/89 PKE NEEDED FOR 6.0.4 SCRIPTS BUILD, 6.0.5: Extend Pack6 patch to fix
; a problem in LwrString,CharType,Transliterate,FindWord. These
; routines should save the IntlForce flags then clear them before
; the IUGetIntl call, restoring the flags afterward. This is so we
; get the itl2 tables for the correct script (instead of the
; tables for the system script).
; <4.3> 8/21/89 PKE NEEDED FOR 6.0.4!!: Patch Pack6 to fix me-too problem with
; pointer to unlocked handle in Transliterate; affects Roman
; system (this problem looks familiar; did I dream that I already
; fixed this one?).
;___________________________________________________________________________________________________
; To Do:
;
;___________________________________________________________________________________________________
PRINT OFF ; <14>
blanks on
string asis
LOAD 'StandardEqu.d'
INCLUDE 'PatchMacros.a'
include 'ScriptPriv.a' ; <a4.5><e3.8>
INCLUDE 'ApplDeskBus.a' ; <a8.0><e5.5>
INCLUDE 'PackMacs.a' ; <a4.3><e3.7>
INCLUDE 'HardwarePrivateEqu.a' ; <8>
INCLUDE 'IntlUtilsPriv.a' ; <19>
PRINT ON ; <14>
ptchID equ 39 ; per CCH.
; The following symbols are defined in ScriptPriv.a. They control whether <4>
; various Script Mgr patches are resident and installed here.
;
; doScriptMgrUseKscn
; doScriptMgrStr2DatFix
; Local symbols <15>
FixCacheAndStr2Date equ 0 ; do this for 7.1? (not 7.0.1) <15>
;FixCacheAndStr2Date equ (smgrSysVers >= $710) ; do this for 7.1? (not 7.0.1) <15>
; =============================================================================
CodeEntry Main export
Import SMgrInstallPatch ; start of init code
bra.w SMgrInstallPatch ; branch to initialization
dc.b 'ptch' ; resource type
dc.w ptchID ; resource number
dc.w smgrVersPriv ; version
EndMain
; =============================================================================
; ROM binds
; =============================================================================
ROMVersions Esprit, Aurora
; for PACK6 patch
;fromROMLwrString BIND (Aurora, $0C0B2), (Esprit, $0797A)
;fromROMCharType BIND (Aurora, $1D986), (Esprit, $1745C)
;fromROMFindWord BIND (Aurora, $1DBE0), (Esprit, $176B6)
fromROMTranslit BIND (Aurora, $1DB34), (Esprit, $1760A)
toROMTranslit BIND (Aurora, $1DB3A), (Esprit, $17610)
ROMPack6 BIND (Aurora, $262B2), (Esprit, $1E3F4)
; for SwapIcon patch
ROMAfterPushSICN BIND (Aurora, $1DF26), (Esprit, $179E8)
ROMNoList BIND (Aurora, $1DF7C), (Esprit, $17A3E)
; for InitDateCache/String2Date patch
ROMValidLong BIND (Aurora, $1EE60), (Esprit, $1895A)
ROMBlock2String BIND (Aurora, $1EEA0), (Esprit, $18996)
ROMMatchString BIND (Aurora, $1EF20), (Esprit, $18A02)
; in InitDateCache
ROMAfter2ndJSRCopyArray BIND (Aurora, $1F0E8), (Esprit, $18BC8)
ROMExit BIND (Aurora, $1F160), (Esprit, $18C40)
; in/after String2Date
ROMAfterDBNE BIND (Aurora, $1F2D6), (Esprit, $18DB4)
ROMDTComExit BIND (Aurora, $1F426), (Esprit, $18F04)
IF FixCacheAndStr2Date THEN ; <14><15>
ROMCheckRest BIND (Aurora, $1f434), (Esprit, $18F12)
ROMCvtTables BIND (Aurora, $1f51e), (Esprit,$18ffc)
ROMCheckValid BIND (Aurora, $1F506), (Esprit,$18FE4)
ROMStdUnlink BIND (Aurora, $1E310), (Esprit,$17DCA)
ENDIF ; <14>
ROMFixValue BIND (Aurora, $1F46E), (Esprit, $18F4C)
ROMDateTimeEntry BIND (Aurora, $1F47E), (Esprit, $18F5C)
; for GetIndADB patch
ROMAfterGetIndADB BIND (Aurora, $1E048), (Esprit, $17B0A)
ROMAfterClrDeadKey BIND (Aurora, $1E058), (Esprit, $17B1A)
ROM@1dbra BIND (Aurora, $1E064), (Esprit, $17B26)
; for new vector initialization
ROMSMgrCalcRect BIND (Aurora, $1E1C2), (Esprit, $17C84)
ROMSMgrInitFonts BIND (Aurora, $1E21C), (Esprit, $17CDE)
ROMCallInterface BIND (Aurora, $1E3B0), (Esprit, $17E6A)
;ROMFixSpEXtra BIND (Aurora, $1DD94), (Esprit, $1786A)
; For GetOSEvent patch
ROMOSEventAvail BIND (Aurora, $B418), (Esprit, $6420) ; <10>
ROMDequeue BIND (Aurora, $9956), (Esprit, $4D64) ; <10>
ROMFilterKey BIND (Aurora, $1E2C6), (Esprit, $17D88) ; <10>
; For KeyTrans itlk fix
;ROMKeyTrans BIND (Aurora, $AD7A), (Esprit, $5DA2) ; <12>
ROMKeyTransAfterItlk BIND (Aurora, $ADCC), (Esprit, $5DF4) ; <12>
; For SwapKybd fix
;ROMSwapKybdAfterGetKCHR BIND (Aurora, $1DFC2), (Esprit, $17A84) ; <12>
ROMSwapKybdLockKCHR BIND (Aurora, $1DFC6), (Esprit, $17A88) ; <13>
; For ToggleDate fix via come-from patch in ValidDate ; <16>
ROMValidDate BIND (Aurora, $1E7B0), (Esprit, $18260) ; <16>
ROMTogDateAfterValDate BIND (Aurora, $1EAC6), (Esprit, $1856E) ; <16>
ROMbsrCopyDateLoop BIND (Aurora, $1EB3E), (Esprit, $185E6) ; <16>
; Five pairs - return address for xValidDate, ROM addresses after blt SetNewDate: <16>
;ROMbltSetNewDate1 BIND (Aurora, $1EA2E), (Esprit, $184D6) ; <16>
ROMAfterBltSetNewDate1 BIND (Aurora, $1EA32), (Esprit, $184DA) ; <16>
ROMbltSetNewDate2 BIND (Aurora, $1EA70), (Esprit, $18518) ; <16>
ROMAfterBltSetNewDate2 BIND (Aurora, $1EA74), (Esprit, $1851C) ; <16>
;ROMbltSetNewDate3 BIND (Aurora, $1EAE4), (Esprit, $1858C) ; <16>
ROMAfterBltSetNewDate3 BIND (Aurora, $1EAE6), (Esprit, $1858E) ; <16>
ROMdbltFinerLoop4 BIND (Aurora, $1EB02), (Esprit, $185AA) ; <16>
ROMAfterBltSetNewDate4 BIND (Aurora, $1EB08), (Esprit, $185B0) ; <16>
;ROMdbltBackwardsLoop5 BIND (Aurora, $1EB28), (Esprit, $185D0) ; <16>
ROMAfterBltSetNewDate5 BIND (Aurora, $1EB2E), (Esprit, $185D6) ; <16>
; For GetFormatOrder fix <17>
ROMReverseCluster BIND (Aurora, $1F974), (Esprit, $1944A) ; <17>
ROMEndFormatOrder BIND (Aurora, $1F96C), (Esprit, $19442) ; <17>
; For Roman dispatcher change <21>
ROMBitBucket BIND (Aurora, $1E3BC), (Esprit, $17E76) ; <21>
; For Roman FindWord/CharType changes <23>
; beginning of FindWord (Aurora, $1DBA4), (Esprit, $1767A) <23>
ROMfwAfterGetIntl BIND (Aurora, $1DBE0), (Esprit, $176B6) ; <23>
ROMfwLoadOffsets BIND (Aurora, $1DC16), (Esprit, $176EC) ; <23>
ROMfwstoreOffsets BIND (Aurora, $1DC42), (Esprit, $17718) ; <23>
; =============================================================================
; Begin resident code
; =============================================================================
;____________________________________________________________________________
; Script Manager patch to Pack6, fixes problem with pointer to unlocked
; handle in Transliterate. <a4.3><e3.7>
; Also fixes another problem in LwrString, CharType, Transliterate, FindWord:
; These routines need to get itl2 tables that apply to the current font script. <a4.5><e3.8>
; No longer applies to LwrString. <19>
; No longer applies to FindWord or CharType. <23>
;
; Note: d2 hi word has a value passed from dispatcher; save it till IUGetScriptItl call <20>
ptchPack6 PROC Export
tlRecord record {a6link},decr
result ds.w 1 ; function result.
tlArgs equ *-8 ; size of arguments.
srcHandle ds.l 1 ; srcHandle.
dstHandle ds.l 1 ; dstHandle.
target ds.w 1 ; target.
srcMask ds.l 1 ; srcMask.
scriptRecPtr ds.l 1 ; ScriptRecord pointer <24>
return ds.l 1 ; return address.
a6link ds.l 1 ; old a6 register.
tlLocals equ * ; size of local variables.
endr
; We can use the new protection scheme, if the first two instructions in the <11>
; patch are a bra.s followed by the jump to the old rom address.
bra.s @protection
@NoPatch
JMPBIND ROMPack6 ; nothing interesting to do
@protection
CMPBIND fromROMTranslit,(sp)
bne.s @NoPatch ; Translit is special - 2 bugs
@PatchTrans
; We get here if we came from the _IUGetIntl in Roman Transliterate (IUGetIntl is a
; macro that pushes a selector and then does a _Pack6 trap). A few instructions
; before the _IUgetIntl, we had handles in a1 and a2 which were then dereferenced
; into the same registers. We want to postpone this dereferencing till after
; _Pack6. Fortunately, the original handles are still available in Transliterate's
; a6 frame, so we can get them after the Pack6 call, dereference them again, and
; stuff them where they belong. We also need to clear the IntlForce flag around
; Pack6 if it is set.
; Now we ignore IntlForce and instead use IUGetScriptItl to be independent <19>
; of the grafPort, since we already know script is Roman.
;
; At this point the stack has 12 bytes that were intended for Pack6:
; 8(sp).L = space for returned handle
; 6(sp).W = argument, specifies which itlx
; 4(sp).W = Pack6 routine selector = #iuGetIntl
; 0(sp).L = return address
; We only care about the handle space and arg; we will call iuGetScriptItl instead.
WITH tlRecord
addq #6,sp ; kill old return address, selector <19>
;; clr.w d2 ; sysFlag=0; script code in hi word <20>
;; swap d2 ; put where they belong <20>
move.l scriptRecPtr(a6),a0 ; ScriptRecord ptr (maybe nonRoman) <24>
moveq #0,d2 ; sysFlag=0 in hi word <24>
move.b ScriptRecord.scriptID(a0),d2 ; script code in low word <24>
move.l d2,-(sp) ; two arguments: script code, sysFlag=0 <19><20>
move.w #iuGetScriptItl,-(sp) ; selector for PACK 6 <19>
JSRBIND ROMPack6
; The next two lines are what follow the _IUGetIntl in the ROM Transliterate
move.l (sp)+,a4 ;
movem.l (sp)+,a1/d1-d2 ;
; Now we expect to have pointers in a1 and a2, so set them up again (this is
; the fix) and jump back into ROM:
move.l srcHandle(a6),a1 ; get source handle.
move.l dstHandle(a6),a2 ; get destination handle.
move.l (a1),a1 ; get source pointer.
move.l (a2),a2 ; get destination pointer.
JMPBIND toROMTranslit
endwith ;tlRecord
endproc
;====================================================================== pke <a6.2><e4.7>
; This used to patch Script Manager internal routine SwapIcon to use <5>
; new 'kscn' instead of 'SICN'. Now we just eliminate it because we are
; using the new keyboard system menu.
; ----------------------------------------------------------------------------
; SwapIcon blits the key script icon in the upper right corner of the screen,
; opposite the apple symbol in the menu bar. It only draws the icon if the
; menuList is not nil.
; ----------------------------------------------------------------------------
proc
export NewSwapIcon
NewSwapIcon ; <a6.2><e4.7>
rts ; removing since now using the Keyboard-Script Menu <5>
endproc
;_______________________________________________________________________
IF FixCacheAndStr2Date THEN ; { <14><15>
;===========================================================================
; For System 7.0 changes made where the cache record would not be bigger than the
; cache space passed in. ALso MatchString was changed to handle arrays of variable
; length pascal strings rather than just fixed length
;===============================================================================
;======================================================================
; FUNCTION MatchString (textPtr : Ptr; textLen: Integer; textMinLen: Integer;
; strArrPtr : Ptr; strArrMaxLen: Integer;
; strArrCount: Integer) : Integer; external;
; function Finds the longest match between the text and an
; initial portion of a string in the array.
; return is the number of the match (1 based), -1 if not found
;======================================================================
MatchString proc export
import StdUnlink
MatchStrFrame record {oldA6},decrement
result ds.w 1
textPtr ds.l 1
textLen ds.w 1
textMinLen ds.w 1
strArrPtr ds.l 1
strArrMaxLen ds.w 1
strArrCount ds.w 1
return ds.l 1
oldA6 ds.l 1
args equ result-return-4
endr
MatchStrRegs reg a2-a4/d3-d5
with MatchStrFrame
link a6,#Frame ; allocate
movem.l MatchStrRegs,-(sp) ; save regs
move.l textPtr(a6),a3 ; get textPtr
move.w textLen(a6),d3 ; get len
move.l strArrPtr(a6),a4 ; get string array
move.w strArrCount(a6),d5 ; get count
bra.s @EndLoop ; for dbra
@MainLoop
; if 0 we have variable length pstrings in the array and handle
; differently, see below <1-8-91jh>
move.w strArrMaxLen(a6),d4 ; get max str length
; call compare with array entry
move.l a3,a0 ; pass ptr1
move.l d3,d0 ; pass len1
clr.l d1 ; wordize
move.b (a4)+,d1 ; get length
tst.w d4 ; if d4.w=0 then we need to remember the actual string
; length for each string and now the strArrMaxLen as
; above <1-9-91, jh>
bne.s @UsingStrArrMaxLen ; valid length in d4.2 so we don't need to remember
; the real length <1-9-91, jh>
move.b d1,d4 ; remember # of characters so we can move to next string <1-8-91 jh>
@UsingStrArrMaxLen ; added label to branch to <1-9-91, jh>
move.l a4,a1 ; pass start of text
; move compare to in-line, add min length test <2/23/88med>
CMP.w D1,D0 ; word length
BGT.S @NextString ; if len actual > len template, skip
beq.s @TryCompare ; lens equal, try anyway
cmp.w textMinLen(a6),d0 ; len actual < abbrev len?
blt.s @NextString ; do next
@TryCompare
SUBQ.w #1,D0 ; word length
blt.s @NextString ; actual string is null
@CompareLoop
CMPM.B (A0)+,(A1)+
DBNE D0,@CompareLoop
beq.s @GotString ; exit <2/23/88med>
@NextString
add.w d4,a4 ; get to next string
@EndLoop
dbra d5,@MainLoop ; loop til done
bra.s @Exit ; bail with d5 = -1.
@GotString
; return number of string, 1 based
sub.w strArrCount(a6),d5 ; get difference <2/23/88med>
neg.w d5 ; now right direction <2/23/88med>
@Exit
move.w d5,result(a6)
movem.l (sp)+,MatchStrRegs ; restore regs
move.w #args, d0 ; for StdUnlink
bra StdUnlink ; standard exit
endWith
endProc
ENDIF ; } <14>
;====================================================================== pke <a7.8><e5.4>
; Patch Script Manager routines InitDateCache and String2Date for bug fixes
; needed by HyperCard.
; ----------------------------------------------------------------------------
proc
export NewInitDateCache,NewString2Date
WhiteSpace EQU 1 ; token number for white space
AlphaToken EQU 4 ; token number for string
NumericToken EQU 5 ; token number for number
AltNumericToken equ $B ; alternate token type for numbers
NonAlphNumToken EQU 16 ; token numbers starting here correspond to non-alpha numeric tokens
NilToken EQU $7F ; token number for nil <14>
MaxTokens EQU 32 ; number of tokens for which there is space
omdy EQU 0 ; date order constants
odmy EQU 1
oymd EQU 2
Str15 EQU 16 ; length of string[15]
IF FixCacheAndStr2Date THEN ; { <14><15>
Str4 EQU 5 ; length of string[4] added for more space-efficient cache <1-8-91jh>
Str8 EQU 9 ; length of string[8] ditto <1-8-91jh>
ENDIF ; } <14>
DayMonthLen equ 15 ; length of days and months
NumDays EQU 7 ; length of various arrays
NumMonths EQU 12
DayList EQU NumDays*Str15
MonthList EQU NumMonths*Str15
NumStrBytes EQU 300
IF FixCacheAndStr2Date THEN ; { <14><15>
monthReplace EQU 0 ; offsets to CvtTable
reorder EQU 18
theYear EQU 0 ; offset to elements of arrays in CvtTable.reorder
theMonth EQU 1
theDay EQU 2
NumTimeStrings equ 4
TimeLen equ 4
;;-------BEGIN <1-8-90, jh> equates for extend itl1
; new itl1 extensions
itl1Version equ localRtn+2 ; <pke>
itl1Format equ itl1Version+2 ; <pke>
calendarcode equ itl1Format+2 ; <pke>
extraDaysOffset equ calendarcode+2
extraDaysLength equ extraDaysOffset+4
extraMonthsOffset equ extraDaysLength+4
extraMonthsLength equ extraMonthsOffset+4
abbrevDaysOffset equ extraMonthsLength+4
abbrevDaysLength equ abbrevDaysOffset+4
abbrevMonthsOffset equ abbrevDaysLength+4
abbrevMonthsLength equ abbrevMonthsOffset+4
extraSepsOffset equ abbrevMonthsLength+4
extraSepsLength equ extraSepsOffset+4
; For any of the above offsets there will be data down here in all cases this
; data will have the STR# format (i.e. word for string count followed by an
; array of pstring)
extformatkey equ $A89F
maxExtraSeps equ 10 ; count of extra seps in cache, must be at least 1!! <10>
IF maxExtraSeps<1 THEN ; <14>
aerror &concat('maxExtraSeps wrong: ',&i2s(maxExtraSeps)) ; <14>
ENDIF ; <14>
itl1stCount equ 4 ; 0..4 st's in itl1
;;-----------END <1-8-91, jh> equates for extended itl1
ENDIF ; } <14>
;========================IMPORTANT NOTE,POTENTIAL DANGER===================================
;
; The Data structure below is actually 6 bytes longer than the size of a
; DateCacheRecord. Initially, I fixed it so that the Record fit within 512 bytes
; but that change forced very large patches to String2Date and String2Time in the
; aurora and esprit ROMs.
;
; Since these patches were large and required a fair amount of change to ScriptMgrROMPatch.a
; we rethought fixing the cache so that it fit into 512 bytes and instead opted
; for keeping the fields in identical offsets.
;
; This is not as bad as it sounds (although it is bad, let there be no doubt about that)
; since the last 32 bytes of a tokenBlock are reserved and at this time (7.0 and earlier)
; are neither read from nor written to. For that reason, the fact that the declaration
; below is 6 bytes longer than the memory provided for it is only a forgiveable bit
; of forgetfulness.
;
; However, do NOT read or write any values past the itlResource field of the token block.
; And do NOT do what inside mac and the published headers say to do which is zero out
; the last 32 bytes of the token block. Doing that will TRASH memory. DON'T DO IT.
;========================================================================================
Cache RECORD 0
version ds.w 1
CurrentDate DS LongDateRec
BaseDate DS LongDateRec
theDays DS.B DayList ; <a7.8><e5.4>
theMonths DS.B MonthList ; <a7.8><e5.4>
IF FixCacheAndStr2Date THEN ; { <14><15>
theEveStr DS.B Str4 ;use new string definitions to make room for altseps
theMornStr DS.B Str4 ;
the24hrAMStr DS.B Str4 ;
the24hrPMStr DS.B Str4 ;
countAltSeps DS.W 1 ;number of separator tokens <14>
AltSeps DS.W maxExtraSeps ;contains an array of separator tokens <14>
filler DS.B 6
ELSE ; }{ <14>
theEveStr DS.B Str15
theMornStr DS.B Str15
the24hrStr DS.B Str15
ENDIF ; } <14>
theTimeSep DS.W 1
theDateSep DS.W 1
theDateOrder DS.b 1
longDateOrder ds.b 1
theAbbrLen DS.W 1
TBlock DS tokenBlock
CacheSize equ *
theTimeStrings equ theEveStr
ENDR
; ----------------------------------------------------------------------------
; function InitDateCache(theCache: CachePtr): OSErr;
;
; InitDateCache will initialize the items in the DateCacheRecord pointed to by theCache^
; and set the initialized item to true
;
; The bug fixes are in the CopyArray subroutine <a7.8><e5.4>.
; ----------------------------------------------------------------------------
IF FixCacheAndStr2Date THEN ; <14><15>
idcSaveRegs REG A2-A4/D3-d7 ; use d5,d6,d7 in our code to cache separators <1-10-91, jh>
ELSE ; <14>
idcSaveRegs REG A2-A4/D3/D4
ENDIF ; <14>
InitCacheRec RECORD {A6link},decr
Result DS.W 1 ; offset to function result (integer)
paramBegin EQU *
theCache DS.L 1 ; pointer to the cache record
selector ds.l 1 ; added for resource
paramEnd EQU *
return DS.L 1
A6link DS.L 1
theTokens DS.B 2*TokenRec.tokenRecSize
Intl0 DS.L 1 ; handle, not pointer
Intl1 DS.L 1 ; handle, not pointer
altSpace ds.w 1 ; use top byte
aLongDate ds LongDateTime ;
IF FixCacheAndStr2Date THEN ; <14><15>
temp4bytes ds.l 1 ;4 bytes to cache temp string <1-10-91,jh>
ENDIF ; <14>
localsize EQU *
ENDR
WITH InitCacheRec,LongDateField
parametersize EQU paramBegin - paramEnd ; size of parameter space on stack <14>
NewInitDateCache
LINK A6,#localsize ; Establish local frame and variables
MOVEM.L idcSaveRegs,-(SP) ; saved used registers
CLR.W Result(A6) ; clear function result
MOVE.L theCache(A6),A2 ; cache addr
move.b #' ',altSpace(a6) ; assume no alt space
sub.l #6,sp ; reserve returns
_IntlScript ; get the script
move.w #smScriptRight,-(sp) ; get flag
_GetScript ; get value
tst.l (sp)+ ; got it?
beq.s @NoAltSpace ; no
move.b #' '+$80,altSpace(a6) ; use alt space.
@NoAltSpace
WITH Cache
lea aLongDate(a6),a0 ; @temp
clr.l (a0)+ ; no high
move.l Time,(a0)+ ; low = current
pea aLongDate(a6) ; extended
pea CurrentDate(A2) ; get current date from system global time and convert to date
_LongSecs2Date
lea aLongDate(a6),a0 ; @temp
clr.l (a0)+ ; no high
clr.l (a0)+ ; low = current
pea aLongDate(a6) ; extended
pea BaseDate(A2) ; get base date and convert to date
_LongSecs2Date
; IUGetIntl(0): Handle
CLR.L -(SP)
CLR.W -(SP)
_IUGetIntl
MOVE.L (SP)+,Intl0(A6)
move.w ResErr,d0 ; did intl0 load in all right
BEQ.S GotIntl0Ok ; if so, go on
MOVE.W d0,Result(A6)
BRA Exit
GotIntl0Ok
MOVE.L Intl0(A6),A3
; Lock itl0 across Block2String calls (which can now move memory)
move.l a3,a0
_HLock
MOVE.L (A3),A3 ; now a3 is pointer to itl0
; Block2String(eveStr,theEveStr,4,true)
LEA eveStr(A3),A0 ; get international 0 record for evening string
LEA theEveStr(A2),A1
MOVEQ #4,D0
MOVE.B #1,D1
move.b altSpace(a6),d2 ; pass alt string
JSRBIND ROMBlock2String ; convert packed array of char into string <a7.8><e5.4>
; with no leading spaces
; Block2String(mornStr,theMornStr,4,true)
LEA mornStr(A3),A0 ; get international 0 record for morning string
LEA theMornStr(A2),A1
MOVEQ #4,D0
MOVE.B #1,D1
move.b altSpace(a6),d2 ; pass alt string
JSRBIND ROMBlock2String ; convert packed array of char into string <a7.8><e5.4>
; with no leading spaces
; Block2String(time1Stuff,the24hrStr,1,true)
IF FixCacheAndStr2Date THEN ; <14><15>
lea timeSuff(a3),A0 ; AM trailer for 24 hour time
lea the24hrAMStr(a2),a1 ; position in cache
moveq #4,d0 ; max four bytes per trailer
MOVE.B #1,D1
move.b altSpace(a6),d2 ; pass alt string <8/22/87med>
JSRBIND ROMBlock2String ; convert packed array of char intoÉ
; Éstring with no leading spaces
lea timeSuff+4(a3),A0 ; PM trailer for 24 hour time
lea the24hrPMStr(a2),a1 ; position in cache
moveq #4,d0 ; max four bytes per trailer
MOVE.B #1,D1
move.b altSpace(a6),d2 ; pass alt string <8/22/87med>
JSRBIND ROMBlock2String ; convert packed array of char intoÉ
ELSE ; <14>
LEA timeSuff(A3),A0 ; get international 0 record for 24 hour string
LEA the24hrStr(A2),A1
MOVEQ #1,D0
MOVE.B #1,D1
move.b altSpace(a6),d2 ; pass alt string
JSRBIND ROMBlock2String ; convert packed array of char into string <a7.8><e5.4>
; with no leading spaces
ENDIF ; <14>
MOVE.B timeSep(A3),theTimeSep(A2) ; get time separator from intl 0
MOVE.B dateOrder(A3),theDateOrder(A2)
MOVE.B dateSep(A3),(theTimeSep + 1)(A2)
; Now unlock itl0
move.l Intl0(A6),a0
_HUnlock
; This was moved from above to prevent itl0 and itl1 handles from being purged <7>
; before we lock them.
; IUGetIntl(1): Handle
CLR.L -(SP)
MOVE.W #1,-(SP)
_IUGetIntl
MOVE.L (SP)+,Intl1(A6)
TST.W ResErr ; did intl1 load in all right
BEQ.S GotIntl1 ; if so, go on
MOVE.W ResErr,Result(A6)
BRA Exit
GotIntl1
MOVE.L Intl1(A6),A3
; Lock itl1 across Copy Array calls; it calls Block2String, which can now move memory
move.l a3,a0
_HLock
MOVE.L (A3),A3 ; now a3 is pointer to itl1
; Get the long date order and convert
; false => dmy, true => mdy; otherwise fancy stuff
move.l #omdy,d1 ; assume false
clr.w d0 ; wordize
move.b lngDateFmt(a3),d0 ; get long format
beq.s @GotLong ; done
move.l #odmy,d1 ; assume true
cmp.b #$FF,d0 ; true?
beq.s @GotLong ; yes, got it
; if we are looking at the long date, only the day and year are important,
; since the dayOfWeek and month are both strings. Walk through the format until
; we find either one or the other
@LongFmtLoop
move.b d0,d2 ; get bottom half-nybble
and.b #3,d2 ; got it
cmp.b #longDay,d2 ; day?
beq.s @GotLong ; yes, return #odmy
cmp.b #longYear,d2 ; year?
beq.s @LongYearFirst ; go for it
lsr.b #2,d0 ; strip bottom
bne.s @LongFmtLoop ; repeat until done
@LongYearFirst
move.l #oymd,d1 ; year first (also if none found)
@GotLong
move.b d1,longDateOrder(a2) ; set it
; continue
MOVE.B abbrLen(A3),theAbbrLen(A2) ; get abbrLen
; changed order for more convenience in the later routine
lea months(a3),a4 ; source of days
LEA theMonths(A2),a1 ; destination names of the day and months
MOVE.L #(numMonths - 1),D3 ; load day and months from intl 1 rec into space
jsr CopyArray ; copy days
lea days(a3),a4 ; source of days
LEA theDays(A2),a1 ; destination names of the day and months
MOVE.L #(numDays - 1),D3 ; load day and months from intl 1 rec into space
jsr CopyArray ; copy days
IF NOT FixCacheAndStr2Date THEN ; <14><15>
; Now continue with ROM code
JMPBIND ROMAfter2ndJSRCopyArray ; <a7.8><e5.4>
Exit
JMPBIND ROMExit ; <a7.8><e5.4>
ELSE ; <14>
; Begin addition where we try to cache any valid st0 through st4 strings <14>
; and any alternative separators included in the extended itl1
; note that these separators are not cached as strings but as tokens produced by IntlTokenize
; jh, 1-8-91
; Notes on the loop:
; An itl1 has 5 fields that are declared as PACKED ARRAY[1..4] OF CHAR
; This field contain valid separators for the long date format
; This loop walks through those arrays, and converts valid separators into pascal
; strings; those strings are then converted to tokens and potentially cached in the subroutine TokenizeSepAndCache
; Register usage in the loop:
; a0-used to pass address of separator string to TokenizeSepAndCache
; a1-used briefly in the beginning to copy the date separator obtained previously from the itl0 into the cache
; a2-just like the rest of this code holds pointer to the cache
; a3-contains pointer to itl1
; a4-points at the ST arrays is
; d0-used to hold characters so they can be compared to null and space
; d1-used as a scratch register
; d3 - loop control for inner loop
; d4 - used to hold count of characters placed in temp4bytes, for that reason used to pass length of string to TokenizeSepAndCache
; d6 - loop control for outer loop
; d7 - holds available cache space
move.w #maxExtraSeps,d7 ;hold onto the maximum chars allowed
clr.w CountAltSeps(a2) ;clear the count
; get the itl resource and stash it in parameter block
WITH TBlock
clr.l -(sp) ; return handle
move.w #4,-(sp) ; get itl4
_IUGetIntl
move.l (sp)+,itlResource(a2) ; store itl resource
ENDWITH
beq @FatalError ; couldn't get it give up
lea st0(a3),a4 ;load start of 4-byte char blocks
move.l #4,d6 ; 5 ST strings to look at
@startSTLoop
clr.l d4 ; clear our offset into temp4bytes
move.w #3,d3
lea temp4bytes(a6),a1 ;get our temp string address
@char4loop
move.b (a4)+,d0
beq.s @looptotop ; yes its null so just continue
cmp.b #32,d0 ; space ?
beq.s @looptotop ; yes don't copy it, but continue
move.b d0,(a1)+
addq #1,d4 ;increment our offset
@looptotop
dbra d3,@char4loop ;loop back
tst.w d4 ; if d4 > 0 we have some sort of string
beq.s @looptoTopST ; its 0 so look at the next st[x]
;if we got a string we want to turn it into a Token here and then stick the token into
; our cache
moveq #1,d5 ; only one token permitted
;now we need to tokenize this separator and check to see if it is in the cache
lea temp4bytes(a6),A0 ; load the address of the source text into A0 which is where the subroutine expects it
bsr TokenizeSep ; branch to subroutine
bne.s @looptoTopST ; something went wrong with that one
bsr CompareAndCache ; check the token against the cache
ble.s @DoneWithItls ; if we have run out of cache, quit this
@looptoTopST
dbra d6,@startSTloop
;now we've copied the old st0-st4 separators, its time to check and see if we are
;dealing with an extended itl1 that might have some more separators added
cmp.w #extformatkey,localRtn(a3) ;is local routine $A89F ($A89F (unimplemented trap)
; is used here to flag this itl1 as an extended itl1)
bne.s @DoneWithItls ;nope, so branch around extra sep copying code
move.l extraSepsOffset(a3),d1 ;ok move the offset into d1
beq.s @DoneWithItls ;moved a 0 nothing is actually here so give it up
move.l extraSepsLength(a3),d0 ;how long is this array
ble.s @DoneWithItls ;negative or 0 means nothing is really here so get out
add.l a3,d1 ;add offset to ptr to itl1
move.l d1,a4 ;move result to a4
move.w (a4)+,d3 ;move the count of extra separators to d3,
subq #1,d3 ; set up for dbra
clr.l d4 ;clear d4 for safety
moveq #1,D5 ;D5 carrys number of token recs allowed into subroutine
@extraSepLoop
move.b (a4)+,d4 ;a4 points at the length byte, put that in d4 and increment a0 to point at actual string
move.l a4,a0 ;TokenizeSep expects source in a0
bsr TokenizeSep ; branch to subroutine
bne.s @extraSepLoop ; NE is tokenizer failed
bsr CompareAndCache ; tokenizer was OK so compare the token and potentially cache it
ble.s @DoneWithItls ; if we have run out of cache, quit this
add d4,a4 ; increment to next string
dbra d3,@extraSepLoop
@DoneWithItls
;;;;;;;;;;;;;;;;;;;;;;;;;;;;end addition
;jh, 1-8-91 <14>
;;;;;;;;;;;;;;;;;;;;;;;;;;end addition
; Now unlock itl1
move.l Intl1(A6),a0
_HUnlock
LEA theTimeSep(A2),A0 ;get ready for tokenize sub routine
moveq #2,d5 ;we allow two tokens
move.l #2,d4 ; length into d4
bsr TokenizeSep ;
beq.s @GotSeparators ; OK so back to the old code
@FatalError ;added label so I could branch here from new code <10>
MOVE.W #fatalDateTime,Result(A6) ; if not, exit procedure and return fatal error
BRA.S Exit
@GotSeparators
MOVE.W theTokens(A6),theTimeSep(A2)
MOVE.W (theTokens + TokenRec.tokenRecSize)(A6),theDateSep(A2) ; store date and time sep tokens
MOVE.L #MaxTokens,TBlock.tokenLength(A2) ; no more than 2 tokens, please
Exit
MOVEM.L (SP)+,idcSaveRegs ; restore registers to their original value
move.w #parametersize, d0 ; for StdUnlink
JMPBIND ROMStdUnlink ; standard exit
ENDIF ; <14>
; little subroutine for code savings
; a4 is source pointer
; a1 is dest pointer
; d3 is byte length
CopyArray
move.l a1,d4 ; dest ptr
@LOOP MOVE.L A4,A0 ; move string from intl 1 rec <a7.8><e5.4>
MOVE.L d4,A1 ; into local frame
moveq #0,d0 ; Block2String wants a long! <a7.8><e5.4>
MOVE.B (A0)+,D0 ; with length from first byte of string
MOVEQ #1,D1 ; with no local frame
move.b altSpace(a6),d2 ; pass alt string
JSRBIND ROMBlock2String ; search <a7.8><e5.4>
ADD.L #Str15,d4 ; get next string to transfer
ADD.w #Str15,A4 ; into next string in local frame <a7.8><e5.4>
DBRA D3,@LOOP
rts
IF FixCacheAndStr2Date THEN ; { <14><15>
;-----------------------------------------------------------------------------------
; TokenizeSep
; This subroutine is called to tokenize any separator we have found and store the
; resulting token in the datecache
; registers
; INPUT
; A0 - ptr to the source text
; A2 - which holds a ptr to the cache which contains a token paramblock
; D5 - number of tokens allowed
; D4 - length of source text
; TRASHED
; A1,D0,D1
; sets NE if Tokenizer fails
;-------------------------------------------------------------------------------------
TokenizeSep
; load the tokenizer parameter block for later
WITH TBlock
LEA theTokens(A6),A1 ; spaces for tokens in local frame
MOVE.L A1,tokenList(A2)
MOVE.L d5,tokenLength(A2) ; number of tokens allowed (shouldn't be more than 2)
CLR.L tokenCount(A2)
CLR.L DoString(A2) ; clear out DoString, DoAppend, DoAlphaNumeric, and DoNest
LEA leftDelims(A2),A1
MOVE.W #(decimalCode-leftDelims)/2,D0 ; load NilToken into leftDelims, rightDelims, leftComment
@LOOP0
MOVE.W #NilToken,(A1)+ ; RightComment, EscapeCode & decimal code
DBRA D0,@LOOP0
; get the address of the source from a1
MOVE.L A0,source(A2) ; inside With TBlock
MOVE.L d4,sourceLength(A2) ; d4 holds the length
ENDWITH ; TBlock
; IntlTokenize(@TBlock): signedByte;
CLR.B -(SP)
PEA TBlock(A2)
_IntlTokenize ; tokenize text
tst.b (sp)+ ; test the result and set the return bit
rts
;---------------------------------------------------------------------------------------------------
; CompareAndCache
; Once we've sucessfully tokenized one of the separators we use this routine to compare
; the new token against the stuff already in the cache
; if the new token is not there it is cached
;
; REGISTERS
; INPUT
; a2 - Ptr to cache
; d7.w - token slots available in cache
; TRASHED
; d0,d1,a1
; SETS cc AT EXIT BASED ON UPDATED d7.w
;-------------------------------------------------------------------------------------------------
CompareAndCache
WITH TBlock
; so we have a token type in theTokenRec
lea AltSeps(a2),a1 ; get destination in a1
move.w countAltSeps(a2),d0 ; number of tokens in d0
beq.s @storeToken ; none there so store it
subq #1,d0 ; for dbra
@tokenCompare ; otherwise compare token with whats in the cache
move.w (a1)+,d1
cmp.w theTokens(a6),d1 ;
beq.s @quitSubroutine ; we've already got this one so lets get on with it
; addq #2,a1 ; increment the pointer into the cache
dbra d0,@tokenCompare ; ne so look at the next one
@storeToken
move.w theTokens(A6),(a1) ; when loop completes a1 points at first empty slot
add.w #1,countAltSeps(a2) ; increment our count of separators
subq #1,d7 ; decrement our number of available token slots in cache
ENDWITH
@quitSubroutine
tst.w d7 ; set condition codes
rts
ENDIF ; moved this back inside 2 ENDWITHs <14><15>
ENDWITH ; Cache
ENDWITH
; ----------------------------------------------------------------------------
;function String2Date( textPtr: Ptr;
; textLen: longint;
; theCache: DateCachePtr;
; var lengthUsed: longint;
; var DateTime: LongDateRec): Integer;
;
; String2Date will look for a date in the text given it according to the international
; resource format. Using the Tokenizer routine it will look for a dayofWeek (which will
; be a string), a month (either a string or a number) and a day and year (both numbers).
; If the month is a number, order is decided by the ShortDate format in INTL 0; otherwise
; String2Date uses a table. Note if only two numbers are found they are assumed to be day
; and month. If one number is found it is assumed to be a date. Missing fields are
; filled in by the current date and time
;
; Register Usage
;
; A2 - Work register D3 - loop control register
; A3 - Work register D4 - MonthFound
; A4 - Cache Addr D5 - ResultNum
; D6 - AbbrLen
; D7 - NumDelimsFound
;
; The bug fixes are: É <a7.8><e5.4>
; ----------------------------------------------------------------------------
s2dSaveRegs REG D3-D7/A2-a4 ; removed a5
DateFrame RECORD {A6link},decr
Result DS.W 1 ; offset to function result (integer)
paramBegin EQU *
textPtr DS.L 1 ; offset to Date2Time's paramters
textLen DS.L 1
theCache DS.L 1 ; @DateCacheRecord
RestofText DS.L 1 ; @Longint
DateTime DS.L 1 ; @LongDateRec
selector ds.l 1 ; added for resource
paramEnd EQU *
return DS.L 1
A6link DS.L 1
theTokens DS.B MaxTokens*TokenRec.tokenRecSize ; storage for tokens found by tokenizer
theDate DS LongDateRec ; date time rec
results DS.W 3 ; three temporary results
myDateOrder DS.W 1
DayFound DS.W 1
lastItemSep DS.W 1
lastToken DS.W 1
lastTokenAddr DS.L 1
lastExToken DS.W 1
dummyLongDate ds LongDateTime
stringStorage DS.B NumStrBytes
localsize EQU *
ENDR
WITH DateFrame
With Cache,LongDateField
IF FixCacheAndStr2Date THEN ; Needed this conditional <15>
IMPORT ValidLong
ENDIF ; <15>
NewString2Date
LINK A6,#localsize ; Establish local frame and variables
MOVEM.L s2dSaveRegs,-(SP) ; saved used registers
JSRBIND ROMDateTimeEntry ; initialize & call _IntlTokenize
; Note that DateTimeEntry also does the following:
; 1. moves theCache(a6) into a4
; 2. moves TheTokens(a6) into a3
; 3. sets result(a6)
; 4. clears D7,D6; sets D5.L = -1
; 5. after IntlTokenize, sets D3= number of tokens - 1
tst.w result(a6) ; entry failed?
bne DTComExit ; bail if so
; specific stuff
MOVEQ #-1,D4 ; initialize MonthFound to -1
CLR.W DayFound(A6)
LEA CurrentDate(A4),A1 ; source
LEA theDate(A6),A0 ;
MOVE.L (A1)+,(A0)+ ; era, year
MOVE.L (A1)+,(A0)+ ; month, day
MOVE.L (A1)+,(A0)+ ; hour, minute
move.w (a1)+,(a0)+ ; second
CLR.W (A0)+ ; clear out dayOfWeek. Will either be set by user or be set
; in the course of the validity check of the date
MOVE.B theAbbrLen(A4),D6
WITH TokenRec
@TokenLoop
MOVE.W theToken(A3),D1 ; get token code from TokenRec record at (A3)
CMP.W #NonAlphNumToken,D1 ; is it a separator
BGE.S @FoundSeparator
SUB.W #WhiteSpace,D1 ; was it a white space?
BEQ @TokenLoopEnd ; ignore
SUBQ.W #(AlphaToken - WhiteSpace),D1 ; is it an alpha token?
IF FixCacheAndStr2Date THEN ; { <14><15>
beq @FoundAlpha ; <1-8-91, jh> changed to .w
SUBQ.W #(NumericToken - AlphaToken),D1 ; is it a number token?
BEQ @NumberToken ; <1-8-91, jh> changed to .w
SUBQ.W #(AltNumericToken - NumericToken),D1 ; is it a number token? <9/2/87med>
BEQ @NumberToken ; <1-8-91, jh> changed to .w <9/2/87med>
ELSE ; }{ <14>
beq.s @FoundAlpha
SUBQ.W #(NumericToken - AlphaToken),D1 ; is it a number token?
BEQ.S @NumberToken
SUBQ.W #(AltNumericToken - NumericToken),D1 ; is it a number token? <9/2/87med>
BEQ.S @NumberToken ; <9/2/87med>
ENDIF ; } <14>
BRA @TokenLoopEnd ; ignore any other characters
@FoundSeparator
TST.B D7 ; possible separator. Has a separator already been found
BEQ.S @OneDelimFound ; no, so no error yet
OR.W #TooManySeps,Result(A6) ; yes, so now we have too many separators
@OneDelimFound
IF FixCacheAndStr2Date THEN ; { <14><15>
;***********************
;begin <1-8-91 jh> changes <14>
;here we compare if any of the separators in the itl1 equal this so-called
;separator we just found
;*********************
cmp.w theDateSep(a4),d1 ; start by comparing the DateSep (which is not cached with the other stuff) with the new token
beq.s @SeparatorFound ; found it
move.w countAltSeps(a4),d0 ; d0 will be our loop counter
beq.s @SeparatorFound ; hmm, nothing cached, but didn't match DateSep we could fail completely
; but I guess will just go with the old method of having everything match
subq #1,d0 ; set up for dbra
lea AltSeps(a4),a0 ; address of alternate separators
@compareSeps
cmp.w (a0)+,d1 ; compare cached tokens with new token
beq.s @SeparatorFound ; found it branch out of loop
dbra d0,@compareSeps ; decrement and branch
;no separator match. If any of the date is there we set up for an error and kind of continue
TST.w D5 ; is this after the first number loaded? (.w)
bmi.s @firstNonAlphaInvalid ; if first non-alphanumeric isn't a valid separator we return dateTimeInvalid
or.w #SepNotIntlSep+sepNotConsistent+extraneousStrings,Result(a6)
bra.s @SeparatorFound
@firstNonAlphaInvalid
OR.W #dateTimeInvalid,Result(A6) ; date not valid, return error
BRA DTComExit
@SeparatorFound
;;********************************************
; end <1-8-91, jh> changes <14>
;;********************************************
ENDIF ; } <14>
ADDQ.B #1,D7 ; record separator found
TST.w D5 ; is this after the first number loaded? (.w) <1/5/88med>
BMI @TokenLoopEnd ; if we have not reached a number yet go on
BNE.S @CheckDateSep ; if we loaded in a number then check consistency
MOVE.W D1,lastItemSep(A6) ; otherwise update lastItemSep with just found separator
BRA @TokenLoopEnd
@CheckDateSep
CMP.W lastItemSep(A6),D1 ; are they consistent
BEQ @TokenLoopEnd ; if yes, than go on
OR.W #SepNotIntlSep+sepNotConsistent,Result(A6) ; record warning
BRA @TokenLoopEnd
@NumberToken
; check for numbers separated only by white space
tst.w d7 ; got a separator?
bne.s @1 ; yes
tst.w d5 ; first number?
blt.s @1 ; yes, skip
bne.s @0 ; have 1 number
move.w #WhiteSpace,lastItemSep(A6) ; set separator
bra.s @1 ; continue
@0
cmp.w #WhiteSpace,lastItemSep(a6) ; same?
beq.s @1 ; yes, continue
or.w #SepNotIntlSep+sepNotConsistent,Result(A6) ; record warning
@1
; end of white space check
CLR.L D7 ; clear out past separators
CMP.W #2,D5 ; make sure that results array is not full
BGE @ExtrnsToken ; if full, record warning and search <a7.8><e5.4>
; for final string (remove .s)
; ValidLong(position,textLength): longint
MOVE.L stringPosition(A3),A0
IF FixCacheAndStr2Date THEN ; <14><15>
jsr ValidLong ; call new one to get > 32768 test
ELSE ; <14>
JSRBIND ROMValidLong ; get number in text at TokenRec.position <a7.8><e5.4>
ENDIF ; <14>
IF FixCacheAndStr2Date THEN ; <14><15>
bpl.s @numberOK ; branch around error if the number is a valid long
ori.w #dateTimeInvalid,result(a6) ;bad number so or in the dateTimeInvalid error
bra DTComExit ; and branch to our exit place
@numberOK
ELSE ; <14>
BMI DTComExit
ENDIF ; <14>
JSRBIND ROMFixValue ; <a7.8><e5.4>
bra @TokenRecognized ; get next token (remove .s) <a7.8><e5.4>
@FoundAlpha
CLR.L D7 ; clear out past separators
; UprString(newTextPtr,AbbrLen) ; and make it uppercase for case insensitive search
MOVE.L stringPosition(A3),A2
ADDQ.L #1,A2
MOVE.L A2,A0
MOVE.L length(A3),D0 ; use real length
_UpperText ; _LwrString with uppercase function <a39><e11><3>
TST.W D4
BPL.S @SearchForDay ; <a7.8><e5.4>
; MatchString(newTextPtr,AbbrLen,@months,15,12): integer
CLR.W -(SP) ; attempt to find a day/month string which matches alpha token
MOVE.L A2,-(SP)
MOVE.W length+2(a3),-(SP) ; push length as integer
MOVE.W D6,-(SP) ; push minlen as integer
PEA theDays(A4) ; <a7.8><e5.4>
MOVE.W #DayMonthLen,-(SP)
MOVE.W #NumMonths+NumDays,-(SP) ; check for both at once
JSRBIND ROMMatchString ; <a7.8><e5.4>
MOVE.W (SP)+,D2 ; save in D2
BLE.S @ExtrnsToken ; checking both
; decide between days and months
sub.w #NumDays,d2 ; months?
ble.s @CheckForDay ; no, do days
; got a month
CMP.W #2,D5 ; is result array already full?
BGE.S @ExtrnsToken ; if so, then its not a needed token
ADDQ.W #1,D5 ; is in range, result is not full and string
MOVE.W D5,D1 ; did not match as a day
ADD.W D1,D1 ; double index for integer array
LEA results(A6),A1 ; ResultNum:= ResultNum + 1
MOVE.W D2,(A1,D1.W) ; results[ResultNum]:= match result
MOVE.W D5,D4 ; MonthFound:= resultNum
BRA.S @TokenRecognized
; if day not found yet, we need to see if current string matches a day <a7.8><e5.4>
@SearchForDay
TST.B DayFound(a6) ; have we found one yet?
BNE.S @ExtrnsToken ; day already found, record warning
CLR.W -(SP) ; attempt to find a day string which matches alpha token
MOVE.L A2,-(SP)
MOVE.W length+2(a3),-(SP) ; push length as integer
MOVE.W D6,-(SP) ; push minlen as integer
PEA theDays(A4)
MOVE.W #DayMonthLen,-(SP)
MOVE.W #NumDays,-(SP) ; just check days this time
JSRBIND ROMMatchString ; <a7.8><e5.4>
MOVE.W (SP)+,D2 ; save in D2
BLE.S @ExtrnsToken ; checking both
BRA.S @HaveDay
@CheckForDay
TST.B DayFound(a6) ; off of a6!
BNE.S @ExtrnsToken ; day already found, record warning
add.w #NumDays,d2 ; restore days <a7.8><e5.4>
@HaveDay ; <a7.8><e5.4>
ST DayFound(A6) ; record that day was found <a7.8><e5.4>
MOVE.W D2,theDate.dayOfWeek(A6) ; otherwise, load dayOfWeek into date time record
TST.W D5 ; is dayOfWeek between two numbers (.w)
BMI.S @NoWarning ; if no number has been found yet, go on
OR.W #fieldOrderNotIntl,Result(A6) ; record warning
@NoWarning
BRA.S @TokenRecognized
@ExtrnsToken
TST.W lastExToken(A6) ; is this the first extraneous token found?
BPL.S @TokenLoopEnd ; no, go on
MOVE.W D3,lastExToken(A6) ; a string which we don't recognize has been found
BRA.S @TokenLoopEnd ; record warning and go on
@TokenRecognized
MOVE.W D3,lastToken(A6)
MOVE.L A3,lastTokenAddr(A6) ; save loop and token addr for later use
@TokenLoopEnd
ADD.L #tokenRecSize,A3 ; add size of TokenRec record to A3 to get next token
CMP.W #2,D5 ; if the result array full (.w)
SGE D0
AND.B DayFound(A6),D0 ; and dayofWeek string been found
DBNE D3,@TokenLoop ; then stop loop, otherwise go until all tokens are looked at
JMPBIND ROMAfterDBNE
DTComExit
JMPBIND ROMDTComExit
endproc ; replaced this endproc <15>
IF FixCacheAndStr2Date THEN ; <14><15>
;======================================================================
; Function ValidLong(aStr: Str255): Longint; <2.5>
; Input stringPtr: ptr in A0
; Output theLong ($80000000 if invalid) in D0
; returns a valid longint, positive. Number sets status register
;======================================================================
ValidLong proc export
MaxInteger equ $00008000
movem.l d3/d4,-(sp)
move.l #$80000000,d0 ; assume bad
clr.l d4
move.b (A0)+,d4 ; get length
ble.s @BailValid ; bail if not there
clr.l d1 ; longize
move.b (a0)+,d1 ; new value
sub.b #'0',d1 ; adjust
subq.b #1,D4 ; adjust string length
move.l d1,d2 ; initialize total
bra.s @FastEntry ; enter loop in middle
@FastPathLoop
; multiply by 10
add.l d2,d2 ; double
move.l d2,d3 ; save copy
lsl.l #2,d2 ; now * 8
add.l d3,d2 ; now * 10, at a cost of 6+4+12+6=28 10x = 2x + 4á2x
add.l d1,d2 ; accumulate
@FastEntry
move.b (a0)+,d1 ; new value
sub.b #'0',d1 ; adjust
dbra d4,@FastPathLoop ; yes, continue
@DoneFastPath
cmp.l #MaxInteger,d2 ; is it greater than 32768?
bhi.s @BailValid ; yes, so it is too high, bail
; note that we don't compare against negative since tokenizer will treat that as a separator
move.l d2,d0 ; return result and set status register
@BailValid
tst.l d0
@Exit
movem.l (sp)+,d3/d4
rts
endProc
ENDIF ; } <14>
;====================================================================== <a8.0><e5.5>
; Tail patch on _GetIndADB to fix bug in Script Manager ResetKCHR routine
; called by SwapKybd: it clears ADB keyboard driver dead state as a word,
; should be a long.
; ----------------------------------------------------------------------------
proc
export ptchGetIndADB
ptchGetIndADB
; We can use the new protection scheme, if the first two instructions in the <11>
; patch are a bra.s followed by the jump to the old rom address.
bra.s @protection
@JumpToRom
BackToTrap oldGetIndADB ; Jump back to the Rom
@protection
CMPBIND ROMAfterGetIndADB,OSTrapReturnAddressDepth(sp) ; From ResetKCHR?
bne.s @JumpToRom ; if not, just continue with trap
lea ptchResetKCHR,a1 ; a1 is not a param for GetIndADB
move.l a1,OSTrapReturnAddressDepth(sp) ; so trap returns to patch, not ROM
bra.s @JumpToRom ; and go back to the ROM
; When we reach the patch below, we are in ResetKCHR just after the _GetIndADB
rkRecord record {a6link},decr
rkArgs equ *-8 ; size of arguments.
pointer ds.l 1 ; new KCHR pointer.
return ds.l 1 ; return address.
a6link ds.l 1 ; old a6 register.
adb ds ADBDataBlock ; ADB data structure.
oldKeyboard ds.l 1 ; old keyboard pointer
rkLocals equ * ; size of local variables.
endr
ptchResetKCHR
with rkRecord
cmp.b #kybdADBAddr,adb.origADBAddr(a6) ; is it a keyboard?
bne.s @1 ; no -> skip it.
move.l adb.dbDataAreaAddr(a6),a0 ; load data area pointer.
clr.l KybdDriverData.deadKey(a0) ; clear dead state - long! <a8.0><e5.5>
JMPBIND ROMAfterClrDeadKey ; <a8.0><e5.5>
@1 JMPBIND ROM@1dbra ; <a8.0><e5.5>
endwith
endproc
;====================================================================== <5>
; Set the smgrRect to 0 so that a mouse-down in the script icon is not
; handled by FilterMouse in GetOSEvent patch. Really undoing our patch to
; InitMenus; ugly, but necessary, if we don't want to completely patch out
; GetOSEvent.
; ----------------------------------------------------------------------------
proc
export ptchInitMenus
with smgrRecord
ptchInitMenus
move.l IntlSpec,a0
move.l sVectInitMenus(a0),a0
jsr (a0)
move.l IntlSpec,a0 ; prepare to stuff smgrRect!
lea smgrRect(a0),a0
move.l #0,(a0)+
move.l #0,(a0)
rts
endwith
endProc
;============================================================================= <10>
; GetOSEvent in the ROM ends by jumping to some Script Mgr code that checked
; events to see if they were script toggling events. Now we want to check if
; they are "keyboard changing events" - key-down or auto-key events that match
; a key combination in the 'KSWP' resource. To do this, we have to patch out
; GetOSEvent and the Script Mgr code it jumped to.
; ----------------------------------------------------------------------------
proc
export ptchGetOSEvent
;_______________________________________________________________________
;
; Routine: GetOSEvent
;
; Arguments: A0 (input) -- pointer to user event buffer (32-bit)
; D0 (input) -- type of event desired (event mask)
; D0 (output) -- 0=non-null event returned, -1=null event
; returned
;
; Function: This routine returns the next event in the system event queue.
; The returned event is dequeued, thereby freeing up the space
; which holds that queue element. If no events of the types
; enabled by the mask exist, the null event is returned.
;
; Calling sequence: MOVE.W #EventMask,D0
; LEA EventBuffer,A0
; _GetNextEvent
;
; Other: uses D0,D1,D2,A0,A1
;_______________________________________________________________________
EvtOffset EQU 6 ; event record offset from start of
; event queue element
ptchGetOSEvent
JSRBind ROMOSEventAvail ; first find the event
BNE.S @EventDone ; don't dequeue null or update events
MOVE.L A0,-(SP) ; save user's event record ptr
MOVE.L A1,A0 ; pointer to event queue element
LEA EventQueue,A1 ; A1 points to the queue
JSRBind ROMDequeue ; dequeue it (D0 destroyed)
MOVE #$FFFF,EvtNum+EvtOffset(A0) ; and release its storage
MOVE.L (SP)+,A0 ; restore user's event record ptr
; (needed by SMgrPostMunging)
MOVEQ #0,D0 ; exit with result code 0
@EventDone
; fall thru to newSMgrPostMunging
;_______________________________________________________________________
; newSMgrPostMunging
;
; Check key-down and auto-key events to see if they match a key combo
; in the 'KSWP' resource. If they do, call KeyScript with the
; corresponding verb from 'KSWP'.
;_______________________________________________________________________
modMask equ $fffb ; mask off capsLock key.
; a4.l Script Manager globals pointer.
; a3.l Keyboard globals pointer.
; a2.l Event record pointer.
newSMgrPostMunging
with SMgrRecord ; <12>
movem.l a0-a4/d0-d2,-(sp) ; save the registers.
GetSMgrCore a4 ; load SMgr globals.
move.l a0,a2 ; save the event pointer.
; If this is a keyDown event, check to see if the keyboard code and
; modifiers match any of the combinations in the keyboard swapping table.
;
; Copied this code in from ScriptMgrPatch.a.
FilterKey
cmp.w #keyDwnEvt,evtNum(a2) ; evtNum = keyDown?
beq.s @1 ; yes -> check message.
cmp.w #autoKeyEvt,evtNum(a2) ; evtNum = autoKey?
bne.s DoneEvent ; no -> bail out.
@1
move.l smgrKeySwap(a4),d0 ; swap table = nil?
beq.s DoneEvent ; yes -> skip key swapping.
move.l d0,a0 ; load swap table handle.
move.l (a0),a0 ; load swap table pointer.
move.l evtMessage(a2),d1 ; get event message
move.b evtMeta(a2),d1 ; get modifier keys.
and.w #modMask,d1 ; mask off alpha modifier.
@2
move.l (a0)+,d0 ; tuple = 0?
beq.s DoneEvent ; yes -> bail out.
cmp.w d0,d1 ; tuple = message?
bne.s @2 ; no -> try next tuple.
swap d0 ; get KeyScript verb.
; Change the current keyboard. Call KeyScript to load the new keyboard
; and to draw the keyboard icon in the menu bar. Remember to null out
; the event type and return that no events were available.
;
; Beginning with System 7, we only strip the event if it meaningful <12>
; in the current system - i.e., the KeyScript return code is true.
ScriptEvent
move.w d0,-(sp) ; push script code.
_KeyScript ; invoke the trap.
tst.b smgrKeyScriptResult(a4) ; Did KeyScript do something useful? <12>
beq.s DoneEvent ; if not, don't strip event <12>
move.w #nullEvt,evtNum(a2) ; null event type.
move.l MinusOne,(sp) ; return no event in d0.
; Restore the registers and return to the caller.
DoneEvent
movem.l (sp)+,a0-a4/d0-d2 ; restore the registers.
rts ; return to the caller.
endwith ;SMgrRecord ; <12>
endproc
;============================================================================= <12>
; Patch KeyTrans to skip the initial itlk processing if the KCHR pointer
; passed into KeyTrans is not the same as the one in emKeyCache (i.e., the
; itlk does not apply to this KCHR).
; ----------------------------------------------------------------------------
proc
export ptchKeyTrans
ktFrame record {a6link},decr
result ds.l 1 ; resulting ascii codes
kchrTable ds.l 1 ; KCHR table to use
codeMods ds.w 1 ; virtual key code, modifiers
deadState ds.l 1 ; dead key state pointer
return ds.l 1 ; return address
a6link ds.l 1 ; old link pointer
ktLocals equ * ; size of locals
kchrTableNoLink equ kchrTable-return ; kchrTable offset before link
endr
ptchKeyTrans
; bail if KCHR pointer is not same as in ExpandMem
with ExpandMemRec,ktFrame ;
move.l ExpandMem,a1 ;
move.l emKeyCache(a1),d1 ; Get KCHR pointer in ExpandMem
cmp.l kchrTableNoLink(sp),d1 ; same as KCHR pointer param?
bne.s @skipItlk ; if not, skip itlk handling
BackToTrap oldKeyTrans ; begin with itlk handling
@skipItlk
JmpBIND ROMKeyTransAfterItlk ; enter after itlk handling
endwith ;ExpandMemRec,ktFrame ;
endproc
;============================================================================= <12>
; Patch internal SwapKybd routine to force it to load 'KCHR' resources only
; from the System file.
; ----------------------------------------------------------------------------
proc
export ptchSwapKybd
SwapKybdRegs reg a2/a3/d4 ; added d4 <7/25/87med>
ptchSwapKybd
with smgrRecord,scriptRecord,ExpandMemRec
link a6,#0 ; link the stack.
movem.l SwapKybdRegs,-(sp) ; save the registers.
move.l expandMem,a3 ; load expandMemPtr
move.l emKeyCache(a3),a3 ; get pointer to key cache
; Load the KCHR resource from the system file.
@LoadKybd
move.w CurMap,-(sp) ; leave cur resfile refnum on stack <12>
clr.w -(sp) ; specify system file <12>
_UseResFile ; <12>
sub.l #4,sp ; make room for handle.
move.l #'KCHR',-(sp) ; push KCHR type.
GetSMgrCore a0 ; load smgrCore pointer.
move.w smgrKeyScript(a0),d0 ; get key script code.
lsl.w #2,d0 ; convert to long offset.
move.l smgrEntry(a0,d0.w),a0 ; get key script entry.
move.w scriptBundle.itlbKeys(a0),d4 ; save KCHR id number in d4É <13>
move.w d4,-(sp) ; and push it <13>
move.w #-1,RomMapInsert ; look for KCHR in ROM and load.
_GetResource ; get the KCHR resource.
move.l (sp)+,a2 ; load handle
move.l a2,d0 ; handle = nil? <13>
; if no KCHR, restore resfile and exit <13>
bne.s @loadItlk ; no - go load itlk. OtherwiseÉ
_UseResFile ; restore old resfile (refnum on stack)
bra.s DoneKybd ; bail, keep old KCHR & itlk.
@loadItlk
; if we already have an itlk, dispose of it <13>
GetSMgrCore a0 ;
move.l smgrCurITLK(a0),d0 ; have old handle?
beq.s @noOld ; no -> skip dispose
clr.l smgrCurITLK(a0) ; clear the handle storage
move.l d0,a0 ; copy itlk handle
_DisposHandle ; dispose of the itlk
@noOld
; load the itlk resource, detach it, and store its handle <13>
subq #4,sp ; make room for handle
move.l #'itlk',-(sp) ; push resource type
move.w d4,-(sp) ; push resource ID number
_GetResource ; load the resource
move.l (sp)+,d0 ; found the itlk resource?
beq.s @noNew ; no -> skip installation
GetSMgrCore a0 ;
move.l d0,smgrCurITLK(a0) ; save new itlk handle
move.l d0,-(sp) ; push itlk handle
_DetachResource ; detach from system file
@noNew
; restore previous resource file
_UseResFile ; restore old resfile (refnum on stack) <12><13>
JmpBIND ROMSwapKybdLockKCHR ; <12><13>
DoneKybd ; <13>
movem.l (sp)+,SwapKybdRegs ; restore the registers.
unlk a6 ; unlink the stack.
rts ; return to the caller.
endwith ;smgrRecord,scriptRecord,ExpandMemRec
endproc
;============================================================================= <16>
; Come-from after patch on ValidDate to fix bug in Toggledate. <16>
; ---------------------------------------------------------------------------- <16>
; <16>
proc ; <16>
export ptchValidDate ; <16>
; <16>
ptchValidDate ; <16>
CMPBIND ROMTogDateAfterValDate,(sp) ; coming from ROM ToggleDate? <16>
bne.s @doROMroutine ; if not, just continue <16>
lea ptchToggleDate,a0 ; get our patch address <16>
move.l a0,(sp) ; make ValidDate return to it <16>
@doROMroutine ; <16>
JMPBIND ROMValidDate ; continue with routine <16>
; <16>
; Copied from ScriptMgrUtilDate.a ; <16>
ToggleDateRec record {oldA6},decr ; <16>
resultSize equ 2 ; <16>
funcResult ds.w 1 ; <16>
argSize equ *-8 ; <16>
mySecsPtr ds.l 1 ; <16>
field ds.w 1 ; <16>
delta ds.w 1 ; <16>
ch ds.w 1 ; <16>
paramsPtr ds.l 1 ; <16>
selector ds.l 1 ; <16>
return ds.l 1 ; <16>
oldA6 ds.l 1 ; <16>
dateTime0 ds LongDateRec ; <16>
dateTime1 ds LongDateRec ; <16>
dateTime2 ds LongDateRec ; <16>
newDate ds LongDateTime ; <16>
myTogFlags ds.l 1 ; modified copy of togFlags <16>
localFrame equ * ; <16>
endr ; <16>
; <16>
ptchToggleDate ; <16>
; at this point we are near the end of internal xValidDate routine <16>
move.w (sp)+,d0 ; pop ValidDate result, set cc <16>
;; rts ; instead of returningÉ <16>
; Éwe leave return addr on stack, check which of the five possible <16>
; return addresses it is, and dispatch to the new patch (one of 5) <16>
; that corresponds to the old return address. I first tried to pop <16>
; the old return address into a register and do the CMPBIND against <16>
; the register, but the assembler optimizes this to a cmpa.w, which <16>
; breaks the FixRomAddresses macro. <16>
lea @1,a0 ; assume first patch <16>
CMPBIND ROMbltSetNewDate2,(sp) ; but check return for second <16>
blo.s @xValidDateReturn ; if before, we want first <16>
lea @2,a0 ; try second <16>
beq.s @xValidDateReturn ; if equal, we want second <16>
lea @3,a0 ; now assume third patch <16>
CMPBIND ROMdbltFinerLoop4,(sp) ; but check return for fourth <16>
blo.s @xValidDateReturn ; if before, we want third <16>
lea @4,a0 ; try fourth <16>
beq.s @xValidDateReturn ; if equal, we want fourth <16>
lea @5,a0 ; use fifth! <16>
@xValidDateReturn ; simulate return from xValidDate: <16>
addq #4,sp ; discard old return address <16>
tst.w d0 ; reset condition codes <16>
jmp (a0) ; and jump to correct patch <16>
; <16>
@1 blt.s SetNewDate ; <16>
JMPBIND ROMAfterBltSetNewDate1 ; <16>
; <16>
@2 blt.s SetNewDate ; <16>
JMPBIND ROMAfterBltSetNewDate2 ; <16>
; <16>
@3 blt.s SetNewDate ; <16>
JMPBIND ROMAfterBltSetNewDate3 ; <16>
; <16>
@FinerLoop ; <16>
sub.w #1,(a3) ; drop <16>
bsr.s xValidDate ; is it ok? <16>
@4 dblt d5,@FinerLoop ; til done <16>
blt.s SetNewDate ; yes, exit <16>
JMPBIND ROMAfterBltSetNewDate4 ; <16>
; <16>
@BackwardsLoop ; <16>
add.w d3,(a2) ; bump <16>
bsr.s xValidDate ; is it ok? <16>
@5 dblt d5,@BackwardsLoop ; yes, exit <16>
blt.s SetNewDate ; with correct date from ValidDate <16>
JMPBIND ROMAfterBltSetNewDate5 ; <16>
; <16>
; Other fragments: <16>
; <16>
; For xValidDate, we cannot just jump into ROM, because the xValidDate <16>
; return addresses will not match the expectations of the above patch. <16>
; <16>
; The fragment after the SetNewDate label contains the real fix we are making. <16>
; <16>
with ToggleDateRec ; <16>
xValidDate ; <16>
clr.w -(sp) ; allocate return <16>
pea dateTime0(a6) ; pass @datetime0 <16>
move.l myTogFlags(a6),-(sp) ; pass adjusted togFlags <16>
pea newDate(a6) ; pass @newDate <16>
_ValidDate ; call it <16>
move.w (sp)+,d0 ; pop result <16>
rts ; <16>
; <16>
SetNewDate ; <16>
lea newDate(a6),a0 ; source <16>
move.l mySecsPtr(a6),a1 ; dest <16>
move.w #4-1,d0 ; dbra word cound <fixed!> <16>
JMPBIND ROMbsrCopyDateLoop ; <16>
; <16>
endwith ;ToggleDateRec ; <16>
endproc ; <16>
;============================================================================= <17>
; Patch out GetFormatOrder entirely to fix trashing of d3. <17>
; ---------------------------------------------------------------------------- <17>
proc
export ptchFormatOrder
FormatOrderFrame record {oldA6},decrement
resultSize equ 0
argSize equ *-8
ordering ds.l 1
firstFormat ds.w 1
lastFormat ds.w 1
filler ds.b 1
lineRight ds.b 1 ; high byte from pascal <2/10/88med>
DirProc ds.l 1
dirParam ds.l 1
selector ds.l 1
return ds.l 1
oldA6 ds.l 1
localFrame equ *
endR
FormatOrderRegs reg a2-a3/d3-d6 ; Now include d3 <17>
;____________________________________________________________
ptchFormatOrder
with FormatOrderFrame
CheckSelector
link a6,#localFrame
movem.l FormatOrderRegs,-(sp)
; consistency check
move.l ordering(a6),a2 ; get ordering
move.w firstFormat(a6),d3 ; get start
move.w lastFormat(a6),d4 ; get end
cmp.w d3,d4 ; same?
ble.s @Exit ; lastFormat ² firstFormat, leave array alone.
@FillArray
; {fill the array with initial values, going in lineDirection order}
move.l DirProc(a6),a3 ; get dirProc
move.l #2,d5 ; set pointer increment
move.b lineRight(a6),d6 ; right-left?
beq.s @InvertLoop ; no, continue
move.w d4,d0 ; get last element
sub.w d3,d0 ; last-first
add.w d0,d0 ; for word array
add.w d0,a2 ; last element
neg.w d5 ; invert pointer increment
@InvertLoop
clr.b -(sp) ; allocate return
move.w d3,-(sp) ; pass i
move.l dirParam(a6),-(sp) ; pass dirParam
jsr (a3) ; call it
move.w d3,d1 ; set temp
cmp.b (sp)+,d6 ; get result: same as lineRight?
beq.s @1 ; yes, skip
not.w d1 ; invert
@1
move.w d1,(a2) ; set value
add.w d5,a2 ; increment array pointer
add.w #1,d3 ; i := i+1
cmp.w d3,d4 ; same?
bge.s @InvertLoop ; no, keep looping
; {walk through the array, reversing the odd direction clusters (inverted)}
@WalkArray
sub.w firstFormat(a6),d4 ; now # elements + 1
move.l #-1,d5 ; mark as no first backwards element
clr.w d3 ; i := 0
move.l ordering(a6),a2 ; get ordering
move.l a2,a3 ; for increment
@RevLoop
tst.w (a3)+ ; get value
bge.s @BadOrder ; correct order
tst.w d5 ; have first backwards element?
bge.s @RevContinue ; yes, continue
move.w d3,d5 ; mark first backwards element
bra.s @RevContinue ; continue
@BadOrder
tst.w d5 ; have first backwards element?
blt.s @RevContinue ; no, continue
JSRBIND ROMReverseCluster ; ReverseCluster(j, i - 1) <17>
move.l #-1,d5 ; mark no first backwards element.
@RevContinue
add.w #1,d3 ; inc
cmp.w d3,d4 ; at end?
bge.s @RevLoop ; no, continue
tst.w d5 ; got one?
blt.s @Exit ; no, continue
JSRBIND ROMReverseCluster ; ReverseCluster(j, limit); <17>
@Exit
; cleanup
movem.l (sp)+,FormatOrderRegs
CheckA6
JMPBIND ROMEndFormatOrder ; <17>
endproc
;============================================================================= <21>
; Replace Roman dispatcher with version that handles nil entries in
; dispatch table.
; ----------------------------------------------------------------------------
proc
export ptchRomanScript
ptchRomanScript
with SMgrRecord,ScriptRecord
move.l 4(sp),d0 ; get selector
GetSMgrCore a1 ; set up ptr to SMgrRecord <24>
move.l smgrEntry+(smRoman*4)(a1),a1 ; now set up ptr to Roman ScriptRecord <24>
cmp.w scriptDispHigh(a1),d0 ; selector past max script sys call? <24>
bhi BitBucket ; clean up stack and fake the call <6/7/88ldc>
sub.w scriptDispLow(a1),d0 ; make word offset from table start <24>
add.w d0,d0 ; make a long offset
move.l scriptDispTable(a1),a1 ; get table ptr <24>
move.l 0(a1,d0.w),d0 ; get routine vector from table <21><24>
beq BitBucket ; if nil, bail <21>
move.l a0,4(sp) ; replace selector with ScriptRecord ptr <24>
move.l d0,a0 ; copy vector <21>
jmp (a0) ; now jump to it
endwith
BitBucket
JMPBIND ROMBitBucket ; <21>
endproc
;============================================================================= <23>
; Patch beginning of Roman FindWord so that it handles custom break tables
; without checking the itl2 resource.
; This also replaces the FindWord part of the PACK 6 patch above.
; ----------------------------------------------------------------------------
proc
export ptchRomanFindWord
fwRecord record {a6link},decr
fwArgs equ *-8 ; size of arguments.
pointer ds.l 1 ; Text pointer.
length ds.w 1 ; Text length.
offset ds.w 1 ; First offset.
left ds.w 1 ; LeftSide flag.
option ds.l 1 ; Optional tuple table.
table ds.l 1 ; array of offsets.
scriptRecPtr ds.l 1 ; ScriptRecord pointer <24>
return ds.l 1 ; return address.
a6link ds.l 1 ; old a6 register.
fwLocals equ * ; size of local variables.
endr
ptchRomanFindWord
with fwRecord
link a6,#fwLocals ; link the stack.
movem.l d3-d7/a2-a4,-(sp) ; save the registers.
; Load the registers with the basic parameters.
move.l table(a6),a2 ; get offset array.
move.l pointer(a6),a3 ; get text pointer.
move.w offset(a6),d4 ; get first offset.
move.w length(a6),d7 ; get text length.
; Find the word that has the offset in it and return its limits. First,
; determine the starting offset based on the text offset, length, and
; leftSide flag.
tst.b left(a6) ; if leftSide is false,
bne.s @1 ; subtract one from
sub.w #1,d4 ; the offset.
@1 move.l #0,d3 ; left is zero.
move.l d3,d5 ; right is zero.
tst.w d4 ; if offset < 0,
blt storeOffsets ; return to caller.
move.l d7,d3 ; left is length.
move.l d7,d5 ; right is length.
cmp.w d7,d4 ; if offset >= length,
bge storeOffsets ; return to caller.
; Next, prime all of the registers for the search in both directions. We
; determine here which god-forsaken table the user wants.
FoundOffset
MOVE.L option(A6),D0 ; check for 0 <23>
BEQ.S @UseDefault ; if default word select table, go get it <23>
CMP.L #-1,D0 ; check for -1 <23>
BEQ.S @UseDefault ; if default word wrap table, go get it <23>
MOVE.L D0,A1 ; have pointer to custom table <23>
BRA.S @LoadOffsets ; continue with it <23>
@UseDefault
;; clr.w d2 ; sysFlag=0; script code in hi word
;; swap d2 ; put where they belong
move.l scriptRecPtr(a6),a0 ; ScriptRecord ptr (maybe nonRoman) <24>
moveq #0,d2 ; sysFlag=0 in hi word <24>
move.b ScriptRecord.scriptID(a0),d2 ; script code in low word <24>
clr.l -(sp) ; space for returned handle
move.w #2,-(sp) ; select itl2
move.l d2,-(sp) ; two arguments: script code, sysFlag=0
_IUGetScriptItl ; may trash a0,a1,d0-d2
JMPBIND ROMfwAfterGetIntl ; <23>
@LoadOffsets
JMPBIND ROMfwLoadOffsets ; <23>
storeOffsets
JMPBIND ROMfwstoreOffsets ; <23>
endwith ;fwRecord
endproc
; =============================================================================
; END RESIDENT CODE
; =============================================================================
CutBackPt proc Export
; EntryTable YourTrap,YourTrapID
EntryTable 0 ; <=== Last table entry
EndProc
; =============================================================================
; BEGIN INSTALL CODE
; =============================================================================
proc
export SMgrInstallPatch
SMgrInstallPatch ; init routine
import CutBackPt,CodeEntry
; The FixRomAddresses macro has to be located after the last bind macro in the
; code, but has to be executed before any of them. So we put it at the end and
; BSR to it.
bsr DoFixRomAddresses
with SMgrRecord
movem.l d3/a2-a4,-(sp)
; =============================================================================
; Begin init code that is not excluded for A/UX (always installed)
; Initially, everything was here, since this patch file was not loaded for A/UX. <8>
; Now, if this patch is loaded for A/UX (doScriptMgrForAUX is TRUE), we need to
; create a block that is excluded for A/UX and move OS-specific installs there.
; =============================================================================
;________________________________________________________________ <a4.3><e3.7>
; Patch to Pack6 to fix Script Manager routines
;
InstToolTp ptchPack6,$1ED
;____________________________________________________________________________
; Bump Script Manager version number for IntlForce bug fix (SysVers < $700) <a5.3><e4.2>
; Set Script Manager version (SysVers >= $700) <a5.7><e4.4>
; redo using new symbol smgrVersPTCHRom <a5.9><e4.5>
GetSMgrCore a0
move.w #smgrVersPriv,smgrVersion(a0)
;____________________________________________________________________________
; Initialize additional Script Manager vectors <a5.4><e4.3>
; Add CallInterface <a5.9><e4.5>
; Moved NewSwapIcon setup below <4>
; GetSMgrCore a0 ; already set up <23>
LEABIND ROMSMgrCalcRect,a1
move.l a1,sVectSMgrCalcRect(a0)
LEABIND ROMSMgrInitFonts,a1
move.l a1,sVectSMgrInitFonts(a0)
LEABIND ROMCallInterface,a1 ; <a5.9><e4.5>
move.l a1,sVectCallInterface(a0) ; <a5.9><e4.5>
;____________________________________________________________________________
; Use NewSwapIcon <4>
import NewSwapIcon ; <a6.2><e4.7>
; GetSMgrCore a0 ; already set up
lea NewSwapIcon,a1 ; <a6.2><e4.7><a6.7><e5.4>
move.l a1,sVectSwapIcon(a0) ; <a6.2><e4.7>
;____________________________________________________________________________ <a7.8><e5.4>
; Install patches for Script Manager routines InitDateCache, String2Date
smInitDateCacheOff equ -16 ; DispTable offset for InitDateCache
smString2DateOff equ -20 ; DispTable offset for String2Date
smValidDateOff equ -56 ; DispTable offset for ValidDate <16>
smFormatOrderOff equ -08 ; DispTable offset for GetFormatOrder <17>
GetSMgrCore a1
move.l smgrDispTable(a1),a1
lea NewInitDateCache,a0
move.l a0,smInitDateCacheOff(a1)
lea NewString2Date,a0
move.l a0,smString2DateOff(a1)
lea ptchValidDate,a0 ; <16>
move.l a0,smValidDateOff(a1) ; <16>
lea ptchFormatOrder,a0 ; <17>
move.l a0,smFormatOrderOff(a1) ; <17>
;____________________________________________________________________________ <5>
; Installing tail patch to InitMenus to fix up smgrRect.
import ptchInitMenus
move.w #$130,d0 ; InitMenus trap address
_GetTrapAddress ; returns in a0
move.l IntlSpec,a1
move.l a0,sVectInitMenus(a1)
InstToolTp ptchInitMenus,$130
;____________________________________________________________________________ <12>
; Installing KeyTrans patch for itlk handling.
import ptchKeyTrans
PatchToolJump oldKeyTrans,$1C3 ; set addr for BackToTrap
InstToolTp ptchKeyTrans,$1C3
;____________________________________________________________________________ <12>
; Patch SwapKybd to force loading of KCHRs from System file.
import ptchSwapKybd
GetSMgrCore a0
lea ptchSwapKybd,a1
move.l a1,sVectSwapKybd(a0)
;____________________________________________________________________________ <21>
; Install updated Roman dispatcher.
import ptchRomanScript
with ScriptRecord
;; GetSMgrCore a0 ; already have this from above
move.l smgrEntry+(smRoman*4)(a0),a0 ; get ptr to Roman ScriptRecord <21>
lea ptchRomanScript,a1 ; get new dispatcher address <21>
move.l a1,scriptTrap(a0) ; install it <21>
endwith ;ScriptRecord
;____________________________________________________________________________ <23>
; Install patches to Roman FindWord
import ptchRomanFindWord
with ScriptRecord
GetSMgrCore a0 ; <23>
move.l smgrEntry+(smRoman*4)(a0),a0 ; get ptr to Roman ScriptRecord <23>
move.l scriptDispTable(a0),a1 ; get ptr to Roman disp table <23>
move.w scriptDispLow(a0),d0 ; get low selector handled by table <23>
add.w d0,d0 ; make long offset <23>
sub.w d0,a1 ; adjust to point where entry for selector <23>
; 0 would go if it were in the table <23>
lea ptchRomanFindWord,a0 ; <23>
move.l a0,2*smFindWord(a1) ; <23>
endwith ;ScriptRecord
; =============================================================================
; Begin init code that is excluded for A/UX (only installed if not A/UX).
; =============================================================================
; Runtime check to determine whether we are running A/UX. <8>
; If so, skip this section of patch install code.
move.w HwCfgFlags,d0 ; check Ôem the compulsive way
btst.l #hwCbAUX,d0 ; is it A/UX time?
bne EndMacOnlySection ; if so skip the mac-only patches
;____________________________________________________________________________ <a8.0><e5.5><8>
; Install Script Manager tail patch to _GetIndADB, fixes the way SwapKybd
; clears dead key state in ADB keyboard driver data structure
PatchOSJump oldGetIndADB,$78 ; set addr for BackToTrap
InstOSTp ptchGetIndADB,$78 ; Éand then install patch
;____________________________________________________________________________ <10>
; Installing GetOSEvent patch for keyboard switching via key combos.
; Don't install if A/UX running. <12>
import ptchGetOSEvent
InstOSTp ptchGetOSEvent,$31
;____________________________________________________________________________
EndMacOnlySection
; =============================================================================
; end init code
; =============================================================================
@exit
movem.l (sp)+,d3/a2-a4
lea CutBackPt,a0 ; <=== Keep these two linesÉ
rts ; <=== in any case
@errExit
move.w #dsSysErr,d0 ; load generic error
_SysError ; system error!
bra.s @exit
endwith
DoFixRomAddresses
FixRomAddresses ; new macro
rts
endproc
END