AROS: removed readintags and readinlongs (just a bug function), Added missing functions in AmigaDos, GetAttr overloaded with var parameter

git-svn-id: trunk@31164 -

packages/arosunits/src/asl.pas

@@ -536,13 +536,19 @@ implementation
 
 
 function AllocAslRequest(ReqType: LongWord; const Tags: array of const): Pointer;
+var
+  TagList: TTagsList;
 begin
-  AllocAslRequest := AllocAslRequestA(reqType , readintags(tags));
+  AddTags(TagList, Tags);
+  AllocAslRequest := AllocAslRequestA(reqType , GetTagPtr(TagList));
 end;
 
 function AslRequest(Requester: Pointer; const Tags: array of const): LongBool;
+var
+  TagList: TTagsList;
 begin
-  AslRequest := AslRequestA(Requester , readintags(tags));
+  AddTags(TagList, Tags);
+  AslRequest := AslRequestA(Requester , GetTagPtr(TagList));
 end;
 
 initialization

packages/arosunits/src/longarray.pas

@@ -36,20 +36,12 @@ uses
 type
   PArgList = ^TArgList;
   TArgList = array of IPTR;
-  
-function readinlongs(const Args: array of const): Pointer;
+
 procedure AddArguments(var ArgList: TArgList; const Args: array of const);
 function GetArgPtr(var ArgList: TArgList): Pointer;
 
 implementation
 
-type
-  TMyArgs = array of IPTR;
-  PMyArgs = ^TMyArgs;
-
-var
-  ArgArray : PMyArgs;
-
 procedure AddArguments(var ArgList: TArgList; const Args: array of const);
 var
   i: Integer;
@@ -80,32 +72,5 @@ begin
   Result := @(ArgList[0]);
 end;
 
-
-function ReadInLongs(const Args: array of const): Pointer;
-var
-  i: Integer;
-begin
-  for i := 0 to High(Args) do begin
-    case args[i].vtype of
-      vtinteger: ArgArray^[i] := IPTR(Args[i].vinteger);
-      vtpchar: ArgArray^[i] := IPTR(Args[i].vpchar);
-      vtchar: ArgArray^[i] := IPTR(Args[i].vchar);
-      vtpointer: ArgArray^[i] := IPTR(Args[i].vpointer);
-      vtstring: ArgArray^[i] := IPTR(PChar(string(Args[i].vstring^)));
-      vtboolean: ArgArray^[i] := IPTR(byte(Args[i].vboolean));
-    end;
-  end;
-  readinlongs := @(argarray^[0]);
-end;
-
-
-
-
-initialization
-  New(argarray);
-  SetLength(argarray^, 200);
-finalization
-  SetLength(argarray^, 0);
-  Dispose(argarray);
 end.
 

packages/arosunits/src/mui.pas

@@ -3859,28 +3859,43 @@ end;
  Functions and procedures with array of const go here
 }
 function MUI_AllocAslRequestTags(_type : longword; const tags : Array Of Const) : Pointer;
+var
+  TagList: TTagsList;
 begin
-    MUI_AllocAslRequestTags := MUI_AllocAslRequest(_type , readintags(tags));
+  AddTags(TagList, Tags);
+  MUI_AllocAslRequestTags := MUI_AllocAslRequest(_type, GetTagPtr(TagList));
 end;
 
 function MUI_AslRequestTags(req : Pointer; const tags : Array Of Const) : LongBool;
+var
+  TagList: TTagsList;
 begin
-    MUI_AslRequestTags := MUI_AslRequest(req , readintags(tags));
+  AddTags(TagList, Tags);
+  MUI_AslRequestTags := MUI_AslRequest(req, GetTagPtr(TagList));
 end;
 
 function MUI_MakeObject(_type : LongInt; const params : Array Of Const) : pLongWord;
+var
+  Args: TArgList;
 begin
-    MUI_MakeObject := MUI_MakeObjectA(_type , readinlongs(params));
+  AddArguments(Args, params);
+  MUI_MakeObject := MUI_MakeObjectA(_type, GetArgPtr(Args));
 end;
 
 function MUI_NewObject(a0arg : pCHAR; const tags : Array Of Const) : pLongWord;
+var
+  TagList: TTagsList;
 begin
-    MUI_NewObject := MUI_NewObjectA(a0arg , readintags(tags));
+  AddTags(TagList, Tags);
+  MUI_NewObject := MUI_NewObjectA(a0arg , GetTagPtr(TagList));
 end;
 
 function MUI_Request(app : Pointer; win : Pointer; flags : longword; title : pCHAR; gadgets : pCHAR; format : pCHAR; const params : Array Of Const) : LongInt;
+var
+  Args: TArgList;
 begin
-    MUI_Request := MUI_RequestA(app , win , flags , title , gadgets , format , readintags(params));
+  AddArguments(Args, params);
+  MUI_Request := MUI_RequestA(app , win , flags , title , gadgets , format , GetArgPtr(Args));
 end;
 
 const

