mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-12-22 23:29:27 +00:00
4325cdcc78
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.
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
|