; ; 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,: 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,: 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,: 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,: 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 ; ; <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' ; INCLUDE 'ApplDeskBus.a' ; INCLUDE 'PackMacs.a' ; 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. ; Also fixes another problem in LwrString, CharType, Transliterate, FindWord: ; These routines need to get itl2 tables that apply to the current font script. ; 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 ; 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 ; 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 ; 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 ; itl1Format equ itl1Version+2 ; calendarcode equ itl1Format+2 ; 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 ; theMonths DS.B MonthList ; 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 . ; ---------------------------------------------------------------------------- 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 ; 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 ; 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 ; 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 ; Exit JMPBIND ROMExit ; 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 MOVE.L d4,A1 ; into local frame moveq #0,d0 ; Block2String wants a long! 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 ADD.L #Str15,d4 ; get next string to transfer ADD.w #Str15,A4 ; into next string in local frame 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: É ; ---------------------------------------------------------------------------- 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 ; 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 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 ; bra @TokenRecognized ; get next token (remove .s) @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 <3> TST.W D4 BPL.S @SearchForDay ; ; 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) ; MOVE.W #DayMonthLen,-(SP) MOVE.W #NumMonths+NumDays,-(SP) ; check for both at once JSRBIND ROMMatchString ; 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 @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 ; 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 @HaveDay ; ST DayFound(A6) ; record that day was found 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> ;====================================================================== ; 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! JMPBIND ROMAfterClrDeadKey ; @1 JMPBIND ROM@1dbra ; 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 <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. ; ============================================================================= ;________________________________________________________________ ; Patch to Pack6 to fix Script Manager routines ; InstToolTp ptchPack6,$1ED ;____________________________________________________________________________ ; Bump Script Manager version number for IntlForce bug fix (SysVers < $700) ; Set Script Manager version (SysVers >= $700) ; redo using new symbol smgrVersPTCHRom GetSMgrCore a0 move.w #smgrVersPriv,smgrVersion(a0) ;____________________________________________________________________________ ; Initialize additional Script Manager vectors ; Add CallInterface ; 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 ; move.l a1,sVectCallInterface(a0) ; ;____________________________________________________________________________ ; Use NewSwapIcon <4> import NewSwapIcon ; ; GetSMgrCore a0 ; already set up lea NewSwapIcon,a1 ; move.l a1,sVectSwapIcon(a0) ; ;____________________________________________________________________________ ; 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 ;____________________________________________________________________________ <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