Contributing

[Steve Kargl]

On Sat, Jan 22, 2005 at 02:27:19PM +0100, Gunnar wrote:
> As a total beginner when it comes to writing a part of a fortran compiler, I 
> had a look at the "not" intrinsic function.
> 

> So, should I find something else to do than bugging you with my code, or 
> should I start working with another intrinsic function?

Gunnar write a short Fortran 77 program that tortures the 
intrinsic that you want to implement.  Compile it with g77.
See what the output should be, and then start writing the
intrinsic.  As Paul noted, NOT is already implemented.
You may want to look at AND, OR, and XOR.  I've attached
a program that exercises AND, OR, and XOR.  Note
that these are the bitwise operation.  Also, check g77.info
for the correct usage.

There is more that needs doing other than writing the 
actual intrinsic function.  You need to tell the Fortran
about it.  You may need to edit one or more of these files:

check.c           --> Add function to check the arguments of intrinsic
gfortran.h        --> Add symbol need to mark the intrinsic 
intrinsic.c       --> This is where you add the info to teach the
                      frontend about the new intrinsic.
intrinsic.h       --> Prototypes for check, resolve, and simplify functions.
iresolve.c        --> Add function to resolve the intrinsic to a specific
                      library function
simplify.c        --> Add a simplication function.
trans-intrinsic.c --> Add code to tell the middle-end about the intrinsic

For example, for the UMASK intrinsic function and subroutine, you find
kargl[217] grep _umask *
check.c:gfc_check_umask (gfc_expr * mask)
check.c:gfc_check_umask_sub (gfc_expr * mask, gfc_expr * old)
intrinsic.c:         gfc_check_umask, NULL, gfc_resolve_umask,
intrinsic.c:          gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
intrinsic.h:try gfc_check_umask (gfc_expr *);
intrinsic.h:try gfc_check_umask_sub (gfc_expr *, gfc_expr *);
intrinsic.h:void gfc_resolve_umask (gfc_expr *, gfc_expr *);
intrinsic.h:void gfc_resolve_umask_sub (gfc_code *);
iresolve.c:gfc_resolve_umask (gfc_expr * f, gfc_expr * n)
iresolve.c:gfc_resolve_umask_sub (gfc_code * c)

-- 
Steve
-------------- next part --------------
      program logic

      integer*2 ii2, ij2
      integer*4 ii4, ij4
      integer*8 ii8, ij8

      logical*2 li2, lj2
      logical*4 li4, lj4
      logical*8 li8, lj8

      ii2 = 2
      ij2 = 20
      ii4 = 300
      ij4 = -3000
      ii8 =  987654321
      ij8 = -123456789

      print *, 'and: ', and(ii2,ij2)
      print *, ' or: ',  or(ii2,ij2)
      print *, 'xor: ', xor(ii2,ij2)
      print *, 'not: ', not(ii2), not(ij2)
      print *

      print *, 'and: ', and(ii4,ij4)
      print *, ' or: ',  or(ii4,ij4)
      print *, 'xor: ', xor(ii4,ij4)
      print *, 'not: ', not(ii4), not(ij4)
      print *

      print *, 'and: ', and(ii8,ij8)
      print *, ' or: ',  or(ii8,ij8)
      print *, 'xor: ', xor(ii8,ij8)
      print *, 'not: ', not(ii8), not(ij8)
      print *

      print *, 'and: ', and(ii2,ij2), and(ii2,ij4), and(ii2,ij8)
      print *, 'and: ', and(ii4,ij2), and(ii4,ij4), and(ii4,ij8)
      print *, 'and: ', and(ii8,ij2), and(ii8,ij4), and(ii8,ij8)
      print *

      print *, ' or: ',  or(ii2,ij2), or(ii4,ij2), or(ii8,ij2)
      print *, ' or: ',  or(ii2,ij4), or(ii4,ij4), or(ii8,ij4)
      print *, ' or: ',  or(ii2,ij8), or(ii4,ij8), or(ii8,ij8)
      print *

      print *, 'xor: ', xor(ii2,ij2), xor(ii2,ij4), xor(ii2,ij8)
      print *, 'xor: ', xor(ii4,ij2), xor(ii4,ij4), xor(ii4,ij8)
      print *, 'xor: ', xor(ii8,ij2), xor(ii8,ij4), xor(ii8,ij8)
      print *

      li2 = .true.
      lj2 = .false.
      li4 = .true.
      lj4 = .false.
      li8 = .true.
      lj8 = .false.

      print *, 'and: ', and(li2,lj2), and(li2,lj4), and(li2,lj8)
      print *, ' or: ',  or(li2,lj2),  or(li2,lj4),  or(li2,lj8)
      print *, 'xor: ', xor(li2,lj2), xor(li2,lj4), xor(li2,lj8)
      print *
      print *, 'and: ', and(li2,lj2), and(li4,lj2), and(li8,lj2)
      print *, ' or: ',  or(li2,lj4),  or(li4,lj4),  or(li8,lj4)
      print *, 'xor: ', xor(li2,lj8), xor(li4,lj8), xor(li8,lj8)

      end