utility.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931
  1. {
  2. This file is part of the Free Pascal run time library.
  3. A file in Amiga system run time library.
  4. Copyright (c) 1998-2003 by Nils Sjoholm
  5. member of the Amiga RTL development team.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {
  13. History:
  14. Added functions and procedures with array of const.
  15. For use with fpc 1.0.7. Thay are in systemvartags.
  16. 11 Nov 2002.
  17. Added the define use_amiga_smartlink.
  18. 13 Jan 2003.
  19. Update for AmigaOS 3.9.
  20. Added a few overlays.
  21. 06 Feb 2003.
  22. [email protected]
  23. }
  24. {$I useamigasmartlink.inc}
  25. {$ifdef use_amiga_smartlink}
  26. {$smartlink on}
  27. {$endif use_amiga_smartlink}
  28. unit utility;
  29. INTERFACE
  30. uses exec;
  31. Type
  32. pClockData = ^tClockData;
  33. tClockData = record
  34. sec : Word;
  35. min : Word;
  36. hour : Word;
  37. mday : Word;
  38. month : Word;
  39. year : Word;
  40. wday : Word;
  41. END;
  42. pHook = ^tHook;
  43. tHook = record
  44. h_MinNode : tMinNode;
  45. h_Entry : Pointer; { assembler entry point }
  46. h_SubEntry : Pointer; { often HLL entry point }
  47. h_Data : Pointer; { owner specific }
  48. END;
  49. {
  50. * Hook calling conventions:
  51. * A0 - pointer to hook data structure itself
  52. * A1 - pointer to parameter structure ("message") typically
  53. * beginning with a longword command code, which makes
  54. * sense in the context in which the hook is being used.
  55. * A2 - Hook specific address data ("object," e.g, GadgetInfo)
  56. *
  57. * Control will be passed to the routine h_Entry. For many
  58. * High-Level Languages (HLL), this will be an assembly language
  59. * stub which pushes registers on the stack, does other setup,
  60. * and then calls the function at h_SubEntry.
  61. *
  62. * The C standard receiving code is:
  63. * CDispatcher( hook, object, message )
  64. * struct Hook *hook;
  65. * APTR object;
  66. * APTR message;
  67. *
  68. * NOTE that register natural order differs from this convention
  69. * for C parameter order, which is A0,A2,A1.
  70. *
  71. * The assembly language stub for "vanilla" C parameter conventions
  72. * could be:
  73. _hookEntry:
  74. move.l a1,-(sp) ; push message packet pointer
  75. move.l a2,-(sp) ; push object pointer
  76. move.l a0,-(sp) ; push hook pointer
  77. move.l h_SubEntry(a0),a0 ; fetch C entry point ...
  78. jsr (a0) ; ... and call it
  79. lea 12(sp),sp ; fix stack
  80. rts
  81. * with this function as your interface stub, you can write
  82. * a Hook setup function as:
  83. SetupHook( hook, c_function, userdata )
  84. struct Hook *hook;
  85. ULONG (*c_function)();
  86. VOID *userdata;
  87. ULONG (*hookEntry)();
  88. hook->h_Entry = hookEntry;
  89. hook->h_SubEntry = c_function;
  90. hook->h_Data = userdata;
  91. * with Lattice C pragmas, you can put the C function in the
  92. * h_Entry field directly if you declare the function:
  93. ULONG __saveds __asm
  94. CDispatcher( register __a0 struct Hook *hook,
  95. register __a2 VOID *object,
  96. register __a1 ULONG *message );
  97. *
  98. ***}
  99. { Namespace definitions }
  100. Type
  101. { The named object structure }
  102. pNamedObject = ^tNamedObject;
  103. tNamedObject = record
  104. no_Object : Pointer; { Your pointer, for whatever you want }
  105. END;
  106. const
  107. { Tags for AllocNamedObject() }
  108. ANO_NameSpace = 4000; { Tag to define namespace }
  109. ANO_UserSpace = 4001; { tag to define userspace }
  110. ANO_Priority = 4002; { tag to define priority }
  111. ANO_Flags = 4003; { tag to define flags }
  112. { Flags for tag ANO_Flags }
  113. NSB_NODUPS = 0;
  114. NSB_CASE = 1;
  115. NSF_NODUPS = 1; { Default allow duplicates }
  116. NSF_CASE = 2; { Default to caseless... }
  117. { Control attributes for Pack/UnpackStructureTags() }
  118. { PackTable definition:
  119. *
  120. * The PackTable is a simple array of LONGWORDS that are evaluated by
  121. * PackStructureTags() and UnpackStructureTags().
  122. *
  123. * The table contains compressed information such as the tag offset from
  124. * the base tag. The tag offset has a limited range so the base tag is
  125. * defined in the first longword.
  126. *
  127. * After the first longword, the fields look as follows:
  128. *
  129. * +--------- 1 = signed, 0 = unsigned (for bits, 1=inverted boolean)
  130. * |
  131. * | +------ 00 = Pack/Unpack, 10 = Pack, 01 = Unpack, 11 = special
  132. * | / \
  133. * | | | +-- 00 = Byte, 01 = Integer, 10 = Long, 11 = Bit
  134. * | | | / \
  135. * | | | | | /----- For bit operations: 1 = TAG_EXISTS is TRUE
  136. * | | | | | |
  137. * | | | | | | /-------------------- Tag offset from base tag value
  138. * | | | | | | | \
  139. * m n n o o p q q q q q q q q q q r r r s s s s s s s s s s s s s
  140. * \ | | |
  141. * Bit offset (for bit operations) ----/ | |
  142. * \ |
  143. * Offset into data structure -----------------------------------/
  144. *
  145. * A -1 longword signifies that the next longword will be a new base tag
  146. *
  147. * A 0 longword signifies that it is the end of the pack table.
  148. *
  149. * What this implies is that there are only 13-bits of address offset
  150. * and 10 bits for tag offsets from the base tag. For most uses this
  151. * should be enough, but when this is not, either multiple pack tables
  152. * or a pack table with extra base tags would be able to do the trick.
  153. * The goal here was to make the tables small and yet flexible enough to
  154. * handle most cases.
  155. }
  156. const
  157. PSTB_SIGNED =31;
  158. PSTB_UNPACK =30; { Note that these are active low... }
  159. PSTB_PACK =29; { Note that these are active low... }
  160. PSTB_EXISTS =26; { Tag exists bit true flag hack... }
  161. PSTF_SIGNED = $80000000;
  162. PSTF_UNPACK = $40000000;
  163. PSTF_PACK = $20000000;
  164. PSTF_EXISTS = $4000000;
  165. {***************************************************************************}
  166. PKCTRL_PACKUNPACK = $00000000;
  167. PKCTRL_PACKONLY = $40000000;
  168. PKCTRL_UNPACKONLY = $20000000;
  169. PKCTRL_BYTE = $80000000;
  170. PKCTRL_WORD = $88000000;
  171. PKCTRL_LONG = $90000000;
  172. PKCTRL_UBYTE = $00000000;
  173. PKCTRL_UWORD = $08000000;
  174. PKCTRL_ULONG = $10000000;
  175. PKCTRL_BIT = $18000000;
  176. PKCTRL_FLIPBIT = $98000000;
  177. {***************************************************************************}
  178. { Macros used by the next batch of macros below. Normally, you don't use
  179. * this batch directly. Then again, some folks are wierd
  180. }
  181. {***************************************************************************}
  182. { Some handy dandy macros to easily create pack tables
  183. *
  184. * Use PACK_STARTTABLE() at the start of a pack table. You pass it the
  185. * base tag value that will be handled in the following chunk of the pack
  186. * table.
  187. *
  188. * PACK_ENDTABLE() is used to mark the end of a pack table.
  189. *
  190. * PACK_NEWOFFSET() lets you change the base tag value used for subsequent
  191. * entries in the table
  192. *
  193. * PACK_ENTRY() lets you define an entry in the pack table. You pass it the
  194. * base tag value, the tag of interest, the type of the structure to use,
  195. * the field name in the structure to affect and control bits (combinations of
  196. * the various PKCTRL_XXX bits)
  197. *
  198. * PACK_BYTEBIT() lets you define a bit-control entry in the pack table. You
  199. * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  200. * affects. This macro should be used when the field being affected is byte
  201. * sized.
  202. *
  203. * PACK_WORDBIT() lets you define a bit-control entry in the pack table. You
  204. * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  205. * affects. This macro should be used when the field being affected is Integer
  206. * sized.
  207. *
  208. * PACK_LONGBIT() lets you define a bit-control entry in the pack table. You
  209. * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  210. * affects. This macro should be used when the field being affected is longword
  211. * sized.
  212. *
  213. * EXAMPLE:
  214. *
  215. * ULONG packTable[] =
  216. * (
  217. * PACK_STARTTABLE(GA_Dummy),
  218. * PACK_ENTRY(GA_Dummy,GA_Left,Gadget,LeftEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  219. * PACK_ENTRY(GA_Dummy,GA_Top,Gadget,TopEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  220. * PACK_ENTRY(GA_Dummy,GA_Width,Gadget,Width,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  221. * PACK_ENTRY(GA_Dummy,GA_Height,Gadget,Height,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  222. * PACK_WORDBIT(GA_Dummy,GA_RelVerify,Gadget,Activation,PKCTRL_BIT|PKCTRL_PACKUNPACK,GACT_RELVERIFY)
  223. * PACK_ENDTABLE
  224. * );
  225. }
  226. { ======================================================================= }
  227. { ==== TagItem ========================================================== }
  228. { ======================================================================= }
  229. { This data type may propagate through the system for more general use.
  230. * In the meantime, it is used as a general mechanism of extensible data
  231. * arrays for parameter specification and property inquiry (coming soon
  232. * to a display controller near you).
  233. *
  234. * In practice, an array (or chain of arrays) of TagItems is used.
  235. }
  236. Type
  237. Tag = LongInt;
  238. pTag = ^Tag;
  239. pTagItem = ^tTagItem;
  240. tTagItem = record
  241. ti_Tag : Tag;
  242. ti_Data : LongInt;
  243. END;
  244. ppTagItem = ^pTagItem;
  245. { ---- system tag values ----------------------------- }
  246. CONST
  247. TAG_DONE = 0; { terminates array of TagItems. ti_Data unused }
  248. TAG_END = TAG_DONE;
  249. TAG_IGNORE = 1; { ignore this item, not END of array }
  250. TAG_MORE = 2; { ti_Data is pointer to another array of TagItems
  251. * note that this tag terminates the current array
  252. }
  253. TAG_SKIP = 3; { skip this AND the next ti_Data items }
  254. { differentiates user tags from control tags }
  255. TAG_USER = $80000000; { differentiates user tags from system tags}
  256. {* If the TAG_USER bit is set in a tag number, it tells utility.library that
  257. * the tag is not a control tag (like TAG_DONE, TAG_IGNORE, TAG_MORE) and is
  258. * instead an application tag. "USER" means a client of utility.library in
  259. * general, including system code like Intuition or ASL, it has nothing to do
  260. * with user code.
  261. *}
  262. { Tag filter logic specifiers for use with FilterTagItems() }
  263. TAGFILTER_AND = 0; { exclude everything but filter hits }
  264. TAGFILTER_NOT = 1; { exclude only filter hits }
  265. { Mapping types for use with MapTags() }
  266. MAP_REMOVE_NOT_FOUND = 0; { remove tags that aren't in mapList }
  267. MAP_KEEP_NOT_FOUND = 1; { keep tags that aren't in mapList }
  268. Type
  269. pUtilityBase = ^tUtilityBase;
  270. tUtilityBase = record
  271. ub_LibNode : tLibrary;
  272. ub_Language : Byte;
  273. ub_Reserved : Byte;
  274. END;
  275. function AddNamedObject(nameSpace,obj : pNamedObject) : Boolean;
  276. function AllocateTagItems(num : ULONG) : pTagItem;
  277. function AllocNamedObjectA(const name : STRPTR;const TagList : pTagItem) : pNamedObject;
  278. procedure Amiga2Date(amigatime : ULONG;resultat : pClockData);
  279. procedure ApplyTagChanges(TagList : pTagItem; const ChangeList : pTagItem);
  280. function AttemptRemNamedObject(obj : pNamedObject) : LongInt;
  281. function CallHookPkt(h : pHook;obj, paramPkt : APTR) : ULONG;
  282. function CheckDate(const date : pClockData) : ULONG;
  283. function CloneTagItems(const tagList : pTagItem) : pTagItem;
  284. function Date2Amiga(const date : pClockData) : ULONG;
  285. procedure FilterTagChanges(changelist, oldvalues : pTagItem;apply : ULONG);
  286. function FilterTagItems(taglist : pTagItem ;const tagArray : pULONG;logic : ULONG) : ULONG;
  287. function FindNamedObject(nameSpace : pNamedObject;const name : STRPTR;lastobject: pNamedObject) : pNamedObject;
  288. function FindTagItem(TagVal : Tag;const TagList : pTagItem) : pTagItem;
  289. procedure FreeNamedObject(Obj : pNamedObject);
  290. procedure FreeTagItems(TagList : pTagItem);
  291. function GetTagData(tagval : Tag;default : ULONG;const TagList : pTagItem) : ULONG;
  292. function GetUniqueID : ULONG;
  293. procedure MapTags(TagList : pTagItem;const maplist : pTagItem;IncludeMiss : ULONG);
  294. function NamedObjectName(Obj : pNamedObject) : STRPTR;
  295. function NextTagItem(Item : ppTagItem) : pTagItem;
  296. function PackBoolTags(InitialFlags : ULONG;const TagList, boolmap : pTagItem) : ULONG;
  297. function PackStructureTags(packk: APTR;const packTable : pULONG;const TagList : pTagItem) : ULONG;
  298. procedure RefreshTagItemClones(cloneTagItem : pTagItem; const OriginalTagItems : pTagItem);
  299. procedure ReleaseNamedObject(Obj : pNamedObject);
  300. procedure RemNamedObject(Obj : pNamedObject;Msg : pointer);
  301. function SDivMod32( dividend , divisor : LongInt) : LongInt;
  302. function SMult32(Arg1, Arg2 : LongInt) : LongInt;
  303. function SMult64(Arg1, Arg2 : LongInt) : LongInt;
  304. function Stricmp(const Str1: STRPTR;const Str2 : STRPTR) : LongInt;
  305. function Strnicmp(const Str1: STRPTR;const Str2 : STRPTR;len : LongInt) : LongInt;
  306. function TagInArray(t : Tag;const TagArray : pULONG) : Boolean;
  307. function ToLower(c : ULONG) : Char;
  308. function ToUpper(c : ULONG) : Char;
  309. function UDivMod32( dividend , divisor : ULONG) : ULONG;
  310. function UMult32(Arg1, Arg2 : ULONG) : ULONG;
  311. function UMult64(Arg1, Arg2 : ULONG) : ULONG;
  312. function UnpackStructureTags(const pac: APTR;const packTable: pULONG;TagList : pTagItem) : ULONG;
  313. function AllocNamedObjectA(const name : string;const TagList : pTagItem) : pNamedObject;
  314. FUNCTION FindNamedObject(nameSpace : pNamedObject; CONST name : string; lastObject : pNamedObject) : pNamedObject;
  315. FUNCTION Stricmp(CONST string1 : string; CONST string2 : pCHAR) : LONGINT;
  316. FUNCTION Stricmp(CONST string1 : pCHAR; CONST string2 : string) : LONGINT;
  317. FUNCTION Stricmp(CONST string1 : string; CONST string2 : string) : LONGINT;
  318. FUNCTION Strnicmp(CONST string1 : string; CONST string2 : pCHAR; length : LONGINT) : LONGINT;
  319. FUNCTION Strnicmp(CONST string1 : pCHAR; CONST string2 : string; length : LONGINT) : LONGINT;
  320. FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGINT) : LONGINT;
  321. IMPLEMENTATION
  322. uses pastoc;
  323. function AddNamedObject(nameSpace,obj : pNamedObject) : Boolean;
  324. begin
  325. asm
  326. MOVE.L A6,-(A7)
  327. MOVE.L nameSpace,a0
  328. MOVE.L obj,a1
  329. MOVE.L _UtilityBase,A6
  330. JSR -222(A6)
  331. MOVE.L (A7)+,A6
  332. TST.L d0
  333. bne @success
  334. bra @end
  335. @success:
  336. move.b #1,d0
  337. @end:
  338. move.b d0,@RESULT
  339. end;
  340. end;
  341. function AllocateTagItems(num : ULONG) : pTagItem;
  342. begin
  343. asm
  344. MOVE.L A6,-(A7)
  345. MOVE.L num,d0
  346. MOVE.L _UtilityBase,A6
  347. JSR -066(A6)
  348. MOVE.L (A7)+,A6
  349. MOVE.L d0,@RESULT
  350. end;
  351. end;
  352. function AllocNamedObjectA(const name : STRPTR;const TagList : pTagItem) : pNamedObject;
  353. begin
  354. asm
  355. MOVE.L A6,-(A7)
  356. MOVE.L name,a0
  357. MOVE.L TagList,a1
  358. MOVE.L _UtilityBase,A6
  359. JSR -228(A6)
  360. MOVE.L (A7)+,A6
  361. MOVE.L d0,@RESULT
  362. end;
  363. end;
  364. procedure Amiga2Date(amigatime : ULONG;resultat : pClockData);
  365. begin
  366. asm
  367. MOVE.L A6,-(A7)
  368. MOVE.L amigatime,d0
  369. MOVE.L resultat,a0
  370. MOVE.L _UtilityBase,A6
  371. JSR -120(A6)
  372. MOVE.L (A7)+,A6
  373. end;
  374. end;
  375. procedure ApplyTagChanges(TagList : pTagItem;const ChangeList : pTagItem);
  376. begin
  377. asm
  378. MOVE.L A6,-(A7)
  379. MOVE.L TagList,a0
  380. MOVE.L ChangeList,a1
  381. MOVE.L _UtilityBase,A6
  382. JSR -186(A6)
  383. MOVE.L (A7)+,A6
  384. end;
  385. end;
  386. function AttemptRemNamedObject(obj : pNamedObject) : LongInt;
  387. begin
  388. asm
  389. MOVE.L A6,-(A7)
  390. MOVE.L obj,a0
  391. MOVE.L _UtilityBase,A6
  392. JSR -234(A6)
  393. MOVE.L (A7)+,A6
  394. MOVE.L d0,@RESULT
  395. end;
  396. end;
  397. function CallHookPkt(h : pHook;obj, paramPkt : APTR) : ULONG;
  398. begin
  399. asm
  400. MOVEM.L a2/a6,-(A7)
  401. MOVE.L h,a0
  402. MOVE.L obj,a2
  403. MOVE.L paramPkt,a1
  404. MOVE.L _UtilityBase,A6
  405. JSR -102(A6)
  406. MOVEM.L (A7)+,a2/a6
  407. MOVE.L d0,@RESULT
  408. end;
  409. end;
  410. function CheckDate(const date : pClockData) : ULONG;
  411. begin
  412. asm
  413. MOVE.L A6,-(A7)
  414. MOVE.L date,a0
  415. MOVE.L _UtilityBase,A6
  416. JSR -132(A6)
  417. MOVE.L (A7)+,A6
  418. MOVE.L d0,@RESULT
  419. end;
  420. end;
  421. function CloneTagItems(const tagList : pTagItem) : pTagItem;
  422. begin
  423. asm
  424. MOVE.L A6,-(A7)
  425. MOVE.L taglist,a0
  426. MOVE.L _UtilityBase,A6
  427. JSR -072(A6)
  428. MOVE.L (A7)+,A6
  429. MOVE.L d0,@RESULT
  430. end;
  431. end;
  432. function Date2Amiga(const date : pClockData) : ULONG;
  433. begin
  434. asm
  435. MOVE.L A6,-(A7)
  436. MOVE.L date,a0
  437. MOVE.L _UtilityBase,A6
  438. JSR -126(A6)
  439. MOVE.L (A7)+,A6
  440. MOVE.L d0,@RESULT
  441. end;
  442. end;
  443. procedure FilterTagChanges(changelist, oldvalues : pTagItem;apply : ULONG);
  444. begin
  445. asm
  446. MOVE.L A6,-(A7)
  447. MOVE.L changelist,a0
  448. MOVE.L oldvalues,a1
  449. MOVE.L apply,d0
  450. MOVE.L _UtilityBase,A6
  451. JSR -054(A6)
  452. MOVE.L (A7)+,A6
  453. end;
  454. end;
  455. function FilterTagItems(taglist : pTagItem ;const tagArray : pULONG;logic : ULONG) : ULONG;
  456. begin
  457. asm
  458. MOVE.L A6,-(A7)
  459. MOVE.L taglist,a0
  460. MOVE.L tagArray,a1
  461. MOVE.L logic,d0
  462. MOVE.L _UtilityBase,A6
  463. JSR -096(A6)
  464. MOVE.L (A7)+,A6
  465. MOVE.L d0,@RESULT
  466. end;
  467. end;
  468. function FindNamedObject(nameSpace : pNamedObject;const name : STRPTR;lastobject: pNamedObject) : pNamedObject;
  469. begin
  470. asm
  471. MOVEM.L a2/a6,-(A7)
  472. MOVE.L nameSpace,a0
  473. MOVE.L name,a1
  474. MOVE.L lastobject,a2
  475. MOVE.L _UtilityBase,A6
  476. JSR -240(A6)
  477. MOVEM.L (A7)+,a2/a6
  478. MOVE.L d0,@RESULT
  479. end;
  480. end;
  481. function FindTagItem(TagVal : Tag;const TagList : pTagItem) : pTagItem;
  482. begin
  483. asm
  484. MOVE.L A6,-(A7)
  485. MOVE.L TagVal,d0
  486. MOVE.L TagList,a0
  487. MOVE.L _UtilityBase,A6
  488. JSR -030(A6)
  489. MOVE.L (A7)+,A6
  490. MOVE.L d0,@RESULT
  491. end;
  492. end;
  493. procedure FreeNamedObject(Obj : pNamedObject);
  494. begin
  495. asm
  496. MOVE.L A6,-(A7)
  497. MOVE.L Obj,a0
  498. MOVE.L _UtilityBase,A6
  499. JSR -246(A6)
  500. MOVE.L (A7)+,A6
  501. end;
  502. end;
  503. procedure FreeTagItems(TagList : pTagItem);
  504. begin
  505. asm
  506. MOVE.L A6,-(A7)
  507. MOVE.L TagList,a0
  508. MOVE.L _UtilityBase,A6
  509. JSR -078(A6)
  510. MOVE.L (A7)+,A6
  511. end;
  512. end;
  513. function GetTagData(tagval : Tag;default : ULONG;const TagList : pTagItem) : ULONG;
  514. begin
  515. asm
  516. MOVE.L A6,-(A7)
  517. MOVE.L tagval,d0
  518. MOVE.L default,d1
  519. MOVE.L TagList,a0
  520. MOVE.L _UtilityBase,A6
  521. JSR -036(A6)
  522. MOVE.L (A7)+,A6
  523. MOVE.L d0,@RESULT
  524. end;
  525. end;
  526. function GetUniqueID : ULONG;
  527. begin
  528. asm
  529. MOVE.L A6,-(A7)
  530. MOVE.L _UtilityBase,A6
  531. JSR -270(A6)
  532. MOVE.L (A7)+,A6
  533. MOVE.L d0,@RESULT
  534. end;
  535. end;
  536. procedure MapTags(TagList : pTagItem;const maplist : pTagItem;IncludeMiss : ULONG);
  537. begin
  538. asm
  539. MOVE.L A6,-(A7)
  540. MOVE.L TagList,a0
  541. MOVE.L maplist,a1
  542. MOVE.L IncludeMiss,d0
  543. MOVE.L _UtilityBase,A6
  544. JSR -060(A6)
  545. MOVE.L (A7)+,A6
  546. end;
  547. end;
  548. function NamedObjectName(Obj : pNamedObject) : STRPTR;
  549. begin
  550. asm
  551. MOVE.L A6,-(A7)
  552. MOVE.L Obj,a0
  553. MOVE.L _UtilityBase,A6
  554. JSR -252(A6)
  555. MOVE.L (A7)+,A6
  556. MOVE.L d0,@RESULT
  557. end;
  558. end;
  559. function NextTagItem(Item : ppTagItem) : pTagItem;
  560. begin
  561. asm
  562. MOVE.L A6,-(A7)
  563. MOVE.L Item,a0
  564. MOVE.L _UtilityBase,A6
  565. JSR -048(A6)
  566. MOVE.L (A7)+,A6
  567. MOVE.L d0,@RESULT
  568. end;
  569. end;
  570. function PackBoolTags(InitialFlags : ULONG;const TagList, boolmap : pTagItem) : ULONG;
  571. begin
  572. asm
  573. MOVE.L A6,-(A7)
  574. MOVE.L InitialFlags,d0
  575. MOVE.L TagList,a0
  576. MOVE.L boolmap,a1
  577. MOVE.L _UtilityBase,A6
  578. JSR -042(A6)
  579. MOVE.L (A7)+,A6
  580. MOVE.L d0,@RESULT
  581. end;
  582. end;
  583. function PackStructureTags(packk: APTR;const packTable : pULONG;const TagList : pTagItem) : ULONG;
  584. begin
  585. asm
  586. MOVEM.L a2/a6,-(A7)
  587. MOVE.L packk,a0
  588. MOVE.L packTable,a1
  589. MOVE.L TagList,a2
  590. MOVE.L _UtilityBase,A6
  591. JSR -210(A6)
  592. MOVEM.L (A7)+,a2/a6
  593. MOVE.L d0,@RESULT
  594. end;
  595. end;
  596. procedure RefreshTagItemClones(cloneTagItem : pTagItem; const OriginalTagItems : pTagItem);
  597. begin
  598. asm
  599. MOVE.L A6,-(A7)
  600. MOVE.L cloneTagItem,a0
  601. MOVE.L OriginalTagItems,a1
  602. MOVE.L _UtilityBase,A6
  603. JSR -084(A6)
  604. MOVE.L (A7)+,A6
  605. end;
  606. end;
  607. procedure ReleaseNamedObject(Obj : pNamedObject);
  608. begin
  609. asm
  610. MOVE.L A6,-(A7)
  611. MOVE.L Obj,a0
  612. MOVE.L _UtilityBase,A6
  613. JSR -258(A6)
  614. MOVE.L (A7)+,A6
  615. end;
  616. end;
  617. procedure RemNamedObject(Obj : pNamedObject;Msg : pointer);
  618. begin
  619. asm
  620. MOVE.L A6,-(A7)
  621. MOVE.L Obj,a0
  622. MOVE.L Msg,a1
  623. MOVE.L _UtilityBase,A6
  624. JSR -264(A6)
  625. MOVE.L (A7)+,A6
  626. end;
  627. end;
  628. function SDivMod32( dividend , divisor : LongInt) : LongInt;
  629. begin
  630. asm
  631. MOVE.L A6,-(A7)
  632. MOVE.L dividend,d0
  633. MOVE.L divisor,d1
  634. MOVE.L _UtilityBase,A6
  635. JSR -150(A6)
  636. MOVE.L (A7)+,A6
  637. MOVE.L d0,@RESULT
  638. end;
  639. end;
  640. function SMult32(Arg1, Arg2 : LongInt) : LongInt;
  641. begin
  642. asm
  643. MOVE.L A6,-(A7)
  644. MOVE.L Arg1,d0
  645. MOVE.L Arg2,d1
  646. MOVE.L _UtilityBase,A6
  647. JSR -138(A6)
  648. MOVE.L (A7)+,A6
  649. MOVE.L d0,@RESULT
  650. end;
  651. end;
  652. function SMult64(Arg1, Arg2 : LongInt) : LongInt;
  653. begin
  654. asm
  655. MOVE.L A6,-(A7)
  656. MOVE.L Arg1,d0
  657. MOVE.L Arg2,d1
  658. MOVE.L _UtilityBase,A6
  659. JSR -198(A6)
  660. MOVE.L (A7)+,A6
  661. MOVE.L d0,@RESULT
  662. end;
  663. end;
  664. function Stricmp(const Str1: STRPTR;const Str2 : STRPTR) : LongInt;
  665. begin
  666. asm
  667. MOVE.L A6,-(A7)
  668. MOVE.L Str1,a0
  669. MOVE.L Str2,a1
  670. MOVE.L _UtilityBase,A6
  671. JSR -162(A6)
  672. MOVE.L (A7)+,A6
  673. MOVE.L d0,@RESULT
  674. end;
  675. end;
  676. function Strnicmp(const Str1: STRPTR;const Str2 : STRPTR;len : LongInt) : LongInt;
  677. begin
  678. asm
  679. MOVE.L A6,-(A7)
  680. MOVE.L Str1,a0
  681. MOVE.L Str2,a1
  682. MOVE.L len,d0
  683. MOVE.L _UtilityBase,A6
  684. JSR -168(A6)
  685. MOVE.L (A7)+,A6
  686. MOVE.L d0,@RESULT
  687. end;
  688. end;
  689. function TagInArray(t : Tag;const TagArray : pULONG) : Boolean;
  690. begin
  691. asm
  692. MOVE.L A6,-(A7)
  693. MOVE.L t,d0
  694. MOVE.L TagArray,a0
  695. MOVE.L _UtilityBase,A6
  696. JSR -090(A6)
  697. MOVE.L (A7)+,A6
  698. TST.L d0
  699. bne @success
  700. bra @end
  701. @success:
  702. move.b #1,d0
  703. @end:
  704. move.b d0,@RESULT
  705. end;
  706. end;
  707. function ToLower(c : ULONG) : Char;
  708. begin
  709. asm
  710. MOVE.L A6,-(A7)
  711. MOVE.L c,d0
  712. MOVE.L _UtilityBase,A6
  713. JSR -180(A6)
  714. MOVE.L (A7)+,A6
  715. MOVE.B d0,@RESULT
  716. end;
  717. end;
  718. function ToUpper(c : ULONG) : Char;
  719. begin
  720. asm
  721. MOVE.L A6,-(A7)
  722. MOVE.L c,d0
  723. MOVE.L _UtilityBase,A6
  724. JSR -174(A6)
  725. MOVE.L (A7)+,A6
  726. MOVE.B d0,@RESULT
  727. end;
  728. end;
  729. function UDivMod32( dividend , divisor : ULONG) : ULONG;
  730. begin
  731. asm
  732. MOVE.L A6,-(A7)
  733. MOVE.L dividend,d0
  734. MOVE.L divisor,d1
  735. MOVE.L _UtilityBase,A6
  736. JSR -156(A6)
  737. MOVE.L (A7)+,A6
  738. MOVE.L d0,@RESULT
  739. end;
  740. end;
  741. function UMult32(Arg1, Arg2 : ULONG) : ULONG;
  742. begin
  743. asm
  744. MOVE.L A6,-(A7)
  745. MOVE.L Arg1,d0
  746. MOVE.L Arg2,d1
  747. MOVE.L _UtilityBase,A6
  748. JSR -144(A6)
  749. MOVE.L (A7)+,A6
  750. MOVE.L d0,@RESULT
  751. end;
  752. end;
  753. function UMult64(Arg1, Arg2 : ULONG) : ULONG;
  754. begin
  755. asm
  756. MOVE.L A6,-(A7)
  757. MOVE.L Arg1,d0
  758. MOVE.L Arg2,d1
  759. MOVE.L _UtilityBase,A6
  760. JSR -204(A6)
  761. MOVE.L (A7)+,A6
  762. MOVE.L d0,@RESULT
  763. end;
  764. end;
  765. function UnpackStructureTags(const pac: APTR;const packTable: pULONG;TagList : pTagItem) : ULONG;
  766. begin
  767. asm
  768. MOVEM.L a2/a6,-(A7)
  769. MOVE.L pac,a0
  770. MOVE.L packTable,a1
  771. MOVE.L TagList,a2
  772. MOVE.L _UtilityBase,A6
  773. JSR -216(A6)
  774. MOVEM.L (A7)+,a2/a6
  775. MOVE.L d0,@RESULT
  776. end;
  777. end;
  778. function AllocNamedObjectA(const name : string;const TagList : pTagItem) : pNamedObject;
  779. begin
  780. AllocNamedObjectA := AllocNamedObjectA(pas2c(name),TagList);
  781. end;
  782. FUNCTION FindNamedObject(nameSpace : pNamedObject; CONST name : string; lastObject : pNamedObject) : pNamedObject;
  783. begin
  784. FindNamedObject := FindNamedObject(nameSpace,pas2c(name),lastObject);
  785. end;
  786. FUNCTION Stricmp(CONST string1 : string; CONST string2 : pCHAR) : LONGINT;
  787. begin
  788. Stricmp := Stricmp(pas2c(string1),string2);
  789. end;
  790. FUNCTION Stricmp(CONST string1 : pCHAR; CONST string2 : string) : LONGINT;
  791. begin
  792. Stricmp := Stricmp(string1,pas2c(string2));
  793. end;
  794. FUNCTION Stricmp(CONST string1 : string; CONST string2 : string) : LONGINT;
  795. begin
  796. Stricmp := Stricmp(pas2c(string1),pas2c(string2));
  797. end;
  798. FUNCTION Strnicmp(CONST string1 : string; CONST string2 : pCHAR; length : LONGINT) : LONGINT;
  799. begin
  800. Strnicmp := Strnicmp(pas2c(string1),string2,length);
  801. end;
  802. FUNCTION Strnicmp(CONST string1 : pCHAR; CONST string2 : string; length : LONGINT) : LONGINT;
  803. begin
  804. Strnicmp := Strnicmp(string1,pas2c(string2),length);
  805. end;
  806. FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGINT) : LONGINT;
  807. begin
  808. Strnicmp := Strnicmp(pas2c(string1),pas2c(string2),length);
  809. end;
  810. end.