mirror of
https://github.com/elliotnunn/sys7.1-doc-wip.git
synced 2024-06-11 07:29:33 +00:00
2313 lines
85 KiB
Plaintext
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
|