packages/arosunits/src/tagsarray.pas

@@ -24,18 +24,12 @@ uses
 
 type
   TTagsList = array of ttagitem;
-  PMyTags = ^TTagsList;
 
-
-function ReadInTags(const Args: array of const): PTagItem;
 procedure AddTags(var Taglist: TTagsList; const Args: array of const);
 function GetTagPtr(var TagList: TTagsList): PTagItem;
 
 implementation
 
-var
-  MyTags: PMyTags;
-
 procedure AddTags(var Taglist: TTagsList; const Args: array of const);
 var
   i: IPTR;
@@ -69,43 +63,6 @@ begin
   GetTagPtr := @(TagList[0]);
 end;
 
-function ReadInTags(const Args: array of const): PTagItem;
-var
-  i: IPTR;
-  ii: IPTR;
-begin
-  ii := 0;
-  SetLength(MyTags^, (Length(Args) div 2) + 4); // some more at the end
-  for i := 0 to High(Args) do
-  begin
-    if not Odd(i) then
-    begin
-      mytags^[ii].ti_tag := IPTR(Args[i].vinteger);
-    end else
-    begin
-      case Args[i].vtype of
-        vtinteger: mytags^[ii].ti_data := IPTR(Args[i].vinteger);
-        vtboolean: mytags^[ii].ti_data := IPTR(Byte(Args[i].vboolean));
-        vtpchar: mytags^[ii].ti_data := IPTR(Args[i].vpchar);
-        vtchar: mytags^[ii].ti_data := IPTR(Args[i].vchar);
-        vtstring: mytags^[ii].ti_data := IPTR(PChar(string(Args[i].vstring^)));
-        vtpointer: mytags^[ii].ti_data := IPTR(Args[i].vpointer);
-      end;
-      Inc(ii);
-    end;
-  end;
-  Inc(ii);
-  // Add additional TAG_DONE (if user forget)
-  mytags^[ii].ti_tag := TAG_DONE;
-  mytags^[ii].ti_data := 0;
-  // return the pointer
-  ReadInTags := @(MyTags^[0]);
-end;
-
 initialization
-  New(MyTags);
-  SetLength(MyTags^, 200);
 finalization
-  SetLength(MyTags^, 0);
-  Dispose(MyTags);
 end.

packages/arosunits/src/utility.pas

@@ -33,18 +33,18 @@ type
     Year: Word;
     WDay: Word;
   end;
-  
+
 // Use CALLHOOKPKT to call a hook
   PHook = ^THook;
   THookFunctionProc = function(Hook: PHook; Object_: APTR; Message: APTR): IPTR; cdecl;
-  
+
   THook = record
     h_MinNode: TMinNode;
     h_Entry: IPTR;    // Main Entry point THookFunctionProc
     h_SubEntry: IPTR; // Secondary entry point
     h_Data: Pointer;     // owner specific
   end;
-  
+
 // The named object structure
   PNamedObject = ^TNamedObject;
   TNamedObject = record
