[comp.sys.mac.programmer] Free Inc/Decrement routines in Pascal

a_dent@fennel.cc.uwa.oz.au (10/17/90)

G'day all Pascal programmers who handle pointer arithmetic.  I recently did a 
job in which I became heartily sick of writing:
aPtr:=ptr(ord4(aPtr)+1);

so - here's a unit full of increment and decrement functions and procedures, 
for Integer, Ptr and Longint type variables.  Just stick in your project and
enter ptrTools in your 'uses' clause.

NOTE:  there are basically 8 functions and procedures for each of the three
data types.  The procedures are called inc, inc2, inc, inc4 or dec, dec1 etc...
The functions are defined as you often want to peek at the next value without
changing your current pointer.  Hence Plus1, Plus2, ... and Less1 ...

You will see that all routines are typed by a P, L or I character at the end
of the name.

Finally there's 'charAt' which should be used if you are using pointer 
arithmetic to scan through memory.  Odd addresses can cause funny problems (
although a lot of Toolbox calls seem to handle them ok).

Share and Enjoy

Andy

PS:  for the less-knowledgeable, the "inline" stuff means that the two words of 
machine code defined will be copied inline into the calling program, rather 
than compiling in a call to a procedure.  Thus, these routines are the fastest
way to increment pointers etc. around!!


unit ptrTools;
{ functions for incrementing and decrementing various 2 and 4 byte values }
{  EG:  incP(aPtr)      nextPtr:=plus1P(aPtr)        less4I(integerToDecrease) }

{ copyright 1990 A.D. Software, free for all use provided this notice retained }
{Andy Dent                                    A.D. Software phone 09 249 2719 }
{    Mac & VAX programmer           94 Bermuda Dve , Ballajura}
{    a_dent@ ennel.cc.uwa.oz           Western Australia 6066}
{    a_dent@fennel.cc.uwa.oz AU ( international ) }

{ NOTE:  if you want to increase the constants (up to 8) then change the }
{ second digit of the SUBQ or ADDQ line }
{  ADD is even, 0=8  2=1  4=2  6=3  8=4  A=5  C=6  E=7 }
{  SUB is odd,   1=8  3=1  5=2  7=3  9=4  B=5  D=6  F=7 }

