[net.micro.atari16] Pascal demo

fouts@AMES-NAS.ARPA (07/27/86)

This is the peekpoke.pas.  It is part of my OSS Pascal demo.
I did not write the code for this part, but got it from the
OSS Buletin board

----- CUT HERE -----

  {$P-}

  FUNCTION peek( address: long_integer ): long_integer;

    TYPE
      byte_ptr = ^byte;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: byte_ptr );
             END;

    BEGIN
      funny.a := address;
      peek := funny.p^;
    END;

  FUNCTION wpeek( address: long_integer ): long_integer;

    TYPE
      int_ptr = ^integer;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: int_ptr );
             END;

    BEGIN
      funny.a := address;
      wpeek := funny.p^;
    END;

  FUNCTION lpeek( address: long_integer ): long_integer;

    TYPE
      lint_ptr = ^long_integer;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: lint_ptr );
             END;

    BEGIN
      funny.a := address;
      lpeek := funny.p^;
    END;

  PROCEDURE poke( address: long_integer; value: byte );

    TYPE
      lint_ptr = ^long_integer;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: lint_ptr );
             END;

    BEGIN
      funny.a := address;
      funny.p^ := value;
    END;

  PROCEDURE wpoke( address: long_integer; value: integer );

    TYPE
      int_ptr = ^integer;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: int_ptr );
             END;

    BEGIN
      funny.a := address;
      funny.p^ := value;
    END;

  PROCEDURE lpoke( address, value: long_integer );

    TYPE
      lint_ptr = ^long_integer;

    VAR
      funny: RECORD
               CASE boolean OF
                 true:  ( a: long_integer );
                 false: ( p: lint_ptr );
             END;

    BEGIN
      funny.a := address;
      funny.p^ := value;
    END;

  {$P=}