@@ -66,16 +66,16 @@ const
 
 //   Control attributes for Pack/UnpackStructureTags()
 { PackTable definition:
- 
+
   The PackTable is a simple array of LONGWORDS that are evaluated by
   PackStructureTags() and UnpackStructureTags().
- 
+
   The table contains compressed information such as the tag offset from
   the base tag. The tag offset has a limited range so the base tag is
   defined in the first longword.
- 
+
   After the first longword, the fields look as follows:
- 
+
        +--------- 1 = signed, 0 = unsigned (for bits, 1=inverted boolean)
        |
        |  +------ 00 = Pack/Unpack, 10 = Pack, 01 = Unpack, 11 = special
@@ -91,11 +91,11 @@ const
        Bit offset (for bit operations) ----/ |               |
                                              \                       |
        Offset into data structure -----------------------------------/
- 
+
   A -1 longword signifies that the next longword will be a new base tag
- 
+
   A 0 longword signifies that it is the end of the pack table.
- 
+
   What this implies is that there are only 13-bits of address offset
   and 10 bits for tag offsets from the base tag.  For most uses this
   should be enough, but when this is not, either multiple pack tables
@@ -108,7 +108,7 @@ const
   PSTB_PACK   = 29;       // Note that these are active low...
   PSTF_PACK   = 1 shl 29;
   PSTB_UNPACK = 30;       // Note that these are active low...
-  PSTF_UNPACK = 1 shl 30;  
+  PSTF_UNPACK = 1 shl 30;
   PSTB_SIGNED = 31;
   PSTF_SIGNED = 1 shl 31;
 
@@ -199,7 +199,7 @@ const
   MAP_REMOVE_NOT_FOUND = 0; // remove tags that aren't in mapList
   MAP_KEEP_NOT_FOUND   = 1; // keep tags that aren't in mapList
 
-  UTILITYNAME	= 'utility.library';
+  UTILITYNAME = 'utility.library';
 
 type
   PUtilityBase = ^TUtilityBase;
@@ -250,7 +250,6 @@ function UnpackStructureTags(Pack: APTR; PackTable: PLongWord; TagList: PTagItem
 
 // Macros
 function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR; inline;
-function TAGLIST(var Args: array of const): PTagItem; // NOT threadsafe! Better use AddTags/GetTagPtr
 
 // VarArgs Versions
 function AllocNamedObject(const Name: STRPTR; const Tags: array of const): PNamedObject;
@@ -268,20 +267,18 @@ begin
   AddTags(TagList, Tags);
   Result := AllocNamedObjectA(Name, GetTagPtr(TagList));
 end;
-  
-function TAGLIST(var Args: array of const): PTagItem;
-begin
-  Result := ReadInTags(Args);
-end;
 
 function CallHook(Hook: PHook; Object_: APTR; const Params: array of const): IPTR;
+var
+  Args: TArgList;
 begin
-  CallHook := CallHookPkt(Hook, Object_ , ReadInLongs(Params));
+  AddArguments(Args, params);
+  CallHook := CallHookPkt(Hook, Object_ , GetArgPtr(Args));
 end;
 
 function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR;
 var
-  FuncPtr: THookFunctionProc; 
+  FuncPtr: THookFunctionProc;
 begin
   Result := 0;
   if (Hook = nil) or (Object_ = nil) or (Message = nil) then

packages/arosunits/src/workbench.pas

@@ -605,50 +605,73 @@ uses
 
 // varargs versions:
 function AddAppIcon(ID: LongWord; UserData: LongWord; Text_: PChar; MsgPort: PMsgPort; Lock: BPTR; DiskObj: PDiskObject; const Tags: array of const): PAppIcon;
+var
+  TagList: TTagsList;
 begin
-  AddAppIcon := AddAppIconA(ID, UserData, Text_, MsgPort, Lock, DiskObj, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  AddAppIcon := AddAppIconA(ID, UserData, Text_, MsgPort, Lock, DiskObj, GetTagPtr(TagList));
 end;
 
 
 function AddAppMenuItem(ID: LongWord; UserData: LongWord; Text_: APTR; MsgPort: PMsgPort;  const Tags: array of const): PAppMenuItem;
+var
+  TagList: TTagsList;
 begin
-  AddAppMenuItem := AddAppMenuItemA(ID, UserData, Text_, MsgPort, ReadInTags(Tags));
+  AddAppMenuItem := AddAppMenuItemA(ID, UserData, Text_, MsgPort, GetTagPtr(TagList));
 end;
 
 
 function AddAppWindow(ID: LongWord; UserData: LongWord; Window: PWindow; MsgPort: PMsgPort;  const Tags: array of const): PAppWindow;
+var
+  TagList: TTagsList;
 begin
-  AddAppWindow := AddAppWindowA(ID, UserData, Window, MsgPort, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  AddAppWindow := AddAppWindowA(ID, UserData, Window, MsgPort, GetTagPtr(TagList));
 end;
 
 
 function AddAppWindowDropZone(Aw: PAppWindow; ID: LongWord; UserData: LongWord;  const Tags: array of const): PAppWindowDropZone;
+var
+  TagList: TTagsList;
 begin
-  AddAppWindowDropZone := AddAppWindowDropZoneA(Aw, ID, UserData, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  AddAppWindowDropZone := AddAppWindowDropZoneA(Aw, ID, UserData, GetTagPtr(TagList));
 end;
 
 
 function CloseWorkbenchObject(Name: STRPTR;  const Tags: array of const): LongBool;
+var
+  TagList: TTagsList;
 begin
-  CloseWorkbenchObject := CloseWorkbenchObjectA(Name, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  CloseWorkbenchObject := CloseWorkbenchObjectA(Name, GetTagPtr(TagList));
 end;
 
 
 function MakeWorkbenchObjectVisible(Name: STRPTR;  const Tags: array of const): LongBool;
+var
+  TagList: TTagsList;
 begin
-  MakeWorkbenchObjectVisible := MakeWorkbenchObjectVisibleA(Name, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  MakeWorkbenchObjectVisible := MakeWorkbenchObjectVisibleA(Name, GetTagPtr(TagList));
 end;
 
 
 function OpenWorkbenchObject(Name: STRPTR;  const Tags: array of const): LongBool;
+var
+  TagList: TTagsList;
 begin
-  OpenWorkbenchObject := OpenWorkbenchObjectA(Name, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  OpenWorkbenchObject := OpenWorkbenchObjectA(Name, GetTagPtr(TagList));
 end;
 
 
 function WorkbenchControl(Name: STRPTR;  const Tags: array of const): LongBool;
+var
+  TagList: TTagsList;
 begin
-  WorkbenchControl := WorkbenchControlA(Name, ReadInTags(Tags));
+  AddTags(TagList, Tags);
+  WorkbenchControl := WorkbenchControlA(Name, GetTagPtr(TagList));
 end;