interface

	function charAt (p: ptr): char;
{ returns character at pointer - needed because an Odd pointer will cause a }
{ bus error if we try to get just the value at that point.  NOTE:  you don't }
{ need to worry about passing odd pointers to the Toolbox routines as they }
{ also are smart enough to cope. }

{******************************************************************************}
{                                   L O N G I N T                             }
{******************************************************************************}

{                                 F U N C T I O N S                        }

	function Plus1L (l: longint): longint;
	inline
		$5297, {ADDQ.L #$1, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Plus2L (l: longint): longint;
	inline
		$5497, {ADDQ.L #$2, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Plus3L (l: longint): longint;
	inline
		$5697, {ADDQ.L #$3, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Plus4L (l: longint): longint;
	inline
		$5897, {ADDQ.L #$4, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }


	function Less1L (l: longint): longint;
	inline
		$5397, {SUBQ.L #$1, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Less2L (l: longint): longint;
	inline
		$5597, {SUBQ.L #$2, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Less3L (l: longint): longint;
	inline
		$5797, {SUBQ.L #$3, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }

	function Less4L (l: longint): longint;
	inline
		$5997, {SUBQ.L #$4, (A7) }
		$2E9F;  {MOVE.L (A7)+, (A7) }




{                     P R O C E D U R E S                           }
	procedure incL (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5290; {ADDQ.L #$1, (A0) }

	procedure inc2L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5490; {ADDQ.L #$2, (A0) }

	procedure inc3L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5690; {ADDQ.L #$3, (A0) }

	procedure inc4L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5890; {ADDQ.L #$4, (A0) }


	procedure decL (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5390; {SUBQ.L #$1, (A0) }

	procedure dec2L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5590; {SUBQ.L #$2, (A0) }

	procedure dec3L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5790; {SUBQ.L #$3, (A0) }

	procedure dec4L (var l: longint);
	inline
		$205f, {MOVEA.L (A7)+, A0 }
		$5990; {SUBQ.L #$4, (A0) }



{******************************************************************************}
{                                     P T R                                    }
{******************************************************************************}

{                                 F U N C T I O N S                        }
	function Plus1P (p: ptr): ptr;
	inline
		$5297, {ADDQ.L #$1, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Plus2P (p: ptr): ptr;
	inline
		$5497, {ADDQ.L #$2, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Plus3P (p: ptr): ptr;
	inline
		$5697, {ADDQ.L #$3, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Plus4P (p: ptr): ptr;
	inline
		$5897, {ADDQ.L #$4, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }


	function Less1P (p: ptr): ptr;
	inline
		$5397, {SUBQ.L #$1, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Less2P (p: ptr): ptr;
	inline
		$5597, {SUBQ.L #$2, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Less3P (p: ptr): ptr;
	inline
		$5797, {SUBQ.L #$3, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }

	function Less4P (p: ptr): ptr;
	inline
		$5997, {SUBQ.L #$4, (A7) }
		$2E9F;  {MOVE.P (A7)+, (A7) }




{                     P R O C E D U R E S                           }
	procedure incP (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5290; {ADDQ.L #$1, (A0) }

	procedure inc2P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5490; {ADDQ.L #$2, (A0) }

	procedure inc3P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5690; {ADDQ.L #$3, (A0) }

	procedure inc4P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5890; {ADDQ.L #$4, (A0) }


	procedure decP (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5390; {SUBQ.L #$1, (A0) }

	procedure dec2P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5590; {SUBQ.L #$2, (A0) }

	procedure dec3P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5790; {SUBQ.L #$3, (A0) }

	procedure dec4P (var p: ptr);
	inline
		$205f, {MOVEA.P (A7)+, A0 }
		$5990; {SUBQ.L #$4, (A0) }




{******************************************************************************}
{                                    I N T E G E R                             }
{******************************************************************************}

{                                 F U N C T I O N S                        }
	function Plus1I (i: integer): integer;
	inline
		$5257, {ADDQ.W #$1, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Plus2I (i: integer): integer;
	inline
		$5457, {ADDQ.W #$2, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Plus3I (i: integer): integer;
	inline
		$5657, {ADDQ.W #$3, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Plus4I (i: integer): integer;
	inline
		$5857, {ADDQ.W #$4, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }


	function Less1I (i: integer): integer;
	inline
		$5357, {SUBQ.W #$1, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Less2I (i: integer): integer;
	inline
		$5557, {SUBQ.W #$2, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Less3I (i: integer): integer;
	inline
		$5757, {SUBQ.W #$3, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }

	function Less4I (i: integer): integer;
	inline
		$5957, {SUBQ.W #$4, (A7) }
		$3E9F;  {MOVE.W (A7)+, (A7) }




{                     P R O C E D U R E S                           }
	procedure incI (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5250; {ADDQ.W #$1, (A0) }

	procedure inc2I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5450; {ADDQ.W #$2, (A0) }

	procedure inc3I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5650; {ADDQ.W #$3, (A0) }

	procedure inc4I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5850; {ADDQ.W #$4, (A0) }


	procedure decI (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5350; {SUBQ.W #$1, (A0) }

	procedure dec2I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5550; {SUBQ.W #$2, (A0) }

	procedure dec3I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5750; {SUBQ.W #$3, (A0) }

	procedure dec4I (var i: integer);
	inline
		$205f, {MOVEA.W (A7)+, A0 }
		$5950; {SUBQ.W #$4, (A0) }

implementation

	function charAt (p: ptr): char;
		type
			charsInAWord = packed array[1..2] of char;
			charsInAWordPtr = ^charsInAWord;
		var
			w: charsInAWord;
	begin
		if Odd(longint(p)) then begin
			w := charsInAWordPtr(Less1P(p))^;  { uses Less1P }
			charAt := w[2];               { defined in this unit }
		end                                   {to get byte before P }
		else
			charAt := char(p^);
	end;  { charAt }
end.

Lewis_P@cc.curtin.edu.au (Peter Lewis) (10/18/90)

In article <1990Oct17.205801.2454@fennel.cc.uwa.oz.au>, 
             a_dent@fennel.cc.uwa.oz.au writes:
> G'day all Pascal programmers who handle pointer arithmetic.  I recently did a 
> job in which I became heartily sick of writing:
> aPtr:=ptr(ord4(aPtr)+1);
> 
> so - here's a unit full of increment and decrement functions and procedures, 
> for Integer, Ptr and Longint type variables.  Just stick in your project and
> enter ptrTools in your 'uses' clause.
> 
> [...]
>
> unit ptrTools;
> 
>  [lots of functions]
> 	procedure incL (var l: longint);
>  [lots of functions/procedures]
> 	procedure incP (var p: ptr);

   By using a little known feature of THINK Pascal v2.0,v3.0, as well as 
in MPW Pascal, these and many of the other routines can be combined to
   procedure inc(var l:UNIV longint);
using exactly the same inline codes as describe previously.  The UNIV
qualifier turns off type checking for that parameter, as long as the sizes
are the same.  This also means that any pointer can be passed, irrespective
of what it points to (you don't have to cast it to a PTR).
   Note that since UNIV turns off type checking it should be used with caution.

Have fun,
   Peter & Darko.

Disclaimer:Curtin & I have an agreement:Neither of us listen to either of us.
*-------+---------+---------+---------+---------+---------+---------+-------*
Internet: Lewis_P@cc.curtin.edu.au              I Peter Lewis
ACSnet: Lewis_P@cc.cut.oz.au                    I NCRPDA, Curtin University
Bitnet: Lewis_P%cc.curtin.edu.au@cunyvm.bitnet  I GPO Box U1987
UUCP: uunet!munnari.oz!cc.curtin.edu.au!Lewis_P I Perth, WA, 6001, AUSTRALIA
"!thgir  s'ti  naem  t'nseod  yaw  taht  ti  seod  enoyreve  esuaceb  tsuJ"