home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Applications / MakeFat 1.0 / PNL Libraries / QLowLevel.p < prev   
Encoding:
Text File  |  1995-11-07  |  6.5 KB  |  317 lines  |  [TEXT/CWIE]
  1. unit QLowLevel;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8. (* Global Bashing - Get constants from SysEqu.p *)
  9.     function GetGlobalB (ad: univ longint): SignedByte;
  10.     procedure SetGlobalB (ad: univ longint; b: SignedByte);    (* not univ cause}
  11. {I dont trust Pascal *)
  12.  
  13.     function GetGlobalW (ad: univ longint): integer;
  14.     procedure SetGlobalW (ad: univ longint; w: univ integer);
  15.  
  16.     function GetGlobalL (ad: univ longint): longint;
  17.     procedure SetGlobalL (ad: univ longint; l: univ longint);
  18.  
  19.     function GetGlobalS (ad: univ longint): Str255;
  20.     procedure SetGlobalS (ad: univ longint; s: Str255); (* only bashes len+1 chars *)
  21.  
  22. (* Pointer Arithmetic *)
  23.     function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  24. {$IFC not GENERATINGPOWERPC}
  25.     inline
  26.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  27.         $D09F,    (* add.l    (sp)+,d0    ; add ptr to offset (and pop p) *)
  28.         $2E80;    (* move.l    d0,(sp)        ; place in result *)
  29. {$ENDC}
  30.  
  31.     procedure OffsetPtr (var p: univ Ptr; offset: longint);
  32. {$IFC not GENERATINGPOWERPC}
  33.     inline
  34.         $201F,    (* move.l    (sp)+,d0    ; pop offset *)
  35.         $205F,    (* move.l    (sp)+,a0    ; pop address of p *)
  36.         $D190;    (* add.l    d0,(a0)        ; add offset to p *)
  37. {$ENDC}
  38.  
  39.     function SubPtrPtr (leftp, rightp: univ Ptr): longint;
  40. {$IFC not GENERATINGPOWERPC}
  41.     inline
  42.         $201F,    (* move.l    (sp)+,d0    ; pop rightp *)
  43.         $A055,    (* _StripAddress        ; strip if needed *)
  44.         $2200,    (* move.l    d0,d1            ; store in d1 *)
  45.         $201F,    (* move.l    (sp)+,d0    ; pop leftp *)
  46.         $A055,    (* _StripAddress        ; strip if needed (reg traps preserve d1) *)
  47.         $9081,    (* sub.l    d1,d0            ; d0 := leftp - rightp *)
  48.         $2E80;    (* move.l    d0,(sp)        ; place result *)
  49. {$ENDC}
  50.  
  51. (* unsigned comparisons *)
  52.  
  53.     function CompLS (a1, a2: univ longint): boolean;
  54. {$IFC not GENERATINGPOWERPC}
  55.     inline
  56.         $BF8F, $53C0, $4257, $4400, $1E80;
  57. {$ENDC}
  58.  
  59.     function CompLO (a1, a2: univ longint): boolean;
  60. {$IFC not GENERATINGPOWERPC}
  61.     inline
  62.         $BF8F, $55C0, $4257, $4400, $1E80;
  63. {$ENDC}
  64.  
  65.     function CompHS (a1, a2: univ longint): boolean;
  66. {$IFC not GENERATINGPOWERPC}
  67.     inline
  68.         $BF8F, $54C0, $4257, $4400, $1E80;
  69. {$ENDC}
  70.  
  71.     function CompHI (a1, a2: univ longint): boolean;
  72. {$IFC not GENERATINGPOWERPC}
  73.     inline
  74.         $BF8F, $52C0, $4257, $4400, $1E80;
  75. {$ENDC}
  76.  
  77. (* Register Getting - Address *)
  78.  
  79. {$IFC not GENERATINGPOWERPC}
  80.     function GetRegA0: Ptr;
  81.     inline
  82.         $2E88; (* movea.l    a0,(sp)        ; fetch a0 into tos    *)
  83.     function GetRegA1: Ptr;
  84.     inline
  85.         $2E89;
  86.     function GetRegA2: Ptr;
  87.     inline
  88.         $2E8A;
  89.     function GetRegA3: Ptr;
  90.     inline
  91.         $2E8B;
  92.     function GetRegA4: Ptr;
  93.     inline
  94.         $2E8C;
  95.     function GetRegA5: Ptr;
  96.     inline
  97.         $2E8D;
  98.     function GetRegA6: Ptr;
  99.     inline
  100.         $2E8E;
  101.     function GetRegA7: Ptr;
  102.     inline
  103.         $2E8F;
  104.  
  105. (* Register Setting - Address *)
  106.  
  107.     procedure SetRegA0 (n: univ Ptr);
  108.     inline
  109.         $205F; (* movea.l    (sp)+,a0        ; pop n into a0    *)
  110.     procedure SetRegA1 (n: univ Ptr);
  111.     inline
  112.         $225F;
  113.     procedure SetRegA2 (n: univ Ptr);
  114.     inline
  115.         $245F;
  116.     procedure SetRegA3 (n: univ Ptr);
  117.     inline
  118.         $265F;
  119.     procedure SetRegA4 (n: univ Ptr);
  120.     inline
  121.         $285F;
  122.     procedure SetRegA5 (n: univ Ptr);
  123.     inline
  124.         $2A5F;
  125.     procedure SetRegA6 (n: univ Ptr);
  126.     inline
  127.         $2C5F;
  128.     procedure SetRegA7 (n: univ Ptr);
  129.     inline
  130.         $2E5F;
  131.  
  132. (* Register Getting - Data *)
  133.  
  134.     function GetRegD0: longint;
  135.     inline
  136.         $2E80; (* move.l    d0,(sp)        ; fetch d0 into tos    *)
  137.     function GetRegD1: longint;
  138.     inline
  139.         $2E81;
  140.     function GetRegD2: longint;
  141.     inline
  142.         $2E82;
  143.     function GetRegD3: longint;
  144.     inline
  145.         $2E83;
  146.     function GetRegD4: longint;
  147.     inline
  148.         $2E84;
  149.     function GetRegD5: longint;
  150.     inline
  151.         $2E85;
  152.     function GetRegD6: longint;
  153.     inline
  154.         $2E86;
  155.     function GetRegD7: longint;
  156.     inline
  157.         $2E87;
  158.  
  159. (* Register Setting - Data *)
  160.  
  161.     procedure SetRegD0 (n: univ longint);
  162.     inline
  163.         $201F; (* move.l    (sp)+,(d0)        ; pop n into d0    *)
  164.     procedure SetRegD1 (n: univ longint);
  165.     inline
  166.         $221F;
  167.     procedure SetRegD2 (n: univ longint);
  168.     inline
  169.         $241F;
  170.     procedure SetRegD3 (n: univ longint);
  171.     inline
  172.         $261F;
  173.     procedure SetRegD4 (n: univ longint);
  174.     inline
  175.         $281F;
  176.     procedure SetRegD5 (n: univ longint);
  177.     inline
  178.         $2A1F;
  179.     procedure SetRegD6 (n: univ longint);
  180.     inline
  181.         $2C1F;
  182.     procedure SetRegD7 (n: univ longint);
  183.     inline
  184.         $2E1F;
  185. {$ENDC}
  186.  
  187.     procedure BSETW (var l: integer; num: integer);
  188. {$IFC not GENERATINGPOWERPC}
  189.     inline
  190.         $301F, $205F, $3210, $01C1, $3081;
  191. {$ENDC}
  192.  
  193.     procedure BCLRW (var l: integer; num: integer);
  194. {$IFC not GENERATINGPOWERPC}
  195.     inline
  196.         $301F, $205F, $3210, $0181, $3081;
  197. {$ENDC}
  198.  
  199. implementation
  200.  
  201.     uses
  202.         Memory;
  203.  
  204.     function GetGlobalB (ad: univ longint): SignedByte;
  205.     begin
  206.         GetGlobalB := Ptr(ad)^;
  207.     end; (* GetGlobalB *)
  208.  
  209.     procedure SetGlobalB (ad: univ longint; b: SignedByte);    (* not univ cause}
  210. {I dont trust Pascal *)
  211.     begin
  212.         Ptr(ad)^ := b;
  213.     end; (* GetGlobalB *)
  214.  
  215.     type
  216.         intPtr = ^integer;
  217.  
  218.     function GetGlobalW (ad: univ longint): integer;
  219.     begin
  220.         GetGlobalW := intPtr(ad)^;
  221.     end; (* GetGlobalB *)
  222.  
  223.     procedure SetGlobalW (ad: univ longint; w: univ integer);
  224.     begin
  225.         intPtr(ad)^ := w;
  226.     end; (* GetGlobalB *)
  227.  
  228.     type
  229.         longPtr = ^longint;
  230.  
  231.     function GetGlobalL (ad: univ longint): longint;
  232.     begin
  233.         GetGlobalL := longPtr(ad)^;
  234.     end; (* GetGlobalB *)
  235.  
  236.     procedure SetGlobalL (ad: univ longint; l: univ longint);
  237.     begin
  238.         longPtr(ad)^ := l;
  239.     end; (* GetGlobalB *)
  240.  
  241.     function GetGlobalS (ad: univ longint): Str255;
  242.         var
  243.             tmp: Str255;
  244.     begin
  245.         BlockMoveData(pointer(ad), @tmp, sizeof(tmp));
  246.         GetGlobalS := tmp;
  247.     end; (* GetGlobalB *)
  248.  
  249.     procedure SetGlobalS (ad: univ longint; s: Str255); (* only bashes}
  250. {len+1 chars *)
  251.     begin
  252.         BlockMoveData(@s, pointer(ad), Length(s) + 1);
  253.     end; (* GetGlobalB *)
  254.  
  255. {$IFC GENERATINGPOWERPC}
  256.     function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  257.     begin
  258.         AddPtrLong := Ptr(ord(p) + offset);
  259.     end;
  260.  
  261.     procedure OffsetPtr (var p: univ Ptr; offset: longint);
  262.     begin
  263.         p := Ptr(ord(p) + offset);
  264.     end;
  265.  
  266.     function SubPtrPtr (leftp, rightp: univ Ptr): longint;
  267.     begin
  268.         SubPtrPtr := ord(leftp) - ord(rightp);
  269.     end;
  270.  
  271.     function CompLS (a1, a2: univ longint): boolean;
  272.     begin
  273.         if ((a1 >= 0) & (a2 >= 0)) | ((a1 < 0) & (a2 < 0)) then begin
  274.             CompLS := a1 <= a2;
  275.         end else if a2 < 0 then begin
  276.             CompLS := true;
  277.         end else begin
  278.             CompLS := false;
  279.         end;
  280.     end;
  281.  
  282.     function CompLO (a1, a2: univ longint): boolean;
  283.     begin
  284.         CompLO := CompLS(a1, a2) & (a1 <> a2);
  285.     end;
  286.  
  287.     function CompHS (a1, a2: univ longint): boolean;
  288.     begin
  289.         CompHS := CompLS(a2, a1);
  290.     end;
  291.  
  292.     function CompHI (a1, a2: univ longint): boolean;
  293.     begin
  294.         CompHI := CompLS(a2, a1) & (a1 <> a2);
  295.     end;
  296.  
  297.     procedure BSETW (var l: integer; num: integer);
  298.         var
  299.             ll: longint;
  300.     begin
  301.         ll := l;
  302.         BSET(ll, num);
  303.         l := ll;
  304.     end;
  305.  
  306.     procedure BCLRW (var l: integer; num: integer);
  307.         var
  308.             ll: longint;
  309.     begin
  310.         ll := l;
  311.         BCLR(ll, num);
  312.         l := ll;
  313.     end;
  314.  
  315. {$ENDC}
  316.  
  317. end. (* LowLevel *)