diff options
author | Jason Downs <downsj@cvs.openbsd.org> | 1997-04-09 10:26:46 +0000 |
---|---|---|
committer | Jason Downs <downsj@cvs.openbsd.org> | 1997-04-09 10:26:46 +0000 |
commit | 633a0c67dc6ad8132b30607861cd2db82a083563 (patch) | |
tree | 969c5005fca7e6fa861b4ac51a7abbf835b3fa15 /gnu | |
parent | 088c16e091d4c2ef507aa84f3ff63ef68c5101fc (diff) |
Remove the rest of the new files.
Commit a couple local configuration changes of mine before I lose them.
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/usr.bin/gcc/alias.c | 989 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/alpha/linux.h | 72 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/alpha/t-linux | 3 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/alpha/x-linux | 1 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/alpha/xm-linux.h | 8 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/romp/xm-romp.h | 2 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/config/x-linux-aout | 14 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/configure | 8 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/gbe/2.7.2.2.diff | 4100 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/intdoc.c | 1248 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/intdoc.h | 1297 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/intdoc.texi | 6000 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/runtime/libF77/makefile | 84 | ||||
-rw-r--r-- | gnu/usr.bin/gcc/f/runtime/libI77/makefile | 101 |
14 files changed, 10 insertions, 13917 deletions
diff --git a/gnu/usr.bin/gcc/alias.c b/gnu/usr.bin/gcc/alias.c deleted file mode 100644 index bd7f1f4e6e5..00000000000 --- a/gnu/usr.bin/gcc/alias.c +++ /dev/null @@ -1,989 +0,0 @@ -/* Alias analysis for GNU C, by John Carr (jfc@mit.edu). - Derived in part from sched.c */ -#include "config.h" -#include "rtl.h" -#include "expr.h" -#include "regs.h" -#include "hard-reg-set.h" -#include "flags.h" - -static rtx canon_rtx PROTO((rtx)); -static int rtx_equal_for_memref_p PROTO((rtx, rtx)); -static rtx find_symbolic_term PROTO((rtx)); -static int memrefs_conflict_p PROTO((int, rtx, int, rtx, - HOST_WIDE_INT)); - -/* Set up all info needed to perform alias analysis on memory references. */ - -#define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) - -/* reg_base_value[N] gives an address to which register N is related. - If all sets after the first add or subtract to the current value - or otherwise modify it so it does not point to a different top level - object, reg_base_value[N] is equal to the address part of the source - of the first set. The value will be a SYMBOL_REF, a LABEL_REF, or - (address (reg)) to indicate that the address is derived from an - argument or fixed register. */ -rtx *reg_base_value; -unsigned int reg_base_value_size; /* size of reg_base_value array */ -#define REG_BASE_VALUE(X) \ - (REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0) - -/* Vector indexed by N giving the initial (unchanging) value known - for pseudo-register N. */ -rtx *reg_known_value; - -/* Indicates number of valid entries in reg_known_value. */ -static int reg_known_value_size; - -/* Vector recording for each reg_known_value whether it is due to a - REG_EQUIV note. Future passes (viz., reload) may replace the - pseudo with the equivalent expression and so we account for the - dependences that would be introduced if that happens. */ -/* ??? This is a problem only on the Convex. The REG_EQUIV notes created in - assign_parms mention the arg pointer, and there are explicit insns in the - RTL that modify the arg pointer. Thus we must ensure that such insns don't - get scheduled across each other because that would invalidate the REG_EQUIV - notes. One could argue that the REG_EQUIV notes are wrong, but solving - the problem in the scheduler will likely give better code, so we do it - here. */ -char *reg_known_equiv_p; - -/* Inside SRC, the source of a SET, find a base address. */ - -/* When copying arguments into pseudo-registers, record the (ADDRESS) - expression for the argument directly so that even if the argument - register is changed later (e.g. for a function call) the original - value is noted. */ -static int copying_arguments; - -static rtx -find_base_value (src) - register rtx src; -{ - switch (GET_CODE (src)) - { - case SYMBOL_REF: - case LABEL_REF: - return src; - - case REG: - if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - return reg_base_value[REGNO (src)]; - return src; - - case MEM: - /* Check for an argument passed in memory. Only record in the - copying-arguments block; it is too hard to track changes - otherwise. */ - if (copying_arguments - && (XEXP (src, 0) == arg_pointer_rtx - || (GET_CODE (XEXP (src, 0)) == PLUS - && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx))) - return gen_rtx (ADDRESS, VOIDmode, src); - return 0; - - case CONST: - src = XEXP (src, 0); - if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS) - break; - /* fall through */ - case PLUS: - case MINUS: - /* Guess which operand to set the register equivalent to. */ - /* If the first operand is a symbol or the second operand is - an integer, the first operand is the base address. */ - if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF - || GET_CODE (XEXP (src, 0)) == LABEL_REF - || GET_CODE (XEXP (src, 1)) == CONST_INT) - return XEXP (src, 0); - /* If an operand is a register marked as a pointer, it is the base. */ - if (GET_CODE (XEXP (src, 0)) == REG - && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0)))) - src = XEXP (src, 0); - else if (GET_CODE (XEXP (src, 1)) == REG - && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1)))) - src = XEXP (src, 1); - else - return 0; - if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - return reg_base_value[REGNO (src)]; - return src; - - case AND: - /* If the second operand is constant set the base - address to the first operand. */ - if (GET_CODE (XEXP (src, 1)) == CONST_INT - && GET_CODE (XEXP (src, 0)) == REG) - { - src = XEXP (src, 0); - if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) - return reg_base_value[REGNO (src)]; - return src; - } - return 0; - - case HIGH: - return XEXP (src, 0); - } - - return 0; -} - -/* Called from init_alias_analysis indirectly through note_stores. */ - -/* while scanning insns to find base values, reg_seen[N] is nonzero if - register N has been set in this function. */ -static char *reg_seen; - -static -void record_set (dest, set) - rtx dest, set; -{ - register int regno; - rtx src; - - if (GET_CODE (dest) != REG) - return; - - regno = REGNO (dest); - - if (set) - { - /* A CLOBBER wipes out any old value but does not prevent a previously - unset register from acquiring a base address (i.e. reg_seen is not - set). */ - if (GET_CODE (set) == CLOBBER) - { - reg_base_value[regno] = 0; - return; - } - src = SET_SRC (set); - } - else - { - static int unique_id; - if (reg_seen[regno]) - { - reg_base_value[regno] = 0; - return; - } - reg_seen[regno] = 1; - reg_base_value[regno] = gen_rtx (ADDRESS, Pmode, - GEN_INT (unique_id++)); - return; - } - - /* This is not the first set. If the new value is not related to the - old value, forget the base value. Note that the following code is - not detected: - extern int x, y; int *p = &x; p += (&y-&x); - ANSI C does not allow computing the difference of addresses - of distinct top level objects. */ - if (reg_base_value[regno]) - switch (GET_CODE (src)) - { - case PLUS: - case MINUS: - if (XEXP (src, 0) != dest && XEXP (src, 1) != dest) - reg_base_value[regno] = 0; - break; - case AND: - if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT) - reg_base_value[regno] = 0; - break; - case LO_SUM: - if (XEXP (src, 0) != dest) - reg_base_value[regno] = 0; - break; - default: - reg_base_value[regno] = 0; - break; - } - /* If this is the first set of a register, record the value. */ - else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno]) - && ! reg_seen[regno] && reg_base_value[regno] == 0) - reg_base_value[regno] = find_base_value (src); - - reg_seen[regno] = 1; -} - -/* Called from loop optimization when a new pseudo-register is created. */ -void -record_base_value (regno, val) - int regno; - rtx val; -{ - if (!flag_alias_check || regno >= reg_base_value_size) - return; - if (GET_CODE (val) == REG) - { - if (REGNO (val) < reg_base_value_size) - reg_base_value[regno] = reg_base_value[REGNO (val)]; - return; - } - reg_base_value[regno] = find_base_value (val); -} - -static rtx -canon_rtx (x) - rtx x; -{ - /* Recursively look for equivalences. */ - if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER - && REGNO (x) < reg_known_value_size) - return reg_known_value[REGNO (x)] == x - ? x : canon_rtx (reg_known_value[REGNO (x)]); - else if (GET_CODE (x) == PLUS) - { - rtx x0 = canon_rtx (XEXP (x, 0)); - rtx x1 = canon_rtx (XEXP (x, 1)); - - if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) - { - /* We can tolerate LO_SUMs being offset here; these - rtl are used for nothing other than comparisons. */ - if (GET_CODE (x0) == CONST_INT) - return plus_constant_for_output (x1, INTVAL (x0)); - else if (GET_CODE (x1) == CONST_INT) - return plus_constant_for_output (x0, INTVAL (x1)); - return gen_rtx (PLUS, GET_MODE (x), x0, x1); - } - } - /* This gives us much better alias analysis when called from - the loop optimizer. Note we want to leave the original - MEM alone, but need to return the canonicalized MEM with - all the flags with their original values. */ - else if (GET_CODE (x) == MEM) - { - rtx addr = canon_rtx (XEXP (x, 0)); - if (addr != XEXP (x, 0)) - { - rtx new = gen_rtx (MEM, GET_MODE (x), addr); - MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x); - RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x); - MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x); - x = new; - } - } - return x; -} - -/* Return 1 if X and Y are identical-looking rtx's. - - We use the data in reg_known_value above to see if two registers with - different numbers are, in fact, equivalent. */ - -static int -rtx_equal_for_memref_p (x, y) - rtx x, y; -{ - register int i; - register int j; - register enum rtx_code code; - register char *fmt; - - if (x == 0 && y == 0) - return 1; - if (x == 0 || y == 0) - return 0; - x = canon_rtx (x); - y = canon_rtx (y); - - if (x == y) - return 1; - - code = GET_CODE (x); - /* Rtx's of different codes cannot be equal. */ - if (code != GET_CODE (y)) - return 0; - - /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. - (REG:SI x) and (REG:HI x) are NOT equivalent. */ - - if (GET_MODE (x) != GET_MODE (y)) - return 0; - - /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ - - if (code == REG) - return REGNO (x) == REGNO (y); - if (code == LABEL_REF) - return XEXP (x, 0) == XEXP (y, 0); - if (code == SYMBOL_REF) - return XSTR (x, 0) == XSTR (y, 0); - - /* For commutative operations, the RTX match if the operand match in any - order. Also handle the simple binary and unary cases without a loop. */ - if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') - return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) - || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); - else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') - return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) - && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); - else if (GET_RTX_CLASS (code) == '1') - return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); - - /* Compare the elements. If any pair of corresponding elements - fail to match, return 0 for the whole things. */ - - fmt = GET_RTX_FORMAT (code); - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - { - switch (fmt[i]) - { - case 'w': - if (XWINT (x, i) != XWINT (y, i)) - return 0; - break; - - case 'n': - case 'i': - if (XINT (x, i) != XINT (y, i)) - return 0; - break; - - case 'V': - case 'E': - /* Two vectors must have the same length. */ - if (XVECLEN (x, i) != XVECLEN (y, i)) - return 0; - - /* And the corresponding elements must match. */ - for (j = 0; j < XVECLEN (x, i); j++) - if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) - return 0; - break; - - case 'e': - if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) - return 0; - break; - - case 'S': - case 's': - if (strcmp (XSTR (x, i), XSTR (y, i))) - return 0; - break; - - case 'u': - /* These are just backpointers, so they don't matter. */ - break; - - case '0': - break; - - /* It is believed that rtx's at this level will never - contain anything but integers and other rtx's, - except for within LABEL_REFs and SYMBOL_REFs. */ - default: - abort (); - } - } - return 1; -} - -/* Given an rtx X, find a SYMBOL_REF or LABEL_REF within - X and return it, or return 0 if none found. */ - -static rtx -find_symbolic_term (x) - rtx x; -{ - register int i; - register enum rtx_code code; - register char *fmt; - - code = GET_CODE (x); - if (code == SYMBOL_REF || code == LABEL_REF) - return x; - if (GET_RTX_CLASS (code) == 'o') - return 0; - - fmt = GET_RTX_FORMAT (code); - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - { - rtx t; - - if (fmt[i] == 'e') - { - t = find_symbolic_term (XEXP (x, i)); - if (t != 0) - return t; - } - else if (fmt[i] == 'E') - break; - } - return 0; -} - -static rtx -find_base_term (x) - rtx x; -{ - switch (GET_CODE (x)) - { - case REG: - return REG_BASE_VALUE (x); - - case HIGH: - return find_base_value (XEXP (x, 0)); - - case CONST: - x = XEXP (x, 0); - if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS) - return 0; - /* fall through */ - case LO_SUM: - case PLUS: - case MINUS: - { - rtx tmp = find_base_term (XEXP (x, 0)); - if (tmp) - return tmp; - return find_base_term (XEXP (x, 1)); - } - - case AND: - if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT) - return REG_BASE_VALUE (XEXP (x, 0)); - return 0; - - case SYMBOL_REF: - case LABEL_REF: - return x; - - default: - return 0; - } -} - -/* Return 0 if the addresses X and Y are known to point to different - objects, 1 if they might be pointers to the same object. */ - -static int -base_alias_check (x, y) - rtx x, y; -{ - rtx x_base = find_base_term (x); - rtx y_base = find_base_term (y); - - /* If either base address is unknown or the base addresses are equal, - nothing is known about aliasing. */ - if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base)) - return 1; - - /* The base addresses of the read and write are different - expressions. If they are both symbols there is no - conflict. */ - if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS) - return 0; - - /* If one address is a stack reference there can be no alias: - stack references using different base registers do not alias, - a stack reference can not alias a parameter, and a stack reference - can not alias a global. */ - if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode) - || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode)) - return 0; - - if (! flag_argument_noalias) - return 1; - - if (flag_argument_noalias > 1) - return 0; - - /* Weak noalias assertion (arguments are distinct, but may match globals). */ - return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode); -} - -/* Return nonzero if X and Y (memory addresses) could reference the - same location in memory. C is an offset accumulator. When - C is nonzero, we are testing aliases between X and Y + C. - XSIZE is the size in bytes of the X reference, - similarly YSIZE is the size in bytes for Y. - - If XSIZE or YSIZE is zero, we do not know the amount of memory being - referenced (the reference was BLKmode), so make the most pessimistic - assumptions. - - We recognize the following cases of non-conflicting memory: - - (1) addresses involving the frame pointer cannot conflict - with addresses involving static variables. - (2) static variables with different addresses cannot conflict. - - Nice to notice that varying addresses cannot conflict with fp if no - local variables had their addresses taken, but that's too hard now. */ - - -static int -memrefs_conflict_p (xsize, x, ysize, y, c) - register rtx x, y; - int xsize, ysize; - HOST_WIDE_INT c; -{ - if (GET_CODE (x) == HIGH) - x = XEXP (x, 0); - else if (GET_CODE (x) == LO_SUM) - x = XEXP (x, 1); - else - x = canon_rtx (x); - if (GET_CODE (y) == HIGH) - y = XEXP (y, 0); - else if (GET_CODE (y) == LO_SUM) - y = XEXP (y, 1); - else - y = canon_rtx (y); - - if (rtx_equal_for_memref_p (x, y)) - { - if (xsize == 0 || ysize == 0) - return 1; - if (c >= 0 && xsize > c) - return 1; - if (c < 0 && ysize+c > 0) - return 1; - return 0; - } - - if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx - || y == stack_pointer_rtx) - { - rtx t = y; - int tsize = ysize; - y = x; ysize = xsize; - x = t; xsize = tsize; - } - - if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx - || x == stack_pointer_rtx) - { - rtx y1; - - if (CONSTANT_P (y)) - return 0; - - if (GET_CODE (y) == PLUS - && canon_rtx (XEXP (y, 0)) == x - && (y1 = canon_rtx (XEXP (y, 1))) - && GET_CODE (y1) == CONST_INT) - { - c += INTVAL (y1); - return (xsize == 0 || ysize == 0 - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - } - - if (GET_CODE (y) == PLUS - && (y1 = canon_rtx (XEXP (y, 0))) - && CONSTANT_P (y1)) - return 0; - - return 1; - } - - if (GET_CODE (x) == PLUS) - { - /* The fact that X is canonicalized means that this - PLUS rtx is canonicalized. */ - rtx x0 = XEXP (x, 0); - rtx x1 = XEXP (x, 1); - - if (GET_CODE (y) == PLUS) - { - /* The fact that Y is canonicalized means that this - PLUS rtx is canonicalized. */ - rtx y0 = XEXP (y, 0); - rtx y1 = XEXP (y, 1); - - if (rtx_equal_for_memref_p (x1, y1)) - return memrefs_conflict_p (xsize, x0, ysize, y0, c); - if (rtx_equal_for_memref_p (x0, y0)) - return memrefs_conflict_p (xsize, x1, ysize, y1, c); - if (GET_CODE (x1) == CONST_INT) - if (GET_CODE (y1) == CONST_INT) - return memrefs_conflict_p (xsize, x0, ysize, y0, - c - INTVAL (x1) + INTVAL (y1)); - else - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - else if (GET_CODE (y1) == CONST_INT) - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - - /* Handle case where we cannot understand iteration operators, - but we notice that the base addresses are distinct objects. */ - /* ??? Is this still necessary? */ - x = find_symbolic_term (x); - if (x == 0) - return 1; - y = find_symbolic_term (y); - if (y == 0) - return 1; - return rtx_equal_for_memref_p (x, y); - } - else if (GET_CODE (x1) == CONST_INT) - return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); - } - else if (GET_CODE (y) == PLUS) - { - /* The fact that Y is canonicalized means that this - PLUS rtx is canonicalized. */ - rtx y0 = XEXP (y, 0); - rtx y1 = XEXP (y, 1); - - if (GET_CODE (y1) == CONST_INT) - return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); - else - return 1; - } - - if (GET_CODE (x) == GET_CODE (y)) - switch (GET_CODE (x)) - { - case MULT: - { - /* Handle cases where we expect the second operands to be the - same, and check only whether the first operand would conflict - or not. */ - rtx x0, y0; - rtx x1 = canon_rtx (XEXP (x, 1)); - rtx y1 = canon_rtx (XEXP (y, 1)); - if (! rtx_equal_for_memref_p (x1, y1)) - return 1; - x0 = canon_rtx (XEXP (x, 0)); - y0 = canon_rtx (XEXP (y, 0)); - if (rtx_equal_for_memref_p (x0, y0)) - return (xsize == 0 || ysize == 0 - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - - /* Can't properly adjust our sizes. */ - if (GET_CODE (x1) != CONST_INT) - return 1; - xsize /= INTVAL (x1); - ysize /= INTVAL (x1); - c /= INTVAL (x1); - return memrefs_conflict_p (xsize, x0, ysize, y0, c); - } - } - - /* Treat an access through an AND (e.g. a subword access on an Alpha) - as an access with indeterminate size. */ - if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT) - return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c); - if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT) - return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c); - - if (CONSTANT_P (x)) - { - if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) - { - c += (INTVAL (y) - INTVAL (x)); - return (xsize == 0 || ysize == 0 - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); - } - - if (GET_CODE (x) == CONST) - { - if (GET_CODE (y) == CONST) - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - ysize, canon_rtx (XEXP (y, 0)), c); - else - return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), - ysize, y, c); - } - if (GET_CODE (y) == CONST) - return memrefs_conflict_p (xsize, x, ysize, - canon_rtx (XEXP (y, 0)), c); - - if (CONSTANT_P (y)) - return (rtx_equal_for_memref_p (x, y) - && (xsize == 0 || ysize == 0 - || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); - - return 1; - } - return 1; -} - -/* Functions to compute memory dependencies. - - Since we process the insns in execution order, we can build tables - to keep track of what registers are fixed (and not aliased), what registers - are varying in known ways, and what registers are varying in unknown - ways. - - If both memory references are volatile, then there must always be a - dependence between the two references, since their order can not be - changed. A volatile and non-volatile reference can be interchanged - though. - - A MEM_IN_STRUCT reference at a non-QImode varying address can never - conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must - allow QImode aliasing because the ANSI C standard allows character - pointers to alias anything. We are assuming that characters are - always QImode here. */ - -/* Read dependence: X is read after read in MEM takes place. There can - only be a dependence here if both reads are volatile. */ - -int -read_dependence (mem, x) - rtx mem; - rtx x; -{ - return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); -} - -/* True dependence: X is read after store in MEM takes place. */ - -int -true_dependence (mem, mem_mode, x, varies) - rtx mem; - enum machine_mode mem_mode; - rtx x; - int (*varies)(); -{ - rtx x_addr, mem_addr; - - if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - return 1; - - x_addr = XEXP (x, 0); - mem_addr = XEXP (mem, 0); - - if (flag_alias_check && ! base_alias_check (x_addr, mem_addr)) - return 0; - - /* If X is an unchanging read, then it can't possibly conflict with any - non-unchanging store. It may conflict with an unchanging write though, - because there may be a single store to this address to initialize it. - Just fall through to the code below to resolve the case where we have - both an unchanging read and an unchanging write. This won't handle all - cases optimally, but the possible performance loss should be - negligible. */ - if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) - return 0; - - x_addr = canon_rtx (x_addr); - mem_addr = canon_rtx (mem_addr); - if (mem_mode == VOIDmode) - mem_mode = GET_MODE (mem); - - if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0)) - return 0; - - /* If both references are struct references, or both are not, nothing - is known about aliasing. - - If either reference is QImode or BLKmode, ANSI C permits aliasing. - - If both addresses are constant, or both are not, nothing is known - about aliasing. */ - if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem) - || mem_mode == QImode || mem_mode == BLKmode - || GET_MODE (x) == QImode || GET_MODE (mem) == BLKmode - || varies (x_addr) == varies (mem_addr)) - return 1; - - /* One memory reference is to a constant address, one is not. - One is to a structure, the other is not. - - If either memory reference is a variable structure the other is a - fixed scalar and there is no aliasing. */ - if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr)) - || (MEM_IN_STRUCT_P (x) && varies (x))) - return 0; - - return 1; -} - -/* Anti dependence: X is written after read in MEM takes place. */ - -int -anti_dependence (mem, x) - rtx mem; - rtx x; -{ - if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - return 1; - - if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0))) - return 0; - - /* If MEM is an unchanging read, then it can't possibly conflict with - the store to X, because there is at most one store to MEM, and it must - have occurred somewhere before MEM. */ - x = canon_rtx (x); - mem = canon_rtx (mem); - if (RTX_UNCHANGING_P (mem)) - return 0; - - return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - SIZE_FOR_MODE (x), XEXP (x, 0), 0) - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - && GET_MODE (mem) != QImode - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - && GET_MODE (x) != QImode - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); -} - -/* Output dependence: X is written after store in MEM takes place. */ - -int -output_dependence (mem, x) - register rtx mem; - register rtx x; -{ - if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) - return 1; - - if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0))) - return 0; - - x = canon_rtx (x); - mem = canon_rtx (mem); - return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), - SIZE_FOR_MODE (x), XEXP (x, 0), 0) - && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) - && GET_MODE (mem) != QImode - && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) - && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) - && GET_MODE (x) != QImode - && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); -} - -void -init_alias_analysis () -{ - int maxreg = max_reg_num (); - register int i; - register rtx insn; - rtx note; - rtx set; - int changed; - - reg_known_value_size = maxreg; - - reg_known_value - = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx)) - - FIRST_PSEUDO_REGISTER; - reg_known_equiv_p = - oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER; - bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), - (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); - bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, - (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); - - if (flag_alias_check) - { - /* Overallocate reg_base_value to allow some growth during loop - optimization. Loop unrolling can create a large number of - registers. */ - reg_base_value_size = maxreg * 2; - reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx)); - reg_seen = (char *)alloca (reg_base_value_size); - bzero (reg_base_value, reg_base_value_size * sizeof (rtx)); - bzero (reg_seen, reg_base_value_size); - - /* Mark all hard registers which may contain an address. - The stack, frame and argument pointers may contain an address. - An argument register which can hold a Pmode value may contain - an address even if it is not in BASE_REGS. - - The address expression is VOIDmode for an argument and - Pmode for other registers. */ - for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) - if (FUNCTION_ARG_REGNO_P (i) && HARD_REGNO_MODE_OK (i, Pmode)) - reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode, - gen_rtx (REG, Pmode, i)); - - reg_base_value[STACK_POINTER_REGNUM] - = gen_rtx (ADDRESS, Pmode, stack_pointer_rtx); - reg_base_value[ARG_POINTER_REGNUM] - = gen_rtx (ADDRESS, Pmode, arg_pointer_rtx); - reg_base_value[FRAME_POINTER_REGNUM] - = gen_rtx (ADDRESS, Pmode, frame_pointer_rtx); - reg_base_value[HARD_FRAME_POINTER_REGNUM] - = gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx); - } - - copying_arguments = 1; - /* Fill in the entries with known constant values. */ - for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) - { - if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i') - { - /* If this insn has a noalias note, process it, Otherwise, - scan for sets. A simple set will have no side effects - which could change the base value of any other register. */ - rtx noalias_note; - if (GET_CODE (PATTERN (insn)) == SET - && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX))) - record_set(SET_DEST (PATTERN (insn)), 0); - else - note_stores (PATTERN (insn), record_set); - } - else if (GET_CODE (insn) == NOTE - && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG) - copying_arguments = 0; - - if ((set = single_set (insn)) != 0 - && GET_CODE (SET_DEST (set)) == REG - && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER - && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 - && reg_n_sets[REGNO (SET_DEST (set))] == 1) - || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) - && GET_CODE (XEXP (note, 0)) != EXPR_LIST) - { - int regno = REGNO (SET_DEST (set)); - reg_known_value[regno] = XEXP (note, 0); - reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; - } - } - - /* Fill in the remaining entries. */ - for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++) - if (reg_known_value[i] == 0) - reg_known_value[i] = regno_reg_rtx[i]; - - if (! flag_alias_check) - return; - - /* Simplify the reg_base_value array so that no register refers to - another register, except to special registers indirectly through - ADDRESS expressions. - - In theory this loop can take as long as O(registers^2), but unless - there are very long dependency chains it will run in close to linear - time. */ - do - { - changed = 0; - for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++) - { - rtx base = reg_base_value[i]; - if (base && GET_CODE (base) == REG) - { - int base_regno = REGNO (base); - if (base_regno == i) /* register set from itself */ - reg_base_value[i] = 0; - else - reg_base_value[i] = reg_base_value[base_regno]; - changed = 1; - } - } - } - while (changed); - - reg_seen = 0; -} - -void -end_alias_analysis () -{ - reg_known_value = 0; - reg_base_value = 0; - reg_base_value_size = 0; -} diff --git a/gnu/usr.bin/gcc/config/alpha/linux.h b/gnu/usr.bin/gcc/config/alpha/linux.h deleted file mode 100644 index cecf0b1147d..00000000000 --- a/gnu/usr.bin/gcc/config/alpha/linux.h +++ /dev/null @@ -1,72 +0,0 @@ -/* Definitions of target machine for GNU compiler, for Alpha Linux, - using ECOFF. - Copyright (C) 1995 Free Software Foundation, Inc. - Contributed by Bob Manson. - Derived from work contributed by Cygnus Support, - (c) 1993 Free Software Foundation. - -This file is part of GNU CC. - -GNU CC is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -GNU CC is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU CC; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ - -#define TARGET_DEFAULT (3 | MASK_GAS) - -#include "alpha/alpha.h" - -#undef TARGET_VERSION -#define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)"); - -#undef CPP_PREDEFINES -#define CPP_PREDEFINES "\ --D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \ --Asystem(linux) -Acpu(alpha) -Amachine(alpha)" - -/* We don't actually need any of these; the MD_ vars are ignored - anyway for cross-compilers, and the other specs won't get picked up - 'coz the user is supposed to do ld -r (hmm, perhaps that should be - the default). In any case, setting them thus will catch some - common user errors. */ - -#undef MD_EXEC_PREFIX -#undef MD_STARTFILE_PREFIX - -#undef LIB_SPEC -#define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}" - -#undef LINK_SPEC -#define LINK_SPEC \ - "-G 8 %{O*:-O3} %{!O*:-O1}" - -#undef ASM_SPEC -#define ASM_SPEC "-nocpp" - -/* Can't do stabs */ -#undef SDB_DEBUGGING_INFO - -/* Prefer dbx. */ -#undef PREFERRED_DEBUGGING_TYPE -#define PREFERRED_DEBUGGING_TYPE DBX_DEBUG - -#undef FUNCTION_PROFILER - -#define FUNCTION_PROFILER(FILE, LABELNO) \ - do { \ - fputs ("\tlda $27,_mcount\n", (FILE)); \ - fputs ("\tjsr $26,($27),_mcount\n", (FILE)); \ - fputs ("\tldgp $29,0($26)\n", (FILE)); \ - } while (0); - -/* Generate calls to memcpy, etc., not bcopy, etc. */ -#define TARGET_MEM_FUNCTIONS diff --git a/gnu/usr.bin/gcc/config/alpha/t-linux b/gnu/usr.bin/gcc/config/alpha/t-linux deleted file mode 100644 index 015d7c834e8..00000000000 --- a/gnu/usr.bin/gcc/config/alpha/t-linux +++ /dev/null @@ -1,3 +0,0 @@ -# Our header files are supposed to be correct, nein? -FIXINCLUDES = -STMP_FIXPROTO = diff --git a/gnu/usr.bin/gcc/config/alpha/x-linux b/gnu/usr.bin/gcc/config/alpha/x-linux deleted file mode 100644 index c3b3fbf43a7..00000000000 --- a/gnu/usr.bin/gcc/config/alpha/x-linux +++ /dev/null @@ -1 +0,0 @@ -CLIB=-lbfd -liberty diff --git a/gnu/usr.bin/gcc/config/alpha/xm-linux.h b/gnu/usr.bin/gcc/config/alpha/xm-linux.h deleted file mode 100644 index bb00115928d..00000000000 --- a/gnu/usr.bin/gcc/config/alpha/xm-linux.h +++ /dev/null @@ -1,8 +0,0 @@ -#ifndef _XM_LINUX_H -#define _XM_LINUX_H - -#include "xm-alpha.h" - -#define DONT_DECLARE_SYS_SIGLIST -#define USE_BFD -#endif diff --git a/gnu/usr.bin/gcc/config/romp/xm-romp.h b/gnu/usr.bin/gcc/config/romp/xm-romp.h index 37de6de8d38..b7924c78846 100644 --- a/gnu/usr.bin/gcc/config/romp/xm-romp.h +++ b/gnu/usr.bin/gcc/config/romp/xm-romp.h @@ -48,7 +48,9 @@ Boston, MA 02111-1307, USA. */ #define FUNCTION_CONVERSION_BUG #endif +#ifdef ibm032 /* We cannot allow cccp.o to contain a copy of BCOPY as this will cause multiple definitions since BLT and BCOPY share an object file in libc.a and the library references BLT. */ #define BSTRING +#endif diff --git a/gnu/usr.bin/gcc/config/x-linux-aout b/gnu/usr.bin/gcc/config/x-linux-aout deleted file mode 100644 index ea2a5f270b3..00000000000 --- a/gnu/usr.bin/gcc/config/x-linux-aout +++ /dev/null @@ -1,14 +0,0 @@ -# It is defined in config/xm-linux.h. -# X_CFLAGS = -DPOSIX - -# The following is needed when compiling stages 2 and 3 because gcc's -# limits.h must be picked up before /usr/include/limits.h. This is because -# each does an #include_next of the other if the other hasn't been included. -# /usr/include/limits.h loses if it gets found first because /usr/include is -# at the end of the search order. When a new version of gcc is released, -# gcc's limits.h hasn't been installed yet and hence isn't found. - -BOOT_CFLAGS = -O $(CFLAGS) -Iinclude - -# Don't run fixproto -STMP_FIXPROTO = diff --git a/gnu/usr.bin/gcc/configure b/gnu/usr.bin/gcc/configure index 5a0a5b72a13..a2196166a09 100644 --- a/gnu/usr.bin/gcc/configure +++ b/gnu/usr.bin/gcc/configure @@ -2174,6 +2174,14 @@ for machine in $canon_build $canon_host $canon_target; do romp-*-aos*) use_collect2=yes ;; + romp-*-openbsd*) + cpu_type=romp + xm_file=romp/xm-openbsd.h + tm_file=romp/openbsd.h + # On OpenBSD, the headers are already okay. + fixincludes=Makefile.in + xmake_file=romp/x-openbsd + ;; romp-*-mach*) xmake_file=romp/x-mach use_collect2=yes diff --git a/gnu/usr.bin/gcc/f/gbe/2.7.2.2.diff b/gnu/usr.bin/gcc/f/gbe/2.7.2.2.diff deleted file mode 100644 index 80903bed46f..00000000000 --- a/gnu/usr.bin/gcc/f/gbe/2.7.2.2.diff +++ /dev/null @@ -1,4100 +0,0 @@ -IMPORTANT: After applying this patch, you must rebuild the -Info documentation derived from the Texinfo files in the -gcc distribution, as this patch does not include patches -to any derived files (due to differences in the way gcc -version 2.7.2.2 is obtained by users). Use the following -command sequence after applying this patch: - - cd gcc-2.7.2.2; make -f Makefile.in gcc.info - -If that fails due to `makeinfo' not being installed, obtain -texinfo-3.9.tar.gz from a GNU distribution site, unpack, -build, and install it, and try the above command sequence -again. - - -diff -rcp2N gcc-2.7.2.2/ChangeLog gcc-2.7.2.2.f.2/ChangeLog -*** gcc-2.7.2.2/ChangeLog Thu Feb 20 19:24:10 1997 ---- gcc-2.7.2.2.f.2/ChangeLog Thu Feb 27 23:04:00 1997 -*************** -*** 1,2 **** ---- 1,69 ---- -+ Wed Feb 26 13:09:33 1997 Michael Meissner <meissner@cygnus.com> -+ -+ * reload.c (debug_reload): Fix format string to print -+ reload_nocombine[r]. -+ -+ Sun Feb 23 15:26:53 1997 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ * fold-const.c (multiple_of_p): Clean up and improve. -+ (fold): Clean up invocation of multiple_of_p. -+ -+ Sat Feb 8 04:53:27 1997 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ From <jfc@jfc.tiac.net> Fri, 07 Feb 1997 22:02:21 -0500: -+ * alias.c (init_alias_analysis): Reduce amount of time -+ needed to simplify the reg_base_value array in the -+ typical case (especially involving function inlining). -+ -+ Fri Jan 10 17:22:17 1997 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ Minor improvements/fixes to better alias handling: -+ * Makefile.in (alias.o): Fix typo in rule (was RLT_H). -+ * cse.c, sched.c: Fix up some indenting. -+ * toplev.c: Add -fargument-alias flag, so Fortran users -+ can turn C-style aliasing on once g77 defaults to -+ -fargument-noalias-global. -+ -+ Integrate patch for better alias handling from -+ John Carr <jfc@mit.edu>: -+ * Makefile.in (OBJS, alias.o): New module and rule. -+ * alias.c: New source module. -+ * calls.c (expand_call): Recognize alias status of calls -+ to malloc(). -+ * combine.c (distribute_notes): New REG_NOALIAS note. -+ * rtl.h (REG_NOALIAS): Ditto. -+ Many other changes for new alias.c module. -+ * cse.c: Many changes, and much code moved into alias.c. -+ * flags.h (flag_alias_check, flag_argument_noalias): -+ New flags. -+ * toplev.c: New flags and related options. -+ * local-alloc.c (validate_equiv_mem_from_store): -+ Caller of true_dependence changed. -+ * loop.c (NUM_STORES): Increase to 50 from 20. -+ (prescan_loop): "const" functions don't alter unknown addresses. -+ (invariant_p): Caller of true_dependence changed. -+ (record_giv): Zero new unrolled and shared flags. -+ (emit_iv_add_mult): Record base value for register. -+ * sched.c: Many changes, mostly moving code to alias.c. -+ (sched_note_set): SCHED_SORT macro def form, but not function, -+ inexplicably changed. -+ * unroll.c: Record base values for registers, etc. -+ -+ Fri Jan 3 04:01:00 1997 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ * loop.c (check_final_value): Handle insns with no luid's -+ appropriately, instead of crashing on INSN_LUID macro -+ invocations. -+ -+ Mon Dec 23 00:49:19 1996 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ * config/alpha/alpha.md: Fix pattern that matches if_then_else -+ involving DF target, DF comparison, SF source. -+ -+ Fri Dec 20 15:42:52 1996 Craig Burley <burley@gnu.ai.mit.edu> -+ -+ * fold-const.c (multiple_of_p): New function. -+ (fold): Use new function to turn *_DIV_EXPR into EXACT_DIV_EXPR. -+ - Sat Jun 29 12:33:39 1996 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> - -diff -rcp2N gcc-2.7.2.2/Makefile.in gcc-2.7.2.2.f.2/Makefile.in -*** gcc-2.7.2.2/Makefile.in Sun Nov 26 14:44:25 1995 ---- gcc-2.7.2.2.f.2/Makefile.in Sun Feb 23 16:36:34 1997 -*************** OBJS = toplev.o version.o tree.o print-t -*** 519,523 **** - integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ - regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ -! insn-peep.o reorg.o sched.o final.o recog.o reg-stack.o \ - insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ - insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) ---- 519,523 ---- - integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \ - regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \ -! insn-peep.o reorg.o alias.o sched.o final.o recog.o reg-stack.o \ - insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \ - insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS) -*************** reorg.o : reorg.c $(CONFIG_H) $(RTL_H) c -*** 1238,1241 **** ---- 1238,1242 ---- - basic-block.h regs.h insn-config.h insn-attr.h insn-flags.h recog.h \ - flags.h output.h -+ alias.o : $(CONFIG_H) $(RTL_H) flags.h hard-reg-set.h regs.h - sched.o : sched.c $(CONFIG_H) $(RTL_H) basic-block.h regs.h hard-reg-set.h \ - flags.h insn-config.h insn-attr.h -diff -rcp2N gcc-2.7.2.2/alias.c gcc-2.7.2.2.f.2/alias.c -*** gcc-2.7.2.2/alias.c Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/alias.c Sat Feb 8 04:53:07 1997 -*************** -*** 0 **** ---- 1,989 ---- -+ /* Alias analysis for GNU C, by John Carr (jfc@mit.edu). -+ Derived in part from sched.c */ -+ #include "config.h" -+ #include "rtl.h" -+ #include "expr.h" -+ #include "regs.h" -+ #include "hard-reg-set.h" -+ #include "flags.h" -+ -+ static rtx canon_rtx PROTO((rtx)); -+ static int rtx_equal_for_memref_p PROTO((rtx, rtx)); -+ static rtx find_symbolic_term PROTO((rtx)); -+ static int memrefs_conflict_p PROTO((int, rtx, int, rtx, -+ HOST_WIDE_INT)); -+ -+ /* Set up all info needed to perform alias analysis on memory references. */ -+ -+ #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) -+ -+ /* reg_base_value[N] gives an address to which register N is related. -+ If all sets after the first add or subtract to the current value -+ or otherwise modify it so it does not point to a different top level -+ object, reg_base_value[N] is equal to the address part of the source -+ of the first set. The value will be a SYMBOL_REF, a LABEL_REF, or -+ (address (reg)) to indicate that the address is derived from an -+ argument or fixed register. */ -+ rtx *reg_base_value; -+ unsigned int reg_base_value_size; /* size of reg_base_value array */ -+ #define REG_BASE_VALUE(X) \ -+ (REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0) -+ -+ /* Vector indexed by N giving the initial (unchanging) value known -+ for pseudo-register N. */ -+ rtx *reg_known_value; -+ -+ /* Indicates number of valid entries in reg_known_value. */ -+ static int reg_known_value_size; -+ -+ /* Vector recording for each reg_known_value whether it is due to a -+ REG_EQUIV note. Future passes (viz., reload) may replace the -+ pseudo with the equivalent expression and so we account for the -+ dependences that would be introduced if that happens. */ -+ /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in -+ assign_parms mention the arg pointer, and there are explicit insns in the -+ RTL that modify the arg pointer. Thus we must ensure that such insns don't -+ get scheduled across each other because that would invalidate the REG_EQUIV -+ notes. One could argue that the REG_EQUIV notes are wrong, but solving -+ the problem in the scheduler will likely give better code, so we do it -+ here. */ -+ char *reg_known_equiv_p; -+ -+ /* Inside SRC, the source of a SET, find a base address. */ -+ -+ /* When copying arguments into pseudo-registers, record the (ADDRESS) -+ expression for the argument directly so that even if the argument -+ register is changed later (e.g. for a function call) the original -+ value is noted. */ -+ static int copying_arguments; -+ -+ static rtx -+ find_base_value (src) -+ register rtx src; -+ { -+ switch (GET_CODE (src)) -+ { -+ case SYMBOL_REF: -+ case LABEL_REF: -+ return src; -+ -+ case REG: -+ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) -+ return reg_base_value[REGNO (src)]; -+ return src; -+ -+ case MEM: -+ /* Check for an argument passed in memory. Only record in the -+ copying-arguments block; it is too hard to track changes -+ otherwise. */ -+ if (copying_arguments -+ && (XEXP (src, 0) == arg_pointer_rtx -+ || (GET_CODE (XEXP (src, 0)) == PLUS -+ && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx))) -+ return gen_rtx (ADDRESS, VOIDmode, src); -+ return 0; -+ -+ case CONST: -+ src = XEXP (src, 0); -+ if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS) -+ break; -+ /* fall through */ -+ case PLUS: -+ case MINUS: -+ /* Guess which operand to set the register equivalent to. */ -+ /* If the first operand is a symbol or the second operand is -+ an integer, the first operand is the base address. */ -+ if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF -+ || GET_CODE (XEXP (src, 0)) == LABEL_REF -+ || GET_CODE (XEXP (src, 1)) == CONST_INT) -+ return XEXP (src, 0); -+ /* If an operand is a register marked as a pointer, it is the base. */ -+ if (GET_CODE (XEXP (src, 0)) == REG -+ && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0)))) -+ src = XEXP (src, 0); -+ else if (GET_CODE (XEXP (src, 1)) == REG -+ && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1)))) -+ src = XEXP (src, 1); -+ else -+ return 0; -+ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) -+ return reg_base_value[REGNO (src)]; -+ return src; -+ -+ case AND: -+ /* If the second operand is constant set the base -+ address to the first operand. */ -+ if (GET_CODE (XEXP (src, 1)) == CONST_INT -+ && GET_CODE (XEXP (src, 0)) == REG) -+ { -+ src = XEXP (src, 0); -+ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER) -+ return reg_base_value[REGNO (src)]; -+ return src; -+ } -+ return 0; -+ -+ case HIGH: -+ return XEXP (src, 0); -+ } -+ -+ return 0; -+ } -+ -+ /* Called from init_alias_analysis indirectly through note_stores. */ -+ -+ /* while scanning insns to find base values, reg_seen[N] is nonzero if -+ register N has been set in this function. */ -+ static char *reg_seen; -+ -+ static -+ void record_set (dest, set) -+ rtx dest, set; -+ { -+ register int regno; -+ rtx src; -+ -+ if (GET_CODE (dest) != REG) -+ return; -+ -+ regno = REGNO (dest); -+ -+ if (set) -+ { -+ /* A CLOBBER wipes out any old value but does not prevent a previously -+ unset register from acquiring a base address (i.e. reg_seen is not -+ set). */ -+ if (GET_CODE (set) == CLOBBER) -+ { -+ reg_base_value[regno] = 0; -+ return; -+ } -+ src = SET_SRC (set); -+ } -+ else -+ { -+ static int unique_id; -+ if (reg_seen[regno]) -+ { -+ reg_base_value[regno] = 0; -+ return; -+ } -+ reg_seen[regno] = 1; -+ reg_base_value[regno] = gen_rtx (ADDRESS, Pmode, -+ GEN_INT (unique_id++)); -+ return; -+ } -+ -+ /* This is not the first set. If the new value is not related to the -+ old value, forget the base value. Note that the following code is -+ not detected: -+ extern int x, y; int *p = &x; p += (&y-&x); -+ ANSI C does not allow computing the difference of addresses -+ of distinct top level objects. */ -+ if (reg_base_value[regno]) -+ switch (GET_CODE (src)) -+ { -+ case PLUS: -+ case MINUS: -+ if (XEXP (src, 0) != dest && XEXP (src, 1) != dest) -+ reg_base_value[regno] = 0; -+ break; -+ case AND: -+ if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT) -+ reg_base_value[regno] = 0; -+ break; -+ case LO_SUM: -+ if (XEXP (src, 0) != dest) -+ reg_base_value[regno] = 0; -+ break; -+ default: -+ reg_base_value[regno] = 0; -+ break; -+ } -+ /* If this is the first set of a register, record the value. */ -+ else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno]) -+ && ! reg_seen[regno] && reg_base_value[regno] == 0) -+ reg_base_value[regno] = find_base_value (src); -+ -+ reg_seen[regno] = 1; -+ } -+ -+ /* Called from loop optimization when a new pseudo-register is created. */ -+ void -+ record_base_value (regno, val) -+ int regno; -+ rtx val; -+ { -+ if (!flag_alias_check || regno >= reg_base_value_size) -+ return; -+ if (GET_CODE (val) == REG) -+ { -+ if (REGNO (val) < reg_base_value_size) -+ reg_base_value[regno] = reg_base_value[REGNO (val)]; -+ return; -+ } -+ reg_base_value[regno] = find_base_value (val); -+ } -+ -+ static rtx -+ canon_rtx (x) -+ rtx x; -+ { -+ /* Recursively look for equivalences. */ -+ if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER -+ && REGNO (x) < reg_known_value_size) -+ return reg_known_value[REGNO (x)] == x -+ ? x : canon_rtx (reg_known_value[REGNO (x)]); -+ else if (GET_CODE (x) == PLUS) -+ { -+ rtx x0 = canon_rtx (XEXP (x, 0)); -+ rtx x1 = canon_rtx (XEXP (x, 1)); -+ -+ if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) -+ { -+ /* We can tolerate LO_SUMs being offset here; these -+ rtl are used for nothing other than comparisons. */ -+ if (GET_CODE (x0) == CONST_INT) -+ return plus_constant_for_output (x1, INTVAL (x0)); -+ else if (GET_CODE (x1) == CONST_INT) -+ return plus_constant_for_output (x0, INTVAL (x1)); -+ return gen_rtx (PLUS, GET_MODE (x), x0, x1); -+ } -+ } -+ /* This gives us much better alias analysis when called from -+ the loop optimizer. Note we want to leave the original -+ MEM alone, but need to return the canonicalized MEM with -+ all the flags with their original values. */ -+ else if (GET_CODE (x) == MEM) -+ { -+ rtx addr = canon_rtx (XEXP (x, 0)); -+ if (addr != XEXP (x, 0)) -+ { -+ rtx new = gen_rtx (MEM, GET_MODE (x), addr); -+ MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x); -+ RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x); -+ MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x); -+ x = new; -+ } -+ } -+ return x; -+ } -+ -+ /* Return 1 if X and Y are identical-looking rtx's. -+ -+ We use the data in reg_known_value above to see if two registers with -+ different numbers are, in fact, equivalent. */ -+ -+ static int -+ rtx_equal_for_memref_p (x, y) -+ rtx x, y; -+ { -+ register int i; -+ register int j; -+ register enum rtx_code code; -+ register char *fmt; -+ -+ if (x == 0 && y == 0) -+ return 1; -+ if (x == 0 || y == 0) -+ return 0; -+ x = canon_rtx (x); -+ y = canon_rtx (y); -+ -+ if (x == y) -+ return 1; -+ -+ code = GET_CODE (x); -+ /* Rtx's of different codes cannot be equal. */ -+ if (code != GET_CODE (y)) -+ return 0; -+ -+ /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. -+ (REG:SI x) and (REG:HI x) are NOT equivalent. */ -+ -+ if (GET_MODE (x) != GET_MODE (y)) -+ return 0; -+ -+ /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ -+ -+ if (code == REG) -+ return REGNO (x) == REGNO (y); -+ if (code == LABEL_REF) -+ return XEXP (x, 0) == XEXP (y, 0); -+ if (code == SYMBOL_REF) -+ return XSTR (x, 0) == XSTR (y, 0); -+ -+ /* For commutative operations, the RTX match if the operand match in any -+ order. Also handle the simple binary and unary cases without a loop. */ -+ if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') -+ return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) -+ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) -+ || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) -+ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); -+ else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') -+ return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) -+ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); -+ else if (GET_RTX_CLASS (code) == '1') -+ return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); -+ -+ /* Compare the elements. If any pair of corresponding elements -+ fail to match, return 0 for the whole things. */ -+ -+ fmt = GET_RTX_FORMAT (code); -+ for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) -+ { -+ switch (fmt[i]) -+ { -+ case 'w': -+ if (XWINT (x, i) != XWINT (y, i)) -+ return 0; -+ break; -+ -+ case 'n': -+ case 'i': -+ if (XINT (x, i) != XINT (y, i)) -+ return 0; -+ break; -+ -+ case 'V': -+ case 'E': -+ /* Two vectors must have the same length. */ -+ if (XVECLEN (x, i) != XVECLEN (y, i)) -+ return 0; -+ -+ /* And the corresponding elements must match. */ -+ for (j = 0; j < XVECLEN (x, i); j++) -+ if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) -+ return 0; -+ break; -+ -+ case 'e': -+ if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) -+ return 0; -+ break; -+ -+ case 'S': -+ case 's': -+ if (strcmp (XSTR (x, i), XSTR (y, i))) -+ return 0; -+ break; -+ -+ case 'u': -+ /* These are just backpointers, so they don't matter. */ -+ break; -+ -+ case '0': -+ break; -+ -+ /* It is believed that rtx's at this level will never -+ contain anything but integers and other rtx's, -+ except for within LABEL_REFs and SYMBOL_REFs. */ -+ default: -+ abort (); -+ } -+ } -+ return 1; -+ } -+ -+ /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within -+ X and return it, or return 0 if none found. */ -+ -+ static rtx -+ find_symbolic_term (x) -+ rtx x; -+ { -+ register int i; -+ register enum rtx_code code; -+ register char *fmt; -+ -+ code = GET_CODE (x); -+ if (code == SYMBOL_REF || code == LABEL_REF) -+ return x; -+ if (GET_RTX_CLASS (code) == 'o') -+ return 0; -+ -+ fmt = GET_RTX_FORMAT (code); -+ for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) -+ { -+ rtx t; -+ -+ if (fmt[i] == 'e') -+ { -+ t = find_symbolic_term (XEXP (x, i)); -+ if (t != 0) -+ return t; -+ } -+ else if (fmt[i] == 'E') -+ break; -+ } -+ return 0; -+ } -+ -+ static rtx -+ find_base_term (x) -+ rtx x; -+ { -+ switch (GET_CODE (x)) -+ { -+ case REG: -+ return REG_BASE_VALUE (x); -+ -+ case HIGH: -+ return find_base_value (XEXP (x, 0)); -+ -+ case CONST: -+ x = XEXP (x, 0); -+ if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS) -+ return 0; -+ /* fall through */ -+ case LO_SUM: -+ case PLUS: -+ case MINUS: -+ { -+ rtx tmp = find_base_term (XEXP (x, 0)); -+ if (tmp) -+ return tmp; -+ return find_base_term (XEXP (x, 1)); -+ } -+ -+ case AND: -+ if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT) -+ return REG_BASE_VALUE (XEXP (x, 0)); -+ return 0; -+ -+ case SYMBOL_REF: -+ case LABEL_REF: -+ return x; -+ -+ default: -+ return 0; -+ } -+ } -+ -+ /* Return 0 if the addresses X and Y are known to point to different -+ objects, 1 if they might be pointers to the same object. */ -+ -+ static int -+ base_alias_check (x, y) -+ rtx x, y; -+ { -+ rtx x_base = find_base_term (x); -+ rtx y_base = find_base_term (y); -+ -+ /* If either base address is unknown or the base addresses are equal, -+ nothing is known about aliasing. */ -+ if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base)) -+ return 1; -+ -+ /* The base addresses of the read and write are different -+ expressions. If they are both symbols there is no -+ conflict. */ -+ if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS) -+ return 0; -+ -+ /* If one address is a stack reference there can be no alias: -+ stack references using different base registers do not alias, -+ a stack reference can not alias a parameter, and a stack reference -+ can not alias a global. */ -+ if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode) -+ || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode)) -+ return 0; -+ -+ if (! flag_argument_noalias) -+ return 1; -+ -+ if (flag_argument_noalias > 1) -+ return 0; -+ -+ /* Weak noalias assertion (arguments are distinct, but may match globals). */ -+ return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode); -+ } -+ -+ /* Return nonzero if X and Y (memory addresses) could reference the -+ same location in memory. C is an offset accumulator. When -+ C is nonzero, we are testing aliases between X and Y + C. -+ XSIZE is the size in bytes of the X reference, -+ similarly YSIZE is the size in bytes for Y. -+ -+ If XSIZE or YSIZE is zero, we do not know the amount of memory being -+ referenced (the reference was BLKmode), so make the most pessimistic -+ assumptions. -+ -+ We recognize the following cases of non-conflicting memory: -+ -+ (1) addresses involving the frame pointer cannot conflict -+ with addresses involving static variables. -+ (2) static variables with different addresses cannot conflict. -+ -+ Nice to notice that varying addresses cannot conflict with fp if no -+ local variables had their addresses taken, but that's too hard now. */ -+ -+ -+ static int -+ memrefs_conflict_p (xsize, x, ysize, y, c) -+ register rtx x, y; -+ int xsize, ysize; -+ HOST_WIDE_INT c; -+ { -+ if (GET_CODE (x) == HIGH) -+ x = XEXP (x, 0); -+ else if (GET_CODE (x) == LO_SUM) -+ x = XEXP (x, 1); -+ else -+ x = canon_rtx (x); -+ if (GET_CODE (y) == HIGH) -+ y = XEXP (y, 0); -+ else if (GET_CODE (y) == LO_SUM) -+ y = XEXP (y, 1); -+ else -+ y = canon_rtx (y); -+ -+ if (rtx_equal_for_memref_p (x, y)) -+ { -+ if (xsize == 0 || ysize == 0) -+ return 1; -+ if (c >= 0 && xsize > c) -+ return 1; -+ if (c < 0 && ysize+c > 0) -+ return 1; -+ return 0; -+ } -+ -+ if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx -+ || y == stack_pointer_rtx) -+ { -+ rtx t = y; -+ int tsize = ysize; -+ y = x; ysize = xsize; -+ x = t; xsize = tsize; -+ } -+ -+ if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx -+ || x == stack_pointer_rtx) -+ { -+ rtx y1; -+ -+ if (CONSTANT_P (y)) -+ return 0; -+ -+ if (GET_CODE (y) == PLUS -+ && canon_rtx (XEXP (y, 0)) == x -+ && (y1 = canon_rtx (XEXP (y, 1))) -+ && GET_CODE (y1) == CONST_INT) -+ { -+ c += INTVAL (y1); -+ return (xsize == 0 || ysize == 0 -+ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -+ } -+ -+ if (GET_CODE (y) == PLUS -+ && (y1 = canon_rtx (XEXP (y, 0))) -+ && CONSTANT_P (y1)) -+ return 0; -+ -+ return 1; -+ } -+ -+ if (GET_CODE (x) == PLUS) -+ { -+ /* The fact that X is canonicalized means that this -+ PLUS rtx is canonicalized. */ -+ rtx x0 = XEXP (x, 0); -+ rtx x1 = XEXP (x, 1); -+ -+ if (GET_CODE (y) == PLUS) -+ { -+ /* The fact that Y is canonicalized means that this -+ PLUS rtx is canonicalized. */ -+ rtx y0 = XEXP (y, 0); -+ rtx y1 = XEXP (y, 1); -+ -+ if (rtx_equal_for_memref_p (x1, y1)) -+ return memrefs_conflict_p (xsize, x0, ysize, y0, c); -+ if (rtx_equal_for_memref_p (x0, y0)) -+ return memrefs_conflict_p (xsize, x1, ysize, y1, c); -+ if (GET_CODE (x1) == CONST_INT) -+ if (GET_CODE (y1) == CONST_INT) -+ return memrefs_conflict_p (xsize, x0, ysize, y0, -+ c - INTVAL (x1) + INTVAL (y1)); -+ else -+ return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); -+ else if (GET_CODE (y1) == CONST_INT) -+ return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); -+ -+ /* Handle case where we cannot understand iteration operators, -+ but we notice that the base addresses are distinct objects. */ -+ /* ??? Is this still necessary? */ -+ x = find_symbolic_term (x); -+ if (x == 0) -+ return 1; -+ y = find_symbolic_term (y); -+ if (y == 0) -+ return 1; -+ return rtx_equal_for_memref_p (x, y); -+ } -+ else if (GET_CODE (x1) == CONST_INT) -+ return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); -+ } -+ else if (GET_CODE (y) == PLUS) -+ { -+ /* The fact that Y is canonicalized means that this -+ PLUS rtx is canonicalized. */ -+ rtx y0 = XEXP (y, 0); -+ rtx y1 = XEXP (y, 1); -+ -+ if (GET_CODE (y1) == CONST_INT) -+ return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); -+ else -+ return 1; -+ } -+ -+ if (GET_CODE (x) == GET_CODE (y)) -+ switch (GET_CODE (x)) -+ { -+ case MULT: -+ { -+ /* Handle cases where we expect the second operands to be the -+ same, and check only whether the first operand would conflict -+ or not. */ -+ rtx x0, y0; -+ rtx x1 = canon_rtx (XEXP (x, 1)); -+ rtx y1 = canon_rtx (XEXP (y, 1)); -+ if (! rtx_equal_for_memref_p (x1, y1)) -+ return 1; -+ x0 = canon_rtx (XEXP (x, 0)); -+ y0 = canon_rtx (XEXP (y, 0)); -+ if (rtx_equal_for_memref_p (x0, y0)) -+ return (xsize == 0 || ysize == 0 -+ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -+ -+ /* Can't properly adjust our sizes. */ -+ if (GET_CODE (x1) != CONST_INT) -+ return 1; -+ xsize /= INTVAL (x1); -+ ysize /= INTVAL (x1); -+ c /= INTVAL (x1); -+ return memrefs_conflict_p (xsize, x0, ysize, y0, c); -+ } -+ } -+ -+ /* Treat an access through an AND (e.g. a subword access on an Alpha) -+ as an access with indeterminate size. */ -+ if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT) -+ return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c); -+ if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT) -+ return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c); -+ -+ if (CONSTANT_P (x)) -+ { -+ if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) -+ { -+ c += (INTVAL (y) - INTVAL (x)); -+ return (xsize == 0 || ysize == 0 -+ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -+ } -+ -+ if (GET_CODE (x) == CONST) -+ { -+ if (GET_CODE (y) == CONST) -+ return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), -+ ysize, canon_rtx (XEXP (y, 0)), c); -+ else -+ return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), -+ ysize, y, c); -+ } -+ if (GET_CODE (y) == CONST) -+ return memrefs_conflict_p (xsize, x, ysize, -+ canon_rtx (XEXP (y, 0)), c); -+ -+ if (CONSTANT_P (y)) -+ return (rtx_equal_for_memref_p (x, y) -+ && (xsize == 0 || ysize == 0 -+ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); -+ -+ return 1; -+ } -+ return 1; -+ } -+ -+ /* Functions to compute memory dependencies. -+ -+ Since we process the insns in execution order, we can build tables -+ to keep track of what registers are fixed (and not aliased), what registers -+ are varying in known ways, and what registers are varying in unknown -+ ways. -+ -+ If both memory references are volatile, then there must always be a -+ dependence between the two references, since their order can not be -+ changed. A volatile and non-volatile reference can be interchanged -+ though. -+ -+ A MEM_IN_STRUCT reference at a non-QImode varying address can never -+ conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must -+ allow QImode aliasing because the ANSI C standard allows character -+ pointers to alias anything. We are assuming that characters are -+ always QImode here. */ -+ -+ /* Read dependence: X is read after read in MEM takes place. There can -+ only be a dependence here if both reads are volatile. */ -+ -+ int -+ read_dependence (mem, x) -+ rtx mem; -+ rtx x; -+ { -+ return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); -+ } -+ -+ /* True dependence: X is read after store in MEM takes place. */ -+ -+ int -+ true_dependence (mem, mem_mode, x, varies) -+ rtx mem; -+ enum machine_mode mem_mode; -+ rtx x; -+ int (*varies)(); -+ { -+ rtx x_addr, mem_addr; -+ -+ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -+ return 1; -+ -+ x_addr = XEXP (x, 0); -+ mem_addr = XEXP (mem, 0); -+ -+ if (flag_alias_check && ! base_alias_check (x_addr, mem_addr)) -+ return 0; -+ -+ /* If X is an unchanging read, then it can't possibly conflict with any -+ non-unchanging store. It may conflict with an unchanging write though, -+ because there may be a single store to this address to initialize it. -+ Just fall through to the code below to resolve the case where we have -+ both an unchanging read and an unchanging write. This won't handle all -+ cases optimally, but the possible performance loss should be -+ negligible. */ -+ if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) -+ return 0; -+ -+ x_addr = canon_rtx (x_addr); -+ mem_addr = canon_rtx (mem_addr); -+ if (mem_mode == VOIDmode) -+ mem_mode = GET_MODE (mem); -+ -+ if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0)) -+ return 0; -+ -+ /* If both references are struct references, or both are not, nothing -+ is known about aliasing. -+ -+ If either reference is QImode or BLKmode, ANSI C permits aliasing. -+ -+ If both addresses are constant, or both are not, nothing is known -+ about aliasing. */ -+ if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem) -+ || mem_mode == QImode || mem_mode == BLKmode -+ || GET_MODE (x) == QImode || GET_MODE (mem) == BLKmode -+ || varies (x_addr) == varies (mem_addr)) -+ return 1; -+ -+ /* One memory reference is to a constant address, one is not. -+ One is to a structure, the other is not. -+ -+ If either memory reference is a variable structure the other is a -+ fixed scalar and there is no aliasing. */ -+ if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr)) -+ || (MEM_IN_STRUCT_P (x) && varies (x))) -+ return 0; -+ -+ return 1; -+ } -+ -+ /* Anti dependence: X is written after read in MEM takes place. */ -+ -+ int -+ anti_dependence (mem, x) -+ rtx mem; -+ rtx x; -+ { -+ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -+ return 1; -+ -+ if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0))) -+ return 0; -+ -+ /* If MEM is an unchanging read, then it can't possibly conflict with -+ the store to X, because there is at most one store to MEM, and it must -+ have occurred somewhere before MEM. */ -+ x = canon_rtx (x); -+ mem = canon_rtx (mem); -+ if (RTX_UNCHANGING_P (mem)) -+ return 0; -+ -+ return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), -+ SIZE_FOR_MODE (x), XEXP (x, 0), 0) -+ && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) -+ && GET_MODE (mem) != QImode -+ && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) -+ && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) -+ && GET_MODE (x) != QImode -+ && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); -+ } -+ -+ /* Output dependence: X is written after store in MEM takes place. */ -+ -+ int -+ output_dependence (mem, x) -+ register rtx mem; -+ register rtx x; -+ { -+ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -+ return 1; -+ -+ if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0))) -+ return 0; -+ -+ x = canon_rtx (x); -+ mem = canon_rtx (mem); -+ return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), -+ SIZE_FOR_MODE (x), XEXP (x, 0), 0) -+ && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) -+ && GET_MODE (mem) != QImode -+ && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) -+ && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) -+ && GET_MODE (x) != QImode -+ && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))); -+ } -+ -+ void -+ init_alias_analysis () -+ { -+ int maxreg = max_reg_num (); -+ register int i; -+ register rtx insn; -+ rtx note; -+ rtx set; -+ int changed; -+ -+ reg_known_value_size = maxreg; -+ -+ reg_known_value -+ = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx)) -+ - FIRST_PSEUDO_REGISTER; -+ reg_known_equiv_p = -+ oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER; -+ bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), -+ (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); -+ bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, -+ (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); -+ -+ if (flag_alias_check) -+ { -+ /* Overallocate reg_base_value to allow some growth during loop -+ optimization. Loop unrolling can create a large number of -+ registers. */ -+ reg_base_value_size = maxreg * 2; -+ reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx)); -+ reg_seen = (char *)alloca (reg_base_value_size); -+ bzero (reg_base_value, reg_base_value_size * sizeof (rtx)); -+ bzero (reg_seen, reg_base_value_size); -+ -+ /* Mark all hard registers which may contain an address. -+ The stack, frame and argument pointers may contain an address. -+ An argument register which can hold a Pmode value may contain -+ an address even if it is not in BASE_REGS. -+ -+ The address expression is VOIDmode for an argument and -+ Pmode for other registers. */ -+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) -+ if (FUNCTION_ARG_REGNO_P (i) && HARD_REGNO_MODE_OK (i, Pmode)) -+ reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode, -+ gen_rtx (REG, Pmode, i)); -+ -+ reg_base_value[STACK_POINTER_REGNUM] -+ = gen_rtx (ADDRESS, Pmode, stack_pointer_rtx); -+ reg_base_value[ARG_POINTER_REGNUM] -+ = gen_rtx (ADDRESS, Pmode, arg_pointer_rtx); -+ reg_base_value[FRAME_POINTER_REGNUM] -+ = gen_rtx (ADDRESS, Pmode, frame_pointer_rtx); -+ reg_base_value[HARD_FRAME_POINTER_REGNUM] -+ = gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx); -+ } -+ -+ copying_arguments = 1; -+ /* Fill in the entries with known constant values. */ -+ for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) -+ { -+ if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i') -+ { -+ /* If this insn has a noalias note, process it, Otherwise, -+ scan for sets. A simple set will have no side effects -+ which could change the base value of any other register. */ -+ rtx noalias_note; -+ if (GET_CODE (PATTERN (insn)) == SET -+ && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX))) -+ record_set(SET_DEST (PATTERN (insn)), 0); -+ else -+ note_stores (PATTERN (insn), record_set); -+ } -+ else if (GET_CODE (insn) == NOTE -+ && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG) -+ copying_arguments = 0; -+ -+ if ((set = single_set (insn)) != 0 -+ && GET_CODE (SET_DEST (set)) == REG -+ && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER -+ && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 -+ && reg_n_sets[REGNO (SET_DEST (set))] == 1) -+ || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) -+ && GET_CODE (XEXP (note, 0)) != EXPR_LIST) -+ { -+ int regno = REGNO (SET_DEST (set)); -+ reg_known_value[regno] = XEXP (note, 0); -+ reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; -+ } -+ } -+ -+ /* Fill in the remaining entries. */ -+ for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++) -+ if (reg_known_value[i] == 0) -+ reg_known_value[i] = regno_reg_rtx[i]; -+ -+ if (! flag_alias_check) -+ return; -+ -+ /* Simplify the reg_base_value array so that no register refers to -+ another register, except to special registers indirectly through -+ ADDRESS expressions. -+ -+ In theory this loop can take as long as O(registers^2), but unless -+ there are very long dependency chains it will run in close to linear -+ time. */ -+ do -+ { -+ changed = 0; -+ for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++) -+ { -+ rtx base = reg_base_value[i]; -+ if (base && GET_CODE (base) == REG) -+ { -+ int base_regno = REGNO (base); -+ if (base_regno == i) /* register set from itself */ -+ reg_base_value[i] = 0; -+ else -+ reg_base_value[i] = reg_base_value[base_regno]; -+ changed = 1; -+ } -+ } -+ } -+ while (changed); -+ -+ reg_seen = 0; -+ } -+ -+ void -+ end_alias_analysis () -+ { -+ reg_known_value = 0; -+ reg_base_value = 0; -+ reg_base_value_size = 0; -+ } -diff -rcp2N gcc-2.7.2.2/calls.c gcc-2.7.2.2.f.2/calls.c -*** gcc-2.7.2.2/calls.c Thu Oct 26 21:53:43 1995 ---- gcc-2.7.2.2.f.2/calls.c Fri Jan 10 23:18:21 1997 -*************** expand_call (exp, target, ignore) -*** 564,567 **** ---- 564,569 ---- - /* Nonzero if it is plausible that this is a call to alloca. */ - int may_be_alloca; -+ /* Nonzero if this is a call to malloc or a related function. */ -+ int is_malloc; - /* Nonzero if this is a call to setjmp or a related function. */ - int returns_twice; -*************** expand_call (exp, target, ignore) -*** 852,855 **** ---- 854,858 ---- - returns_twice = 0; - is_longjmp = 0; -+ is_malloc = 0; - - if (name != 0 && IDENTIFIER_LENGTH (DECL_NAME (fndecl)) <= 15) -*************** expand_call (exp, target, ignore) -*** 891,894 **** ---- 894,901 ---- - && ! strcmp (tname, "longjmp")) - is_longjmp = 1; -+ /* Only recognize malloc when alias analysis is enabled. */ -+ else if (tname[0] == 'm' && flag_alias_check -+ && ! strcmp(tname, "malloc")) -+ is_malloc = 1; - } - -*************** expand_call (exp, target, ignore) -*** 1363,1367 **** - /* Now we are about to start emitting insns that can be deleted - if a libcall is deleted. */ -! if (is_const) - start_sequence (); - ---- 1370,1374 ---- - /* Now we are about to start emitting insns that can be deleted - if a libcall is deleted. */ -! if (is_const || is_malloc) - start_sequence (); - -*************** expand_call (exp, target, ignore) -*** 1951,1954 **** ---- 1958,1975 ---- - end_sequence (); - emit_insns (insns); -+ } -+ else if (is_malloc) -+ { -+ rtx temp = gen_reg_rtx (GET_MODE (valreg)); -+ rtx last, insns; -+ -+ emit_move_insn (temp, valreg); -+ last = get_last_insn (); -+ REG_NOTES (last) = -+ gen_rtx (EXPR_LIST, REG_NOALIAS, temp, REG_NOTES (last)); -+ insns = get_insns (); -+ end_sequence (); -+ emit_insns (insns); -+ valreg = temp; - } - -diff -rcp2N gcc-2.7.2.2/combine.c gcc-2.7.2.2.f.2/combine.c -*** gcc-2.7.2.2/combine.c Sun Nov 26 14:32:07 1995 ---- gcc-2.7.2.2.f.2/combine.c Fri Jan 10 23:18:21 1997 -*************** distribute_notes (notes, from_insn, i3, -*** 10648,10651 **** ---- 10648,10652 ---- - case REG_EQUIV: - case REG_NONNEG: -+ case REG_NOALIAS: - /* These notes say something about results of an insn. We can - only support them if they used to be on I3 in which case they -diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.c gcc-2.7.2.2.f.2/config/alpha/alpha.c -*** gcc-2.7.2.2/config/alpha/alpha.c Thu Feb 20 19:24:11 1997 ---- gcc-2.7.2.2.f.2/config/alpha/alpha.c Sun Feb 23 15:35:33 1997 -*************** output_prolog (file, size) -*** 1370,1373 **** ---- 1370,1378 ---- - - alpha_function_needs_gp = 0; -+ #ifdef __linux__ -+ if(profile_flag) { -+ alpha_function_needs_gp = 1; -+ } -+ #endif - for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) - if ((GET_CODE (insn) == CALL_INSN) -diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.h gcc-2.7.2.2.f.2/config/alpha/alpha.h -*** gcc-2.7.2.2/config/alpha/alpha.h Thu Feb 20 19:24:12 1997 ---- gcc-2.7.2.2.f.2/config/alpha/alpha.h Sun Feb 23 15:35:34 1997 -*************** extern int target_flags; -*** 112,116 **** ---- 112,118 ---- - {"", TARGET_DEFAULT | TARGET_CPU_DEFAULT} } - -+ #ifndef TARGET_DEFAULT - #define TARGET_DEFAULT 3 -+ #endif - - #ifndef TARGET_CPU_DEFAULT -diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.md gcc-2.7.2.2.f.2/config/alpha/alpha.md -*** gcc-2.7.2.2/config/alpha/alpha.md Fri Oct 27 06:49:59 1995 ---- gcc-2.7.2.2.f.2/config/alpha/alpha.md Mon Dec 23 00:43:55 1996 -*************** -*** 1746,1752 **** - (if_then_else:DF - (match_operator 3 "signed_comparison_operator" -! [(match_operand:DF 1 "reg_or_fp0_operand" "fG,fG") - (match_operand:DF 2 "fp0_operand" "G,G")]) -! (float_extend:DF (match_operand:SF 4 "reg_or_fp0_operand" "fG,0")) - (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] - "TARGET_FP" ---- 1746,1752 ---- - (if_then_else:DF - (match_operator 3 "signed_comparison_operator" -! [(match_operand:DF 4 "reg_or_fp0_operand" "fG,fG") - (match_operand:DF 2 "fp0_operand" "G,G")]) -! (float_extend:DF (match_operand:SF 1 "reg_or_fp0_operand" "fG,0")) - (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))] - "TARGET_FP" -diff -rcp2N gcc-2.7.2.2/config/alpha/linux.h gcc-2.7.2.2.f.2/config/alpha/linux.h -*** gcc-2.7.2.2/config/alpha/linux.h Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/config/alpha/linux.h Thu Dec 19 12:31:08 1996 -*************** -*** 0 **** ---- 1,72 ---- -+ /* Definitions of target machine for GNU compiler, for Alpha Linux, -+ using ECOFF. -+ Copyright (C) 1995 Free Software Foundation, Inc. -+ Contributed by Bob Manson. -+ Derived from work contributed by Cygnus Support, -+ (c) 1993 Free Software Foundation. -+ -+ This file is part of GNU CC. -+ -+ GNU CC is free software; you can redistribute it and/or modify -+ it under the terms of the GNU General Public License as published by -+ the Free Software Foundation; either version 2, or (at your option) -+ any later version. -+ -+ GNU CC is distributed in the hope that it will be useful, -+ but WITHOUT ANY WARRANTY; without even the implied warranty of -+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+ GNU General Public License for more details. -+ -+ You should have received a copy of the GNU General Public License -+ along with GNU CC; see the file COPYING. If not, write to -+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -+ -+ #define TARGET_DEFAULT (3 | MASK_GAS) -+ -+ #include "alpha/alpha.h" -+ -+ #undef TARGET_VERSION -+ #define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)"); -+ -+ #undef CPP_PREDEFINES -+ #define CPP_PREDEFINES "\ -+ -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \ -+ -Asystem(linux) -Acpu(alpha) -Amachine(alpha)" -+ -+ /* We don't actually need any of these; the MD_ vars are ignored -+ anyway for cross-compilers, and the other specs won't get picked up -+ 'coz the user is supposed to do ld -r (hmm, perhaps that should be -+ the default). In any case, setting them thus will catch some -+ common user errors. */ -+ -+ #undef MD_EXEC_PREFIX -+ #undef MD_STARTFILE_PREFIX -+ -+ #undef LIB_SPEC -+ #define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}" -+ -+ #undef LINK_SPEC -+ #define LINK_SPEC \ -+ "-G 8 %{O*:-O3} %{!O*:-O1}" -+ -+ #undef ASM_SPEC -+ #define ASM_SPEC "-nocpp" -+ -+ /* Can't do stabs */ -+ #undef SDB_DEBUGGING_INFO -+ -+ /* Prefer dbx. */ -+ #undef PREFERRED_DEBUGGING_TYPE -+ #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG -+ -+ #undef FUNCTION_PROFILER -+ -+ #define FUNCTION_PROFILER(FILE, LABELNO) \ -+ do { \ -+ fputs ("\tlda $27,_mcount\n", (FILE)); \ -+ fputs ("\tjsr $26,($27),_mcount\n", (FILE)); \ -+ fputs ("\tldgp $29,0($26)\n", (FILE)); \ -+ } while (0); -+ -+ /* Generate calls to memcpy, etc., not bcopy, etc. */ -+ #define TARGET_MEM_FUNCTIONS -diff -rcp2N gcc-2.7.2.2/config/alpha/t-linux gcc-2.7.2.2.f.2/config/alpha/t-linux -*** gcc-2.7.2.2/config/alpha/t-linux Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/config/alpha/t-linux Thu Dec 19 12:31:08 1996 -*************** -*** 0 **** ---- 1,3 ---- -+ # Our header files are supposed to be correct, nein? -+ FIXINCLUDES = -+ STMP_FIXPROTO = -diff -rcp2N gcc-2.7.2.2/config/alpha/x-linux gcc-2.7.2.2.f.2/config/alpha/x-linux -*** gcc-2.7.2.2/config/alpha/x-linux Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/config/alpha/x-linux Thu Dec 19 12:31:08 1996 -*************** -*** 0 **** ---- 1 ---- -+ CLIB=-lbfd -liberty -diff -rcp2N gcc-2.7.2.2/config/alpha/xm-alpha.h gcc-2.7.2.2.f.2/config/alpha/xm-alpha.h -*** gcc-2.7.2.2/config/alpha/xm-alpha.h Thu Aug 31 17:52:27 1995 ---- gcc-2.7.2.2.f.2/config/alpha/xm-alpha.h Thu Dec 19 12:31:08 1996 -*************** Boston, MA 02111-1307, USA. */ -*** 46,51 **** ---- 46,53 ---- - #include <alloca.h> - #else -+ #ifndef __alpha__ - extern void *alloca (); - #endif -+ #endif - - /* The host compiler has problems with enum bitfields since it makes -*************** extern void *malloc (), *realloc (), *ca -*** 68,72 **** ---- 70,76 ---- - /* OSF/1 has vprintf. */ - -+ #ifndef linux /* 1996/02/22 mauro@craftwork.com -- unreliable with Linux */ - #define HAVE_VPRINTF -+ #endif - - /* OSF/1 has putenv. */ -diff -rcp2N gcc-2.7.2.2/config/alpha/xm-linux.h gcc-2.7.2.2.f.2/config/alpha/xm-linux.h -*** gcc-2.7.2.2/config/alpha/xm-linux.h Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/config/alpha/xm-linux.h Thu Dec 19 12:31:08 1996 -*************** -*** 0 **** ---- 1,8 ---- -+ #ifndef _XM_LINUX_H -+ #define _XM_LINUX_H -+ -+ #include "xm-alpha.h" -+ -+ #define DONT_DECLARE_SYS_SIGLIST -+ #define USE_BFD -+ #endif -diff -rcp2N gcc-2.7.2.2/config/x-linux gcc-2.7.2.2.f.2/config/x-linux -*** gcc-2.7.2.2/config/x-linux Tue Mar 28 07:43:37 1995 ---- gcc-2.7.2.2.f.2/config/x-linux Thu Dec 19 12:31:08 1996 -*************** BOOT_CFLAGS = -O $(CFLAGS) -Iinclude -*** 13,14 **** ---- 13,17 ---- - # Don't run fixproto - STMP_FIXPROTO = -+ -+ # Don't install "assert.h" in gcc. We use the one in glibc. -+ INSTALL_ASSERT_H = -diff -rcp2N gcc-2.7.2.2/config/x-linux-aout gcc-2.7.2.2.f.2/config/x-linux-aout -*** gcc-2.7.2.2/config/x-linux-aout Wed Dec 31 19:00:00 1969 ---- gcc-2.7.2.2.f.2/config/x-linux-aout Thu Dec 19 12:31:08 1996 -*************** -*** 0 **** ---- 1,14 ---- -+ # It is defined in config/xm-linux.h. -+ # X_CFLAGS = -DPOSIX -+ -+ # The following is needed when compiling stages 2 and 3 because gcc's -+ # limits.h must be picked up before /usr/include/limits.h. This is because -+ # each does an #include_next of the other if the other hasn't been included. -+ # /usr/include/limits.h loses if it gets found first because /usr/include is -+ # at the end of the search order. When a new version of gcc is released, -+ # gcc's limits.h hasn't been installed yet and hence isn't found. -+ -+ BOOT_CFLAGS = -O $(CFLAGS) -Iinclude -+ -+ # Don't run fixproto -+ STMP_FIXPROTO = -diff -rcp2N gcc-2.7.2.2/configure gcc-2.7.2.2.f.2/configure -*** gcc-2.7.2.2/configure Thu Feb 20 19:24:33 1997 ---- gcc-2.7.2.2.f.2/configure Sun Feb 23 16:15:12 1997 -*************** exec_prefix='$(prefix)' -*** 82,85 **** ---- 82,86 ---- - # The default g++ include directory is $(libdir)/g++-include. - gxx_include_dir='$(libdir)/g++-include' -+ #gxx_include_dir='$(exec_prefix)/include/g++' - - # Default --program-transform-name to nothing. -*************** for machine in $canon_build $canon_host -*** 548,551 **** ---- 549,559 ---- - use_collect2=yes - ;; -+ alpha-*-linux*) -+ tm_file=alpha/linux.h -+ tmake_file=alpha/t-linux -+ xmake_file=alpha/x-linux -+ fixincludes=Makefile.in -+ xm_file=alpha/xm-linux.h -+ ;; - alpha-dec-osf[23456789]*) - tm_file=alpha/osf2.h -*************** for machine in $canon_build $canon_host -*** 985,989 **** - cpu_type=i386 # with a.out format using pre BFD linkers - xm_file=i386/xm-linux.h -! xmake_file=x-linux - tm_file=i386/linux-oldld.h - fixincludes=Makefile.in # The headers are ok already. ---- 993,997 ---- - cpu_type=i386 # with a.out format using pre BFD linkers - xm_file=i386/xm-linux.h -! xmake_file=x-linux-aout - tm_file=i386/linux-oldld.h - fixincludes=Makefile.in # The headers are ok already. -*************** for machine in $canon_build $canon_host -*** 994,998 **** - cpu_type=i386 # with a.out format - xm_file=i386/xm-linux.h -! xmake_file=x-linux - tm_file=i386/linux-aout.h - fixincludes=Makefile.in # The headers are ok already. ---- 1002,1006 ---- - cpu_type=i386 # with a.out format - xm_file=i386/xm-linux.h -! xmake_file=x-linux-aout - tm_file=i386/linux-aout.h - fixincludes=Makefile.in # The headers are ok already. -*************** for machine in $canon_build $canon_host -*** 1003,1007 **** - cpu_type=i386 # with ELF format, using GNU libc v1. - xm_file=i386/xm-linux.h -! xmake_file=x-linux - tmake_file=t-linux-libc1 - tm_file=i386/linux.h ---- 1011,1015 ---- - cpu_type=i386 # with ELF format, using GNU libc v1. - xm_file=i386/xm-linux.h -! xmake_file=x-linux-aout - tmake_file=t-linux-libc1 - tm_file=i386/linux.h -diff -rcp2N gcc-2.7.2.2/cse.c gcc-2.7.2.2.f.2/cse.c -*** gcc-2.7.2.2/cse.c Sun Nov 26 14:47:05 1995 ---- gcc-2.7.2.2.f.2/cse.c Fri Jan 10 23:18:22 1997 -*************** static struct table_elt *last_jump_equiv -*** 520,544 **** - static int constant_pool_entries_cost; - -- /* Bits describing what kind of values in memory must be invalidated -- for a particular instruction. If all three bits are zero, -- no memory refs need to be invalidated. Each bit is more powerful -- than the preceding ones, and if a bit is set then the preceding -- bits are also set. -- -- Here is how the bits are set: -- Pushing onto the stack invalidates only the stack pointer, -- writing at a fixed address invalidates only variable addresses, -- writing in a structure element at variable address -- invalidates all but scalar variables, -- and writing in anything else at variable address invalidates everything. */ -- -- struct write_data -- { -- int sp : 1; /* Invalidate stack pointer. */ -- int var : 1; /* Invalidate variable addresses. */ -- int nonscalar : 1; /* Invalidate all but scalar variables. */ -- int all : 1; /* Invalidate all memory refs. */ -- }; -- - /* Define maximum length of a branch path. */ - ---- 520,523 ---- -*************** static void merge_equiv_classes PROTO((s -*** 626,632 **** - struct table_elt *)); - static void invalidate PROTO((rtx, enum machine_mode)); - static void remove_invalid_refs PROTO((int)); - static void rehash_using_reg PROTO((rtx)); -! static void invalidate_memory PROTO((struct write_data *)); - static void invalidate_for_call PROTO((void)); - static rtx use_related_value PROTO((rtx, struct table_elt *)); ---- 605,612 ---- - struct table_elt *)); - static void invalidate PROTO((rtx, enum machine_mode)); -+ static int cse_rtx_varies_p PROTO((rtx)); - static void remove_invalid_refs PROTO((int)); - static void rehash_using_reg PROTO((rtx)); -! static void invalidate_memory PROTO((void)); - static void invalidate_for_call PROTO((void)); - static rtx use_related_value PROTO((rtx, struct table_elt *)); -*************** static void set_nonvarying_address_compo -*** 638,644 **** - HOST_WIDE_INT *)); - static int refers_to_p PROTO((rtx, rtx)); -- static int refers_to_mem_p PROTO((rtx, rtx, HOST_WIDE_INT, -- HOST_WIDE_INT)); -- static int cse_rtx_addr_varies_p PROTO((rtx)); - static rtx canon_reg PROTO((rtx, rtx)); - static void find_best_addr PROTO((rtx, rtx *)); ---- 618,621 ---- -*************** static void record_jump_cond PROTO((enum -*** 656,661 **** - rtx, rtx, int)); - static void cse_insn PROTO((rtx, int)); -! static void note_mem_written PROTO((rtx, struct write_data *)); -! static void invalidate_from_clobbers PROTO((struct write_data *, rtx)); - static rtx cse_process_notes PROTO((rtx, rtx)); - static void cse_around_loop PROTO((rtx)); ---- 633,638 ---- - rtx, rtx, int)); - static void cse_insn PROTO((rtx, int)); -! static int note_mem_written PROTO((rtx)); -! static void invalidate_from_clobbers PROTO((rtx)); - static rtx cse_process_notes PROTO((rtx, rtx)); - static void cse_around_loop PROTO((rtx)); -*************** invalidate (x, full_mode) -*** 1512,1517 **** - register int i; - register struct table_elt *p; -- rtx base; -- HOST_WIDE_INT start, end; - - /* If X is a register, dependencies on its contents ---- 1489,1492 ---- -*************** invalidate (x, full_mode) -*** 1605,1611 **** - full_mode = GET_MODE (x); - -- set_nonvarying_address_components (XEXP (x, 0), GET_MODE_SIZE (full_mode), -- &base, &start, &end); -- - for (i = 0; i < NBUCKETS; i++) - { ---- 1580,1583 ---- -*************** invalidate (x, full_mode) -*** 1614,1618 **** - { - next = p->next_same_hash; -! if (refers_to_mem_p (p->exp, base, start, end)) - remove_from_table (p, i); - } ---- 1586,1594 ---- - { - next = p->next_same_hash; -! /* Invalidate ASM_OPERANDS which reference memory (this is easier -! than checking all the aliases). */ -! if (p->in_memory -! && (GET_CODE (p->exp) != MEM -! || true_dependence (x, full_mode, p->exp, cse_rtx_varies_p))) - remove_from_table (p, i); - } -*************** rehash_using_reg (x) -*** 1695,1722 **** - } - -- /* Remove from the hash table all expressions that reference memory, -- or some of them as specified by *WRITES. */ -- -- static void -- invalidate_memory (writes) -- struct write_data *writes; -- { -- register int i; -- register struct table_elt *p, *next; -- int all = writes->all; -- int nonscalar = writes->nonscalar; -- -- for (i = 0; i < NBUCKETS; i++) -- for (p = table[i]; p; p = next) -- { -- next = p->next_same_hash; -- if (p->in_memory -- && (all -- || (nonscalar && p->in_struct) -- || cse_rtx_addr_varies_p (p->exp))) -- remove_from_table (p, i); -- } -- } -- - /* Remove from the hash table any expression that is a call-clobbered - register. Also update their TICK values. */ ---- 1671,1674 ---- -*************** invalidate_for_call () -*** 1756,1759 **** ---- 1708,1717 ---- - next = p->next_same_hash; - -+ if (p->in_memory) -+ { -+ remove_from_table (p, hash); -+ continue; -+ } -+ - if (GET_CODE (p->exp) != REG - || REGNO (p->exp) >= FIRST_PSEUDO_REGISTER) -*************** set_nonvarying_address_components (addr, -*** 2395,2477 **** - } - -! /* Return 1 iff any subexpression of X refers to memory -! at an address of BASE plus some offset -! such that any of the bytes' offsets fall between START (inclusive) -! and END (exclusive). -! -! The value is undefined if X is a varying address (as determined by -! cse_rtx_addr_varies_p). This function is not used in such cases. -! -! When used in the cse pass, `qty_const' is nonzero, and it is used -! to treat an address that is a register with a known constant value -! as if it were that constant value. -! In the loop pass, `qty_const' is zero, so this is not done. */ -! -! static int -! refers_to_mem_p (x, base, start, end) -! rtx x, base; -! HOST_WIDE_INT start, end; -! { -! register HOST_WIDE_INT i; -! register enum rtx_code code; -! register char *fmt; -! -! repeat: -! if (x == 0) -! return 0; -! -! code = GET_CODE (x); -! if (code == MEM) -! { -! register rtx addr = XEXP (x, 0); /* Get the address. */ -! rtx mybase; -! HOST_WIDE_INT mystart, myend; -! -! set_nonvarying_address_components (addr, GET_MODE_SIZE (GET_MODE (x)), -! &mybase, &mystart, &myend); -! -! -! /* refers_to_mem_p is never called with varying addresses. -! If the base addresses are not equal, there is no chance -! of the memory addresses conflicting. */ -! if (! rtx_equal_p (mybase, base)) -! return 0; -! -! return myend > start && mystart < end; -! } -! -! /* X does not match, so try its subexpressions. */ -! -! fmt = GET_RTX_FORMAT (code); -! for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) -! if (fmt[i] == 'e') -! { -! if (i == 0) -! { -! x = XEXP (x, 0); -! goto repeat; -! } -! else -! if (refers_to_mem_p (XEXP (x, i), base, start, end)) -! return 1; -! } -! else if (fmt[i] == 'E') -! { -! int j; -! for (j = 0; j < XVECLEN (x, i); j++) -! if (refers_to_mem_p (XVECEXP (x, i, j), base, start, end)) -! return 1; -! } -! -! return 0; -! } -! -! /* Nonzero if X refers to memory at a varying address; - except that a register which has at the moment a known constant value - isn't considered variable. */ - - static int -! cse_rtx_addr_varies_p (x) -! rtx x; - { - /* We need not check for X and the equivalence class being of the same ---- 2353,2363 ---- - } - -! /* Nonzero if X, a memory address, refers to a varying address; - except that a register which has at the moment a known constant value - isn't considered variable. */ - - static int -! cse_rtx_varies_p (x) -! register rtx x; - { - /* We need not check for X and the equivalence class being of the same -*************** cse_rtx_addr_varies_p (x) -*** 2479,2497 **** - doesn't vary in any mode. */ - -! if (GET_CODE (x) == MEM -! && GET_CODE (XEXP (x, 0)) == REG -! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) -! && GET_MODE (XEXP (x, 0)) == qty_mode[reg_qty[REGNO (XEXP (x, 0))]] -! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] != 0) - return 0; - -! if (GET_CODE (x) == MEM -! && GET_CODE (XEXP (x, 0)) == PLUS -! && GET_CODE (XEXP (XEXP (x, 0), 1)) == CONST_INT -! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG -! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) -! && (GET_MODE (XEXP (XEXP (x, 0), 0)) -! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) -! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) - return 0; - ---- 2365,2381 ---- - doesn't vary in any mode. */ - -! if (GET_CODE (x) == REG -! && REGNO_QTY_VALID_P (REGNO (x)) -! && GET_MODE (x) == qty_mode[reg_qty[REGNO (x)]] -! && qty_const[reg_qty[REGNO (x)]] != 0) - return 0; - -! if (GET_CODE (x) == PLUS -! && GET_CODE (XEXP (x, 1)) == CONST_INT -! && GET_CODE (XEXP (x, 0)) == REG -! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) -! && (GET_MODE (XEXP (x, 0)) -! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) -! && qty_const[reg_qty[REGNO (XEXP (x, 0))]]) - return 0; - -*************** cse_rtx_addr_varies_p (x) -*** 2501,2519 **** - load fp minus a constant into a register, then a MEM which is the - sum of the two `constant' registers. */ -! if (GET_CODE (x) == MEM -! && GET_CODE (XEXP (x, 0)) == PLUS -! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG -! && GET_CODE (XEXP (XEXP (x, 0), 1)) == REG -! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0))) -! && (GET_MODE (XEXP (XEXP (x, 0), 0)) -! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]) -! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]] -! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 1))) -! && (GET_MODE (XEXP (XEXP (x, 0), 1)) -! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) -! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]]) - return 0; - -! return rtx_addr_varies_p (x); - } - ---- 2385,2402 ---- - load fp minus a constant into a register, then a MEM which is the - sum of the two `constant' registers. */ -! if (GET_CODE (x) == PLUS -! && GET_CODE (XEXP (x, 0)) == REG -! && GET_CODE (XEXP (x, 1)) == REG -! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0))) -! && (GET_MODE (XEXP (x, 0)) -! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]) -! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] -! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 1))) -! && (GET_MODE (XEXP (x, 1)) -! == qty_mode[reg_qty[REGNO (XEXP (x, 1))]]) -! && qty_const[reg_qty[REGNO (XEXP (x, 1))]]) - return 0; - -! return rtx_varies_p (x); - } - -*************** cse_insn (insn, in_libcall_block) -*** 6105,6110 **** - rtx this_insn_cc0 = 0; - enum machine_mode this_insn_cc0_mode; -- struct write_data writes_memory; -- static struct write_data init = {0, 0, 0, 0}; - - rtx src_eqv = 0; ---- 5988,5991 ---- -*************** cse_insn (insn, in_libcall_block) -*** 6118,6122 **** - - this_insn = insn; -- writes_memory = init; - - /* Find all the SETs and CLOBBERs in this instruction. ---- 5999,6002 ---- -*************** cse_insn (insn, in_libcall_block) -*** 6220,6225 **** - else if (GET_CODE (y) == CLOBBER) - { -! /* If we clobber memory, take note of that, -! and canon the address. - This does nothing when a register is clobbered - because we have already invalidated the reg. */ ---- 6100,6104 ---- - else if (GET_CODE (y) == CLOBBER) - { -! /* If we clobber memory, canon the address. - This does nothing when a register is clobbered - because we have already invalidated the reg. */ -*************** cse_insn (insn, in_libcall_block) -*** 6227,6231 **** - { - canon_reg (XEXP (y, 0), NULL_RTX); -! note_mem_written (XEXP (y, 0), &writes_memory); - } - } ---- 6106,6110 ---- - { - canon_reg (XEXP (y, 0), NULL_RTX); -! note_mem_written (XEXP (y, 0)); - } - } -*************** cse_insn (insn, in_libcall_block) -*** 6249,6253 **** - { - canon_reg (XEXP (x, 0), NULL_RTX); -! note_mem_written (XEXP (x, 0), &writes_memory); - } - } ---- 6128,6132 ---- - { - canon_reg (XEXP (x, 0), NULL_RTX); -! note_mem_written (XEXP (x, 0)); - } - } -*************** cse_insn (insn, in_libcall_block) -*** 6674,6678 **** - } - #endif /* LOAD_EXTEND_OP */ -! - if (src == src_folded) - src_folded = 0; ---- 6553,6557 ---- - } - #endif /* LOAD_EXTEND_OP */ -! - if (src == src_folded) - src_folded = 0; -*************** cse_insn (insn, in_libcall_block) -*** 6860,6864 **** - || (GET_CODE (src_folded) != MEM - && ! src_folded_force_flag)) -! && GET_MODE_CLASS (mode) != MODE_CC) - { - src_folded_force_flag = 1; ---- 6739,6744 ---- - || (GET_CODE (src_folded) != MEM - && ! src_folded_force_flag)) -! && GET_MODE_CLASS (mode) != MODE_CC -! && mode != VOIDmode) - { - src_folded_force_flag = 1; -*************** cse_insn (insn, in_libcall_block) -*** 6984,6993 **** - { - dest = fold_rtx (dest, insn); -! -! /* Decide whether we invalidate everything in memory, -! or just things at non-fixed places. -! Writing a large aggregate must invalidate everything -! because we don't know how long it is. */ -! note_mem_written (dest, &writes_memory); - } - ---- 6864,6868 ---- - { - dest = fold_rtx (dest, insn); -! note_mem_written (dest); - } - -*************** cse_insn (insn, in_libcall_block) -*** 7234,7238 **** - sets[i].src_elt = src_eqv_elt; - -! invalidate_from_clobbers (&writes_memory, x); - - /* Some registers are invalidated by subroutine calls. Memory is ---- 7109,7113 ---- - sets[i].src_elt = src_eqv_elt; - -! invalidate_from_clobbers (x); - - /* Some registers are invalidated by subroutine calls. Memory is -*************** cse_insn (insn, in_libcall_block) -*** 7241,7248 **** - if (GET_CODE (insn) == CALL_INSN) - { -- static struct write_data everything = {0, 1, 1, 1}; -- - if (! CONST_CALL_P (insn)) -! invalidate_memory (&everything); - invalidate_for_call (); - } ---- 7116,7121 ---- - if (GET_CODE (insn) == CALL_INSN) - { - if (! CONST_CALL_P (insn)) -! invalidate_memory (); - invalidate_for_call (); - } -*************** cse_insn (insn, in_libcall_block) -*** 7265,7270 **** - we have just done an invalidate_memory that covers even those. */ - if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG -! || (GET_CODE (dest) == MEM && ! writes_memory.all -! && ! cse_rtx_addr_varies_p (dest))) - invalidate (dest, VOIDmode); - else if (GET_CODE (dest) == STRICT_LOW_PART ---- 7138,7142 ---- - we have just done an invalidate_memory that covers even those. */ - if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG -! || GET_CODE (dest) == MEM) - invalidate (dest, VOIDmode); - else if (GET_CODE (dest) == STRICT_LOW_PART -*************** cse_insn (insn, in_libcall_block) -*** 7532,7580 **** - } - -- /* Store 1 in *WRITES_PTR for those categories of memory ref -- that must be invalidated when the expression WRITTEN is stored in. -- If WRITTEN is null, say everything must be invalidated. */ -- - static void -! note_mem_written (written, writes_ptr) -! rtx written; -! struct write_data *writes_ptr; -! { -! static struct write_data everything = {0, 1, 1, 1}; -! -! if (written == 0) -! *writes_ptr = everything; -! else if (GET_CODE (written) == MEM) -! { -! /* Pushing or popping the stack invalidates just the stack pointer. */ -! rtx addr = XEXP (written, 0); -! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC -! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) -! && GET_CODE (XEXP (addr, 0)) == REG -! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) -! { -! writes_ptr->sp = 1; -! return; -! } -! else if (GET_MODE (written) == BLKmode) -! *writes_ptr = everything; -! /* (mem (scratch)) means clobber everything. */ -! else if (GET_CODE (addr) == SCRATCH) -! *writes_ptr = everything; -! else if (cse_rtx_addr_varies_p (written)) -! { -! /* A varying address that is a sum indicates an array element, -! and that's just as good as a structure element -! in implying that we need not invalidate scalar variables. -! However, we must allow QImode aliasing of scalars, because the -! ANSI C standard allows character pointers to alias anything. */ -! if (! ((MEM_IN_STRUCT_P (written) -! || GET_CODE (XEXP (written, 0)) == PLUS) -! && GET_MODE (written) != QImode)) -! writes_ptr->all = 1; -! writes_ptr->nonscalar = 1; -! } -! writes_ptr->var = 1; - } - } - ---- 7404,7447 ---- - } - - static void -! invalidate_memory () -! { -! register int i; -! register struct table_elt *p, *next; -! -! for (i = 0; i < NBUCKETS; i++) -! for (p = table[i]; p; p = next) -! { -! next = p->next_same_hash; -! if (p->in_memory) -! remove_from_table (p, i); -! } -! } -! -! static int -! note_mem_written (mem) -! register rtx mem; -! { -! if (mem == 0 || GET_CODE(mem) != MEM ) -! return 0; -! else -! { -! register rtx addr = XEXP (mem, 0); -! /* Pushing or popping the stack invalidates just the stack pointer. */ -! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC -! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC) -! && GET_CODE (XEXP (addr, 0)) == REG -! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM) -! { -! if (reg_tick[STACK_POINTER_REGNUM] >= 0) -! reg_tick[STACK_POINTER_REGNUM]++; -! -! /* This should be *very* rare. */ -! if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) -! invalidate (stack_pointer_rtx, VOIDmode); -! return 1; - } -+ return 0; -+ } - } - -*************** note_mem_written (written, writes_ptr) -*** 7584,7612 **** - alias with something that is SET or CLOBBERed. - -- W points to the writes_memory for this insn, a struct write_data -- saying which kinds of memory references must be invalidated. - X is the pattern of the insn. */ - - static void -! invalidate_from_clobbers (w, x) -! struct write_data *w; - rtx x; - { -- /* If W->var is not set, W specifies no action. -- If W->all is set, this step gets all memory refs -- so they can be ignored in the rest of this function. */ -- if (w->var) -- invalidate_memory (w); -- -- if (w->sp) -- { -- if (reg_tick[STACK_POINTER_REGNUM] >= 0) -- reg_tick[STACK_POINTER_REGNUM]++; -- -- /* This should be *very* rare. */ -- if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM)) -- invalidate (stack_pointer_rtx, VOIDmode); -- } -- - if (GET_CODE (x) == CLOBBER) - { ---- 7451,7460 ---- - alias with something that is SET or CLOBBERed. - - X is the pattern of the insn. */ - - static void -! invalidate_from_clobbers (x) - rtx x; - { - if (GET_CODE (x) == CLOBBER) - { -*************** invalidate_from_clobbers (w, x) -*** 7615,7619 **** - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG -! || (GET_CODE (ref) == MEM && ! w->all)) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART ---- 7463,7467 ---- - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG -! || GET_CODE (ref) == MEM) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART -*************** invalidate_from_clobbers (w, x) -*** 7634,7638 **** - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG -! || (GET_CODE (ref) == MEM && !w->all)) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART ---- 7482,7486 ---- - { - if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG -! || GET_CODE (ref) == MEM) - invalidate (ref, VOIDmode); - else if (GET_CODE (ref) == STRICT_LOW_PART -*************** cse_around_loop (loop_start) -*** 7800,7807 **** - } - -- /* Variable used for communications between the next two routines. */ -- -- static struct write_data skipped_writes_memory; -- - /* Process one SET of an insn that was skipped. We ignore CLOBBERs - since they are done elsewhere. This function is called via note_stores. */ ---- 7648,7651 ---- -*************** invalidate_skipped_set (dest, set) -*** 7812,7815 **** ---- 7656,7675 ---- - rtx dest; - { -+ enum rtx_code code = GET_CODE (dest); -+ -+ if (code == MEM -+ && ! note_mem_written (dest) /* If this is not a stack push ... */ -+ /* There are times when an address can appear varying and be a PLUS -+ during this scan when it would be a fixed address were we to know -+ the proper equivalences. So invalidate all memory if there is -+ a BLKmode or nonscalar memory reference or a reference to a -+ variable address. */ -+ && (MEM_IN_STRUCT_P (dest) || GET_MODE (dest) == BLKmode -+ || cse_rtx_varies_p (XEXP (dest, 0)))) -+ { -+ invalidate_memory (); -+ return; -+ } -+ - if (GET_CODE (set) == CLOBBER - #ifdef HAVE_cc0 -*************** invalidate_skipped_set (dest, set) -*** 7819,7837 **** - return; - -! if (GET_CODE (dest) == MEM) -! note_mem_written (dest, &skipped_writes_memory); -! -! /* There are times when an address can appear varying and be a PLUS -! during this scan when it would be a fixed address were we to know -! the proper equivalences. So promote "nonscalar" to be "all". */ -! if (skipped_writes_memory.nonscalar) -! skipped_writes_memory.all = 1; -! -! if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG -! || (! skipped_writes_memory.all && ! cse_rtx_addr_varies_p (dest))) -! invalidate (dest, VOIDmode); -! else if (GET_CODE (dest) == STRICT_LOW_PART -! || GET_CODE (dest) == ZERO_EXTRACT) - invalidate (XEXP (dest, 0), GET_MODE (dest)); - } - ---- 7679,7686 ---- - return; - -! if (code == STRICT_LOW_PART || code == ZERO_EXTRACT) - invalidate (XEXP (dest, 0), GET_MODE (dest)); -+ else if (code == REG || code == SUBREG || code == MEM) -+ invalidate (dest, VOIDmode); - } - -*************** invalidate_skipped_block (start) -*** 7845,7850 **** - { - rtx insn; -- static struct write_data init = {0, 0, 0, 0}; -- static struct write_data everything = {0, 1, 1, 1}; - - for (insn = start; insn && GET_CODE (insn) != CODE_LABEL; ---- 7694,7697 ---- -*************** invalidate_skipped_block (start) -*** 7854,7867 **** - continue; - -- skipped_writes_memory = init; -- - if (GET_CODE (insn) == CALL_INSN) - { - invalidate_for_call (); -- skipped_writes_memory = everything; - } - - note_stores (PATTERN (insn), invalidate_skipped_set); -- invalidate_from_clobbers (&skipped_writes_memory, PATTERN (insn)); - } - } ---- 7701,7712 ---- - continue; - - if (GET_CODE (insn) == CALL_INSN) - { -+ if (! CONST_CALL_P (insn)) -+ invalidate_memory (); - invalidate_for_call (); - } - - note_stores (PATTERN (insn), invalidate_skipped_set); - } - } -*************** cse_set_around_loop (x, insn, loop_start -*** 7913,7920 **** - { - struct table_elt *src_elt; -- static struct write_data init = {0, 0, 0, 0}; -- struct write_data writes_memory; -- -- writes_memory = init; - - /* If this is a SET, see if we can replace SET_SRC, but ignore SETs that ---- 7758,7761 ---- -*************** cse_set_around_loop (x, insn, loop_start -*** 7976,7991 **** - - /* Now invalidate anything modified by X. */ -! note_mem_written (SET_DEST (x), &writes_memory); -! -! if (writes_memory.var) -! invalidate_memory (&writes_memory); -! -! /* See comment on similar code in cse_insn for explanation of these tests. */ -! if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG -! || (GET_CODE (SET_DEST (x)) == MEM && ! writes_memory.all -! && ! cse_rtx_addr_varies_p (SET_DEST (x)))) -! invalidate (SET_DEST (x), VOIDmode); -! else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART -! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) - invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); - } ---- 7817,7828 ---- - - /* Now invalidate anything modified by X. */ -! note_mem_written (SET_DEST (x)); -! -! /* See comment on similar code in cse_insn for explanation of these tests. */ -! if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG -! || GET_CODE (SET_DEST (x)) == MEM) -! invalidate (SET_DEST (x), VOIDmode); -! else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART -! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT) - invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x))); - } -*************** cse_main (f, nregs, after_loop, file) -*** 8234,8237 **** ---- 8071,8075 ---- - - init_recog (); -+ init_alias_analysis (); - - max_reg = nregs; -diff -rcp2N gcc-2.7.2.2/flags.h gcc-2.7.2.2.f.2/flags.h -*** gcc-2.7.2.2/flags.h Thu Jun 15 07:34:11 1995 ---- gcc-2.7.2.2.f.2/flags.h Fri Jan 10 23:18:22 1997 -*************** extern int flag_unroll_loops; -*** 204,207 **** ---- 204,221 ---- - extern int flag_unroll_all_loops; - -+ /* Nonzero forces all invariant computations in loops to be moved -+ outside the loop. */ -+ -+ extern int flag_move_all_movables; -+ -+ /* Nonzero forces all general induction variables in loops to be -+ strength reduced. */ -+ -+ extern int flag_reduce_all_givs; -+ -+ /* Nonzero gets another run of loop_optimize performed. */ -+ -+ extern int flag_rerun_loop_opt; -+ - /* Nonzero for -fcse-follow-jumps: - have cse follow jumps to do a more extensive job. */ -*************** extern int flag_gnu_linker; -*** 339,342 **** ---- 353,369 ---- - /* Tag all structures with __attribute__(packed) */ - extern int flag_pack_struct; -+ -+ /* 1 if alias checking is enabled: symbols do not alias each other -+ and parameters do not alias the current stack frame. */ -+ extern int flag_alias_check; -+ -+ /* This flag is only tested if alias checking is enabled. -+ 0 if pointer arguments may alias each other. True in C. -+ 1 if pointer arguments may not alias each other but may alias -+ global variables. -+ 2 if pointer arguments may not alias each other and may not -+ alias global variables. True in Fortran. -+ The value is ignored if flag_alias_check is 0. */ -+ extern int flag_argument_noalias; - - /* Other basic status info about current function. */ -diff -rcp2N gcc-2.7.2.2/fold-const.c gcc-2.7.2.2.f.2/fold-const.c -*** gcc-2.7.2.2/fold-const.c Fri Sep 15 18:26:12 1995 ---- gcc-2.7.2.2.f.2/fold-const.c Sun Feb 23 15:25:58 1997 -*************** static tree unextend PROTO((tree, int, i -*** 80,83 **** ---- 80,84 ---- - static tree fold_truthop PROTO((enum tree_code, tree, tree, tree)); - static tree strip_compound_expr PROTO((tree, tree)); -+ static int multiple_of_p PROTO((tree, tree, tree)); - - #ifndef BRANCH_COST -*************** strip_compound_expr (t, s) -*** 3065,3068 **** ---- 3066,3169 ---- - } - -+ /* Determine if first argument is a multiple of second argument. -+ Return 0 if it is not, or is not easily determined to so be. -+ -+ An example of the sort of thing we care about (at this point -- -+ this routine could surely be made more general, and expanded -+ to do what the *_DIV_EXPR's fold() cases do now) is discovering -+ that -+ -+ SAVE_EXPR (I) * SAVE_EXPR (J * 8) -+ -+ is a multiple of -+ -+ SAVE_EXPR (J * 8) -+ -+ when we know that the two `SAVE_EXPR (J * 8)' nodes are the -+ same node (which means they will have the same value at run -+ time, even though we don't know when they'll be assigned). -+ -+ This code also handles discovering that -+ -+ SAVE_EXPR (I) * SAVE_EXPR (J * 8) -+ -+ is a multiple of -+ -+ 8 -+ -+ (of course) so we don't have to worry about dealing with a -+ possible remainder. -+ -+ Note that we _look_ inside a SAVE_EXPR only to determine -+ how it was calculated; it is not safe for fold() to do much -+ of anything else with the internals of a SAVE_EXPR, since -+ fold() cannot know when it will be evaluated at run time. -+ For example, the latter example above _cannot_ be implemented -+ as -+ -+ SAVE_EXPR (I) * J -+ -+ or any variant thereof, since the value of J at evaluation time -+ of the original SAVE_EXPR is not necessarily the same at the time -+ the new expression is evaluated. The only optimization of this -+ sort that would be valid is changing -+ -+ SAVE_EXPR (I) * SAVE_EXPR (SAVE_EXPR (J) * 8) -+ divided by -+ 8 -+ -+ to -+ -+ SAVE_EXPR (I) * SAVE_EXPR (J) -+ -+ (where the same SAVE_EXPR (J) is used in the original and the -+ transformed version). */ -+ -+ static int -+ multiple_of_p (type, top, bottom) -+ tree type; -+ tree top; -+ tree bottom; -+ { -+ if (operand_equal_p (top, bottom, 0)) -+ return 1; -+ -+ if (TREE_CODE (type) != INTEGER_TYPE) -+ return 0; -+ -+ switch (TREE_CODE (top)) -+ { -+ case MULT_EXPR: -+ return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) -+ || multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); -+ -+ case PLUS_EXPR: -+ case MINUS_EXPR: -+ return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom) -+ && multiple_of_p (type, TREE_OPERAND (top, 1), bottom)); -+ -+ case NOP_EXPR: -+ /* Punt if conversion from non-integral or wider integral type. */ -+ if ((TREE_CODE (TREE_TYPE (TREE_OPERAND (top, 0))) != INTEGER_TYPE) -+ || (TYPE_PRECISION (type) -+ < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (top, 0))))) -+ return 0; -+ /* Fall through. */ -+ case SAVE_EXPR: -+ return multiple_of_p (type, TREE_OPERAND (top, 0), bottom); -+ -+ case INTEGER_CST: -+ if ((TREE_CODE (bottom) != INTEGER_CST) -+ || (tree_int_cst_sgn (top) < 0) -+ || (tree_int_cst_sgn (bottom) < 0)) -+ return 0; -+ return integer_zerop (const_binop (TRUNC_MOD_EXPR, -+ top, bottom, 0)); -+ -+ default: -+ return 0; -+ } -+ } -+ - /* Perform constant folding and related simplification of EXPR. - The related simplifications include x*1 => x, x*0 => 0, etc., -*************** fold (expr) -*** 4010,4013 **** ---- 4111,4121 ---- - case FLOOR_DIV_EXPR: - case CEIL_DIV_EXPR: -+ if (integer_onep (arg1)) -+ return non_lvalue (convert (type, arg0)); -+ /* If arg0 is a multiple of arg1, then rewrite to the fastest div -+ operation, EXACT_DIV_EXPR. Otherwise, handle folding of -+ general divide. */ -+ if (multiple_of_p (type, arg0, arg1)) -+ return fold (build (EXACT_DIV_EXPR, type, arg0, arg1)); - case EXACT_DIV_EXPR: - if (integer_onep (arg1)) -diff -rcp2N gcc-2.7.2.2/gcc.texi gcc-2.7.2.2.f.2/gcc.texi -*** gcc-2.7.2.2/gcc.texi Thu Feb 20 19:24:19 1997 ---- gcc-2.7.2.2.f.2/gcc.texi Sun Feb 23 16:16:49 1997 -*************** original English. -*** 149,152 **** ---- 149,153 ---- - @sp 3 - @center Last updated 29 June 1996 -+ @center (Revised for GNU Fortran 1997-01-10) - @sp 1 - @c The version number appears twice more in this file. -diff -rcp2N gcc-2.7.2.2/glimits.h gcc-2.7.2.2.f.2/glimits.h -*** gcc-2.7.2.2/glimits.h Wed Sep 29 17:30:54 1993 ---- gcc-2.7.2.2.f.2/glimits.h Thu Dec 19 12:31:08 1996 -*************** -*** 64,68 **** - (Same as `int'). */ - #ifndef __LONG_MAX__ -! #define __LONG_MAX__ 2147483647L - #endif - #undef LONG_MIN ---- 64,72 ---- - (Same as `int'). */ - #ifndef __LONG_MAX__ -! # ifndef __alpha__ -! # define __LONG_MAX__ 2147483647L -! # else -! # define __LONG_MAX__ 9223372036854775807LL -! # endif /* __alpha__ */ - #endif - #undef LONG_MIN -diff -rcp2N gcc-2.7.2.2/invoke.texi gcc-2.7.2.2.f.2/invoke.texi -*** gcc-2.7.2.2/invoke.texi Tue Oct 3 11:40:43 1995 ---- gcc-2.7.2.2.f.2/invoke.texi Sun Feb 23 16:18:06 1997 -*************** -*** 1,3 **** -! @c Copyright (C) 1988, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. - @c This is part of the GCC manual. - @c For copying conditions, see the file gcc.texi. ---- 1,3 ---- -! @c Copyright (C) 1988, 89, 92-95, 1997 Free Software Foundation, Inc. - @c This is part of the GCC manual. - @c For copying conditions, see the file gcc.texi. -*************** in the following sections. -*** 149,152 **** ---- 149,153 ---- - -fschedule-insns2 -fstrength-reduce -fthread-jumps - -funroll-all-loops -funroll-loops -+ -fmove-all-movables -freduce-all-givs -frerun-loop-opt - -O -O0 -O1 -O2 -O3 - @end smallexample -*************** in addition to the above: -*** 331,334 **** ---- 332,337 ---- - -fshort-double -fvolatile -fvolatile-global - -fverbose-asm -fpack-struct +e0 +e1 -+ -fargument-alias -fargument-noalias -+ -fargument-noalias-global - @end smallexample - @end table -*************** and usually makes programs run more slow -*** 1941,1944 **** ---- 1944,1992 ---- - implies @samp{-fstrength-reduce} as well as @samp{-frerun-cse-after-loop}. - -+ @item -fmove-all-movables -+ Forces all invariant computations in loops to be moved -+ outside the loop. -+ This option is provided primarily to improve performance -+ for some Fortran code, though it might improve code written -+ in other languages. -+ -+ @emph{Note:} When compiling programs written in Fortran, -+ this option is enabled by default. -+ -+ Analysis of Fortran code optimization and the resulting -+ optimizations triggered by this option, and the -+ @samp{-freduce-all-givs} and @samp{-frerun-loop-opt} -+ options as well, were -+ contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}). -+ -+ These three options are intended to be removed someday, once -+ they have helped determine the efficacy of various -+ approaches to improving the performance of Fortran code. -+ -+ Please let us (@code{fortran@@gnu.ai.mit.edu}) -+ know how use of these options affects -+ the performance of your production code. -+ We're very interested in code that runs @emph{slower} -+ when these options are @emph{enabled}. -+ -+ @item -freduce-all-givs -+ Forces all general-induction variables in loops to be -+ strength-reduced. -+ This option is provided primarily to improve performance -+ for some Fortran code, though it might improve code written -+ in other languages. -+ -+ @emph{Note:} When compiling programs written in Fortran, -+ this option is enabled by default. -+ -+ @item -frerun-loop-opt -+ Runs loop optimizations a second time. -+ This option is provided primarily to improve performance -+ for some Fortran code, though it might improve code written -+ in other languages. -+ -+ @emph{Note:} When compiling programs written in Fortran, -+ this option is enabled by default. -+ - @item -fno-peephole - Disable any machine-specific peephole optimizations. -*************** compilation). -*** 4229,4232 **** ---- 4277,4352 ---- - With @samp{+e1}, G++ actually generates the code implementing virtual - functions defined in the code, and makes them publicly visible. -+ -+ @cindex aliasing of parameters -+ @cindex parameters, aliased -+ @item -fargument-alias -+ @item -fargument-noalias -+ @item -fargument-noalias-global -+ Specify the possible relationships among parameters and between -+ parameters and global data. -+ -+ @samp{-fargument-alias} specifies that arguments (parameters) may -+ alias each other and may alias global storage. -+ @samp{-fargument-noalias} specifies that arguments do not alias -+ each other, but may alias global storage. -+ @samp{-fargument-noalias-global} specifies that arguments do not -+ alias each other and do not alias global storage. -+ -+ For code written in C, C++, and Objective-C, @samp{-fargument-alias} -+ is the default. -+ For code written in Fortran, @samp{-fargument-noalias-global} is -+ the default, though this is pertinent only on systems where -+ @code{g77} is installed. -+ (See the documentation for other compilers for information on the -+ defaults for their respective languages.) -+ -+ Normally, @code{gcc} assumes that a write through a pointer -+ passed as a parameter to the current function might modify a -+ value pointed to by another pointer passed as a parameter, or -+ in global storage. -+ -+ For example, consider this code: -+ -+ @example -+ void x(int *i, int *j) -+ @{ -+ extern int k; -+ -+ ++*i; -+ ++*j; -+ ++k; -+ @} -+ @end example -+ -+ When compiling the above function, @code{gcc} assumes that @samp{i} might -+ be a pointer to the same variable as @samp{j}, and that either @samp{i}, -+ @samp{j}, or both might be a pointer to @samp{k}. -+ -+ Therefore, @code{gcc} does not assume it can generate code to read -+ @samp{*i}, @samp{*j}, and @samp{k} into separate registers, increment -+ each register, then write the incremented values back out. -+ -+ Instead, @code{gcc} must generate code that reads @samp{*i}, -+ increments it, and writes it back before reading @samp{*j}, -+ in case @samp{i} and @samp{j} are aliased, and, similarly, -+ that writes @samp{*j} before reading @samp{k}. -+ The result is code that, on many systems, takes longer to execute, -+ due to the way many processors schedule instruction execution. -+ -+ Compiling the above code with the @samp{-fargument-noalias} option -+ allows @code{gcc} to assume that @samp{i} and @samp{j} do not alias -+ each other, but either might alias @samp{k}. -+ -+ Compiling the above code with the @samp{-fargument-noalias-global} -+ option allows @code{gcc} to assume that no combination of @samp{i}, -+ @samp{j}, and @samp{k} are aliases for each other. -+ -+ @emph{Note:} Use the @samp{-fargument-noalias} and -+ @samp{-fargument-noalias-global} options with care. -+ While they can result in faster executables, they can -+ also result in executables with subtle bugs, bugs that -+ show up only when compiled for specific target systems, -+ or bugs that show up only when compiled by specific versions -+ of @code{g77}. - @end table - -diff -rcp2N gcc-2.7.2.2/local-alloc.c gcc-2.7.2.2.f.2/local-alloc.c -*** gcc-2.7.2.2/local-alloc.c Mon Aug 21 13:15:44 1995 ---- gcc-2.7.2.2.f.2/local-alloc.c Fri Jan 10 23:18:22 1997 -*************** validate_equiv_mem_from_store (dest, set -*** 545,549 **** - && reg_overlap_mentioned_p (dest, equiv_mem)) - || (GET_CODE (dest) == MEM -! && true_dependence (dest, equiv_mem))) - equiv_mem_modified = 1; - } ---- 545,549 ---- - && reg_overlap_mentioned_p (dest, equiv_mem)) - || (GET_CODE (dest) == MEM -! && true_dependence (dest, VOIDmode, equiv_mem, rtx_varies_p))) - equiv_mem_modified = 1; - } -*************** memref_referenced_p (memref, x) -*** 630,634 **** - - case MEM: -! if (true_dependence (memref, x)) - return 1; - break; ---- 630,634 ---- - - case MEM: -! if (true_dependence (memref, VOIDmode, x, rtx_varies_p)) - return 1; - break; -diff -rcp2N gcc-2.7.2.2/loop.c gcc-2.7.2.2.f.2/loop.c -*** gcc-2.7.2.2/loop.c Thu Feb 20 19:24:20 1997 ---- gcc-2.7.2.2.f.2/loop.c Sun Feb 23 15:35:42 1997 -*************** int *loop_number_exit_count; -*** 111,116 **** - unsigned HOST_WIDE_INT loop_n_iterations; - -! /* Nonzero if there is a subroutine call in the current loop. -! (unknown_address_altered is also nonzero in this case.) */ - - static int loop_has_call; ---- 111,115 ---- - unsigned HOST_WIDE_INT loop_n_iterations; - -! /* Nonzero if there is a subroutine call in the current loop. */ - - static int loop_has_call; -*************** static char *moved_once; -*** 160,164 **** - here, we just turn on unknown_address_altered. */ - -! #define NUM_STORES 20 - static rtx loop_store_mems[NUM_STORES]; - ---- 159,163 ---- - here, we just turn on unknown_address_altered. */ - -! #define NUM_STORES 50 - static rtx loop_store_mems[NUM_STORES]; - -*************** move_movables (movables, threshold, insn -*** 1629,1632 **** ---- 1628,1632 ---- - - if (already_moved[regno] -+ || flag_move_all_movables - || (threshold * savings * m->lifetime) >= insn_count - || (m->forces && m->forces->done -*************** prescan_loop (start, end) -*** 2199,2203 **** - else if (GET_CODE (insn) == CALL_INSN) - { -! unknown_address_altered = 1; - loop_has_call = 1; - } ---- 2199,2204 ---- - else if (GET_CODE (insn) == CALL_INSN) - { -! if (! CONST_CALL_P (insn)) -! unknown_address_altered = 1; - loop_has_call = 1; - } -*************** invariant_p (x) -*** 2777,2781 **** - /* See if there is any dependence between a store and this load. */ - for (i = loop_store_mems_idx - 1; i >= 0; i--) -! if (true_dependence (loop_store_mems[i], x)) - return 0; - ---- 2778,2782 ---- - /* See if there is any dependence between a store and this load. */ - for (i = loop_store_mems_idx - 1; i >= 0; i--) -! if (true_dependence (loop_store_mems[i], VOIDmode, x, rtx_varies_p)) - return 0; - -*************** strength_reduce (scan_start, end, loop_t -*** 3821,3826 **** - exit. */ - -! if (v->lifetime * threshold * benefit < insn_count -! && ! bl->reversed) - { - if (loop_dump_stream) ---- 3822,3827 ---- - exit. */ - -! if ( ! flag_reduce_all_givs && v->lifetime * threshold * benefit < insn_count -! && ! bl->reversed ) - { - if (loop_dump_stream) -*************** record_giv (v, insn, src_reg, dest_reg, -*** 4375,4378 **** ---- 4376,4381 ---- - v->final_value = 0; - v->same_insn = 0; -+ v->unrolled = 0; -+ v->shared = 0; - - /* The v->always_computable field is used in update_giv_derive, to -*************** check_final_value (v, loop_start, loop_e -*** 4652,4657 **** - if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) - && LABEL_NAME (JUMP_LABEL (p)) -! && ((INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) -! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) - || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) - && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) ---- 4655,4663 ---- - if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p) - && LABEL_NAME (JUMP_LABEL (p)) -! && ((INSN_UID (JUMP_LABEL (p)) >= max_uid_for_loop) -! || (INSN_UID (v->insn) >= max_uid_for_loop) -! || (INSN_UID (last_giv_use) >= max_uid_for_loop) -! || (INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn) -! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start)) - || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use) - && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end)))) -*************** emit_iv_add_mult (b, m, a, reg, insert_b -*** 5560,5563 **** ---- 5566,5571 ---- - - emit_insn_before (seq, insert_before); -+ -+ record_base_value (REGNO (reg), b); - } - -diff -rcp2N gcc-2.7.2.2/loop.h gcc-2.7.2.2.f.2/loop.h -*** gcc-2.7.2.2/loop.h Fri Jul 14 08:23:28 1995 ---- gcc-2.7.2.2.f.2/loop.h Fri Jan 10 23:18:23 1997 -*************** struct induction -*** 89,92 **** ---- 89,95 ---- - we won't use it to eliminate a biv, it - would probably lose. */ -+ unsigned unrolled : 1; /* 1 if new register has been allocated in -+ unrolled loop. */ -+ unsigned shared : 1; - int lifetime; /* Length of life of this giv */ - int times_used; /* # times this giv is used. */ -diff -rcp2N gcc-2.7.2.2/real.c gcc-2.7.2.2.f.2/real.c -*** gcc-2.7.2.2/real.c Tue Aug 15 17:57:18 1995 ---- gcc-2.7.2.2.f.2/real.c Thu Dec 19 12:31:09 1996 -*************** make_nan (nan, sign, mode) -*** 5625,5633 **** - } - -! /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. -! This is the inverse of the function `etarsingle' invoked by - REAL_VALUE_TO_TARGET_SINGLE. */ - - REAL_VALUE_TYPE - ereal_from_float (f) - HOST_WIDE_INT f; ---- 5625,5699 ---- - } - -! /* This is the inverse of the function `etarsingle' invoked by - REAL_VALUE_TO_TARGET_SINGLE. */ - - REAL_VALUE_TYPE -+ ereal_unto_float (f) -+ long f; -+ { -+ REAL_VALUE_TYPE r; -+ unsigned EMUSHORT s[2]; -+ unsigned EMUSHORT e[NE]; -+ -+ /* Convert 32 bit integer to array of 16 bit pieces in target machine order. -+ This is the inverse operation to what the function `endian' does. */ -+ if (REAL_WORDS_BIG_ENDIAN) -+ { -+ s[0] = (unsigned EMUSHORT) (f >> 16); -+ s[1] = (unsigned EMUSHORT) f; -+ } -+ else -+ { -+ s[0] = (unsigned EMUSHORT) f; -+ s[1] = (unsigned EMUSHORT) (f >> 16); -+ } -+ /* Convert and promote the target float to E-type. */ -+ e24toe (s, e); -+ /* Output E-type to REAL_VALUE_TYPE. */ -+ PUT_REAL (e, &r); -+ return r; -+ } -+ -+ -+ /* This is the inverse of the function `etardouble' invoked by -+ REAL_VALUE_TO_TARGET_DOUBLE. */ -+ -+ REAL_VALUE_TYPE -+ ereal_unto_double (d) -+ long d[]; -+ { -+ REAL_VALUE_TYPE r; -+ unsigned EMUSHORT s[4]; -+ unsigned EMUSHORT e[NE]; -+ -+ /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */ -+ if (REAL_WORDS_BIG_ENDIAN) -+ { -+ s[0] = (unsigned EMUSHORT) (d[0] >> 16); -+ s[1] = (unsigned EMUSHORT) d[0]; -+ s[2] = (unsigned EMUSHORT) (d[1] >> 16); -+ s[3] = (unsigned EMUSHORT) d[1]; -+ } -+ else -+ { -+ /* Target float words are little-endian. */ -+ s[0] = (unsigned EMUSHORT) d[0]; -+ s[1] = (unsigned EMUSHORT) (d[0] >> 16); -+ s[2] = (unsigned EMUSHORT) d[1]; -+ s[3] = (unsigned EMUSHORT) (d[1] >> 16); -+ } -+ /* Convert target double to E-type. */ -+ e53toe (s, e); -+ /* Output E-type to REAL_VALUE_TYPE. */ -+ PUT_REAL (e, &r); -+ return r; -+ } -+ -+ -+ /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE. -+ This is somewhat like ereal_unto_float, but the input types -+ for these are different. */ -+ -+ REAL_VALUE_TYPE - ereal_from_float (f) - HOST_WIDE_INT f; -*************** ereal_from_float (f) -*** 5658,5663 **** - - /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. -! This is the inverse of the function `etardouble' invoked by -! REAL_VALUE_TO_TARGET_DOUBLE. - - The DFmode is stored as an array of HOST_WIDE_INT in the target's ---- 5724,5729 ---- - - /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE. -! This is somewhat like ereal_unto_double, but the input types -! for these are different. - - The DFmode is stored as an array of HOST_WIDE_INT in the target's -diff -rcp2N gcc-2.7.2.2/real.h gcc-2.7.2.2.f.2/real.h -*** gcc-2.7.2.2/real.h Thu Jun 15 07:57:56 1995 ---- gcc-2.7.2.2.f.2/real.h Thu Dec 19 12:31:09 1996 -*************** extern void ereal_to_decimal PROTO((REAL -*** 152,155 **** ---- 152,157 ---- - extern int ereal_cmp PROTO((REAL_VALUE_TYPE, REAL_VALUE_TYPE)); - extern int ereal_isneg PROTO((REAL_VALUE_TYPE)); -+ extern REAL_VALUE_TYPE ereal_unto_float PROTO((long)); -+ extern REAL_VALUE_TYPE ereal_unto_double PROTO((long *)); - extern REAL_VALUE_TYPE ereal_from_float PROTO((HOST_WIDE_INT)); - extern REAL_VALUE_TYPE ereal_from_double PROTO((HOST_WIDE_INT *)); -*************** extern REAL_VALUE_TYPE real_value_trunca -*** 197,200 **** ---- 199,208 ---- - /* IN is a REAL_VALUE_TYPE. OUT is a long. */ - #define REAL_VALUE_TO_TARGET_SINGLE(IN, OUT) ((OUT) = etarsingle ((IN))) -+ -+ /* Inverse of REAL_VALUE_TO_TARGET_DOUBLE. */ -+ #define REAL_VALUE_UNTO_TARGET_DOUBLE(d) (ereal_unto_double (d)) -+ -+ /* Inverse of REAL_VALUE_TO_TARGET_SINGLE. */ -+ #define REAL_VALUE_UNTO_TARGET_SINGLE(f) (ereal_unto_float (f)) - - /* d is an array of HOST_WIDE_INT that holds a double precision -diff -rcp2N gcc-2.7.2.2/reload.c gcc-2.7.2.2.f.2/reload.c -*** gcc-2.7.2.2/reload.c Sat Nov 11 08:23:54 1995 ---- gcc-2.7.2.2.f.2/reload.c Thu Feb 27 23:03:05 1997 -*************** -*** 1,4 **** - /* Search an insn for pseudo regs that must be in hard regs and are not. -! Copyright (C) 1987, 88, 89, 92, 93, 94, 1995 Free Software Foundation, Inc. - - This file is part of GNU CC. ---- 1,4 ---- - /* Search an insn for pseudo regs that must be in hard regs and are not. -! Copyright (C) 1987, 88, 89, 92-5, 1996 Free Software Foundation, Inc. - - This file is part of GNU CC. -*************** static int push_secondary_reload PROTO(( -*** 292,295 **** ---- 292,296 ---- - enum machine_mode, enum reload_type, - enum insn_code *)); -+ static enum reg_class find_valid_class PROTO((enum machine_mode, int)); - static int push_reload PROTO((rtx, rtx, rtx *, rtx *, enum reg_class, - enum machine_mode, enum machine_mode, -*************** push_secondary_reload (in_p, x, opnum, o -*** 361,364 **** ---- 362,368 ---- - mode and object being reloaded. */ - if (GET_CODE (x) == SUBREG -+ #ifdef CLASS_CANNOT_CHANGE_SIZE -+ && reload_class != CLASS_CANNOT_CHANGE_SIZE -+ #endif - && (GET_MODE_SIZE (GET_MODE (x)) - > GET_MODE_SIZE (GET_MODE (SUBREG_REG (x))))) -*************** clear_secondary_mem () -*** 689,692 **** ---- 693,728 ---- - #endif /* SECONDARY_MEMORY_NEEDED */ - -+ /* Find the largest class for which every register number plus N is valid in -+ M1 (if in range). Abort if no such class exists. */ -+ -+ static enum reg_class -+ find_valid_class (m1, n) -+ enum machine_mode m1; -+ int n; -+ { -+ int class; -+ int regno; -+ enum reg_class best_class; -+ int best_size = 0; -+ -+ for (class = 1; class < N_REG_CLASSES; class++) -+ { -+ int bad = 0; -+ for (regno = 0; regno < FIRST_PSEUDO_REGISTER && ! bad; regno++) -+ if (TEST_HARD_REG_BIT (reg_class_contents[class], regno) -+ && TEST_HARD_REG_BIT (reg_class_contents[class], regno + n) -+ && ! HARD_REGNO_MODE_OK (regno + n, m1)) -+ bad = 1; -+ -+ if (! bad && reg_class_size[class] > best_size) -+ best_class = class, best_size = reg_class_size[class]; -+ } -+ -+ if (best_size == 0) -+ abort (); -+ -+ return best_class; -+ } -+ - /* Record one reload that needs to be performed. - IN is an rtx saying where the data are to be found before this instruction. -*************** push_reload (in, out, inloc, outloc, cla -*** 894,898 **** - && GET_CODE (SUBREG_REG (in)) == REG - && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER -! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)), inmode) - || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) ---- 930,935 ---- - && GET_CODE (SUBREG_REG (in)) == REG - && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER -! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)) + SUBREG_WORD (in), -! inmode) - || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in))) -*************** push_reload (in, out, inloc, outloc, cla -*** 909,913 **** - output before the outer reload. */ - push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, -! GENERAL_REGS, VOIDmode, VOIDmode, 0, 0, opnum, type); - dont_remove_subreg = 1; - } ---- 946,951 ---- - output before the outer reload. */ - push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR, -! find_valid_class (inmode, SUBREG_WORD (in)), -! VOIDmode, VOIDmode, 0, 0, opnum, type); - dont_remove_subreg = 1; - } -*************** push_reload (in, out, inloc, outloc, cla -*** 982,986 **** - && GET_CODE (SUBREG_REG (out)) == REG - && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER -! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)), outmode) - || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) ---- 1020,1025 ---- - && GET_CODE (SUBREG_REG (out)) == REG - && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER -! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)) + SUBREG_WORD (out), -! outmode) - || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD - && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out))) -*************** push_reload (in, out, inloc, outloc, cla -*** 998,1002 **** - dont_remove_subreg = 1; - push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), -! &SUBREG_REG (out), ALL_REGS, VOIDmode, VOIDmode, 0, 0, - opnum, RELOAD_OTHER); - } ---- 1037,1043 ---- - dont_remove_subreg = 1; - push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out), -! &SUBREG_REG (out), -! find_valid_class (outmode, SUBREG_WORD (out)), -! VOIDmode, VOIDmode, 0, 0, - opnum, RELOAD_OTHER); - } -*************** find_equiv_reg (goal, insn, class, other -*** 5518,5522 **** - and is also a register that appears in the address of GOAL. */ - -! if (goal_mem && value == SET_DEST (PATTERN (where)) - && refers_to_regno_for_reload_p (valueno, - (valueno ---- 5559,5563 ---- - and is also a register that appears in the address of GOAL. */ - -! if (goal_mem && value == SET_DEST (single_set (where)) - && refers_to_regno_for_reload_p (valueno, - (valueno -*************** debug_reload() -*** 5900,5904 **** - - if (reload_nocombine[r]) -! fprintf (stderr, ", can combine", reload_nocombine[r]); - - if (reload_secondary_p[r]) ---- 5941,5945 ---- - - if (reload_nocombine[r]) -! fprintf (stderr, ", can't combine %d", reload_nocombine[r]); - - if (reload_secondary_p[r]) -diff -rcp2N gcc-2.7.2.2/rtl.h gcc-2.7.2.2.f.2/rtl.h -*** gcc-2.7.2.2/rtl.h Thu Jun 15 08:03:16 1995 ---- gcc-2.7.2.2.f.2/rtl.h Fri Jan 10 23:18:23 1997 -*************** enum reg_note { REG_DEAD = 1, REG_INC = -*** 349,353 **** - REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, - REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, -! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15 }; - - /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ ---- 349,353 ---- - REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10, - REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13, -! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15, REG_NOALIAS = 16 }; - - /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */ -*************** extern char *reg_note_name[]; -*** 432,436 **** - #define NOTE_INSN_FUNCTION_BEG -13 - -- - #if 0 /* These are not used, and I don't know what they were for. --rms. */ - #define NOTE_DECL_NAME(INSN) ((INSN)->fld[3].rtstr) ---- 432,435 ---- -*************** extern char *note_insn_name[]; -*** 576,579 **** ---- 575,579 ---- - /* For a TRAP_IF rtx, TRAP_CONDITION is an expression. */ - #define TRAP_CONDITION(RTX) ((RTX)->fld[0].rtx) -+ #define TRAP_CODE(RTX) ((RTX)->fld[1].rtint) - - /* 1 in a SYMBOL_REF if it addresses this function's constants pool. */ -*************** extern rtx eliminate_constant_term PROTO -*** 817,820 **** ---- 817,830 ---- - extern rtx expand_complex_abs PROTO((enum machine_mode, rtx, rtx, int)); - extern enum machine_mode choose_hard_reg_mode PROTO((int, int)); -+ extern int rtx_varies_p PROTO((rtx)); -+ extern int may_trap_p PROTO((rtx)); -+ extern int side_effects_p PROTO((rtx)); -+ extern int volatile_refs_p PROTO((rtx)); -+ extern int volatile_insn_p PROTO((rtx)); -+ extern void remove_note PROTO((rtx, rtx)); -+ extern void note_stores PROTO((rtx, void (*)())); -+ extern int refers_to_regno_p PROTO((int, int, rtx, rtx *)); -+ extern int reg_overlap_mentioned_p PROTO((rtx, rtx)); -+ - - /* Maximum number of parallel sets and clobbers in any insn in this fn. -*************** extern rtx *regno_reg_rtx; -*** 967,968 **** ---- 977,985 ---- - - extern int rtx_to_tree_code PROTO((enum rtx_code)); -+ -+ extern int true_dependence PROTO((rtx, enum machine_mode, rtx, int (*)())); -+ extern int read_dependence PROTO((rtx, rtx)); -+ extern int anti_dependence PROTO((rtx, rtx)); -+ extern int output_dependence PROTO((rtx, rtx)); -+ extern void init_alias_analysis PROTO((void)); -+ extern void end_alias_analysis PROTO((void)); -diff -rcp2N gcc-2.7.2.2/sched.c gcc-2.7.2.2.f.2/sched.c -*** gcc-2.7.2.2/sched.c Thu Jun 15 08:06:39 1995 ---- gcc-2.7.2.2.f.2/sched.c Fri Jan 10 23:18:24 1997 -*************** Boston, MA 02111-1307, USA. */ -*** 126,129 **** ---- 126,132 ---- - #include "insn-attr.h" - -+ extern char *reg_known_equiv_p; -+ extern rtx *reg_known_value; -+ - #ifdef INSN_SCHEDULING - /* Arrays set up by scheduling for the same respective purposes as -*************** static int *sched_reg_live_length; -*** 143,146 **** ---- 146,150 ---- - by splitting insns. */ - static rtx *reg_last_uses; -+ static int reg_last_uses_size; - static rtx *reg_last_sets; - static regset reg_pending_sets; -*************** struct sometimes -*** 294,302 **** - - /* Forward declarations. */ -- static rtx canon_rtx PROTO((rtx)); -- static int rtx_equal_for_memref_p PROTO((rtx, rtx)); -- static rtx find_symbolic_term PROTO((rtx)); -- static int memrefs_conflict_p PROTO((int, rtx, int, rtx, -- HOST_WIDE_INT)); - static void add_dependence PROTO((rtx, rtx, enum reg_note)); - static void remove_dependence PROTO((rtx, rtx)); ---- 298,301 ---- -*************** void schedule_insns PROTO((FILE *)); -*** 346,885 **** - #endif /* INSN_SCHEDULING */ - -- #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X))) -- -- /* Vector indexed by N giving the initial (unchanging) value known -- for pseudo-register N. */ -- static rtx *reg_known_value; -- -- /* Vector recording for each reg_known_value whether it is due to a -- REG_EQUIV note. Future passes (viz., reload) may replace the -- pseudo with the equivalent expression and so we account for the -- dependences that would be introduced if that happens. */ -- /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in -- assign_parms mention the arg pointer, and there are explicit insns in the -- RTL that modify the arg pointer. Thus we must ensure that such insns don't -- get scheduled across each other because that would invalidate the REG_EQUIV -- notes. One could argue that the REG_EQUIV notes are wrong, but solving -- the problem in the scheduler will likely give better code, so we do it -- here. */ -- static char *reg_known_equiv_p; -- -- /* Indicates number of valid entries in reg_known_value. */ -- static int reg_known_value_size; -- -- static rtx -- canon_rtx (x) -- rtx x; -- { -- if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER -- && REGNO (x) <= reg_known_value_size) -- return reg_known_value[REGNO (x)]; -- else if (GET_CODE (x) == PLUS) -- { -- rtx x0 = canon_rtx (XEXP (x, 0)); -- rtx x1 = canon_rtx (XEXP (x, 1)); -- -- if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1)) -- { -- /* We can tolerate LO_SUMs being offset here; these -- rtl are used for nothing other than comparisons. */ -- if (GET_CODE (x0) == CONST_INT) -- return plus_constant_for_output (x1, INTVAL (x0)); -- else if (GET_CODE (x1) == CONST_INT) -- return plus_constant_for_output (x0, INTVAL (x1)); -- return gen_rtx (PLUS, GET_MODE (x), x0, x1); -- } -- } -- return x; -- } -- -- /* Set up all info needed to perform alias analysis on memory references. */ -- -- void -- init_alias_analysis () -- { -- int maxreg = max_reg_num (); -- rtx insn; -- rtx note; -- rtx set; -- -- reg_known_value_size = maxreg; -- -- reg_known_value -- = (rtx *) oballoc ((maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)) -- - FIRST_PSEUDO_REGISTER; -- bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER), -- (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx)); -- -- reg_known_equiv_p -- = (char *) oballoc ((maxreg -FIRST_PSEUDO_REGISTER) * sizeof (char)) -- - FIRST_PSEUDO_REGISTER; -- bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER, -- (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char)); -- -- /* Fill in the entries with known constant values. */ -- for (insn = get_insns (); insn; insn = NEXT_INSN (insn)) -- if ((set = single_set (insn)) != 0 -- && GET_CODE (SET_DEST (set)) == REG -- && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER -- && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0 -- && reg_n_sets[REGNO (SET_DEST (set))] == 1) -- || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0) -- && GET_CODE (XEXP (note, 0)) != EXPR_LIST) -- { -- int regno = REGNO (SET_DEST (set)); -- reg_known_value[regno] = XEXP (note, 0); -- reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV; -- } -- -- /* Fill in the remaining entries. */ -- while (--maxreg >= FIRST_PSEUDO_REGISTER) -- if (reg_known_value[maxreg] == 0) -- reg_known_value[maxreg] = regno_reg_rtx[maxreg]; -- } -- -- /* Return 1 if X and Y are identical-looking rtx's. -- -- We use the data in reg_known_value above to see if two registers with -- different numbers are, in fact, equivalent. */ -- -- static int -- rtx_equal_for_memref_p (x, y) -- rtx x, y; -- { -- register int i; -- register int j; -- register enum rtx_code code; -- register char *fmt; -- -- if (x == 0 && y == 0) -- return 1; -- if (x == 0 || y == 0) -- return 0; -- x = canon_rtx (x); -- y = canon_rtx (y); -- -- if (x == y) -- return 1; -- -- code = GET_CODE (x); -- /* Rtx's of different codes cannot be equal. */ -- if (code != GET_CODE (y)) -- return 0; -- -- /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent. -- (REG:SI x) and (REG:HI x) are NOT equivalent. */ -- -- if (GET_MODE (x) != GET_MODE (y)) -- return 0; -- -- /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */ -- -- if (code == REG) -- return REGNO (x) == REGNO (y); -- if (code == LABEL_REF) -- return XEXP (x, 0) == XEXP (y, 0); -- if (code == SYMBOL_REF) -- return XSTR (x, 0) == XSTR (y, 0); -- -- /* For commutative operations, the RTX match if the operand match in any -- order. Also handle the simple binary and unary cases without a loop. */ -- if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c') -- return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) -- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))) -- || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1)) -- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0)))); -- else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2') -- return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)) -- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1))); -- else if (GET_RTX_CLASS (code) == '1') -- return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0)); -- -- /* Compare the elements. If any pair of corresponding elements -- fail to match, return 0 for the whole things. */ -- -- fmt = GET_RTX_FORMAT (code); -- for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) -- { -- switch (fmt[i]) -- { -- case 'w': -- if (XWINT (x, i) != XWINT (y, i)) -- return 0; -- break; -- -- case 'n': -- case 'i': -- if (XINT (x, i) != XINT (y, i)) -- return 0; -- break; -- -- case 'V': -- case 'E': -- /* Two vectors must have the same length. */ -- if (XVECLEN (x, i) != XVECLEN (y, i)) -- return 0; -- -- /* And the corresponding elements must match. */ -- for (j = 0; j < XVECLEN (x, i); j++) -- if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0) -- return 0; -- break; -- -- case 'e': -- if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0) -- return 0; -- break; -- -- case 'S': -- case 's': -- if (strcmp (XSTR (x, i), XSTR (y, i))) -- return 0; -- break; -- -- case 'u': -- /* These are just backpointers, so they don't matter. */ -- break; -- -- case '0': -- break; -- -- /* It is believed that rtx's at this level will never -- contain anything but integers and other rtx's, -- except for within LABEL_REFs and SYMBOL_REFs. */ -- default: -- abort (); -- } -- } -- return 1; -- } -- -- /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within -- X and return it, or return 0 if none found. */ -- -- static rtx -- find_symbolic_term (x) -- rtx x; -- { -- register int i; -- register enum rtx_code code; -- register char *fmt; -- -- code = GET_CODE (x); -- if (code == SYMBOL_REF || code == LABEL_REF) -- return x; -- if (GET_RTX_CLASS (code) == 'o') -- return 0; -- -- fmt = GET_RTX_FORMAT (code); -- for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) -- { -- rtx t; -- -- if (fmt[i] == 'e') -- { -- t = find_symbolic_term (XEXP (x, i)); -- if (t != 0) -- return t; -- } -- else if (fmt[i] == 'E') -- break; -- } -- return 0; -- } -- -- /* Return nonzero if X and Y (memory addresses) could reference the -- same location in memory. C is an offset accumulator. When -- C is nonzero, we are testing aliases between X and Y + C. -- XSIZE is the size in bytes of the X reference, -- similarly YSIZE is the size in bytes for Y. -- -- If XSIZE or YSIZE is zero, we do not know the amount of memory being -- referenced (the reference was BLKmode), so make the most pessimistic -- assumptions. -- -- We recognize the following cases of non-conflicting memory: -- -- (1) addresses involving the frame pointer cannot conflict -- with addresses involving static variables. -- (2) static variables with different addresses cannot conflict. -- -- Nice to notice that varying addresses cannot conflict with fp if no -- local variables had their addresses taken, but that's too hard now. */ -- -- /* ??? In Fortran, references to a array parameter can never conflict with -- another array parameter. */ -- -- static int -- memrefs_conflict_p (xsize, x, ysize, y, c) -- rtx x, y; -- int xsize, ysize; -- HOST_WIDE_INT c; -- { -- if (GET_CODE (x) == HIGH) -- x = XEXP (x, 0); -- else if (GET_CODE (x) == LO_SUM) -- x = XEXP (x, 1); -- else -- x = canon_rtx (x); -- if (GET_CODE (y) == HIGH) -- y = XEXP (y, 0); -- else if (GET_CODE (y) == LO_SUM) -- y = XEXP (y, 1); -- else -- y = canon_rtx (y); -- -- if (rtx_equal_for_memref_p (x, y)) -- return (xsize == 0 || ysize == 0 || -- (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -- -- if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx -- || y == stack_pointer_rtx) -- { -- rtx t = y; -- int tsize = ysize; -- y = x; ysize = xsize; -- x = t; xsize = tsize; -- } -- -- if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx -- || x == stack_pointer_rtx) -- { -- rtx y1; -- -- if (CONSTANT_P (y)) -- return 0; -- -- if (GET_CODE (y) == PLUS -- && canon_rtx (XEXP (y, 0)) == x -- && (y1 = canon_rtx (XEXP (y, 1))) -- && GET_CODE (y1) == CONST_INT) -- { -- c += INTVAL (y1); -- return (xsize == 0 || ysize == 0 -- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -- } -- -- if (GET_CODE (y) == PLUS -- && (y1 = canon_rtx (XEXP (y, 0))) -- && CONSTANT_P (y1)) -- return 0; -- -- return 1; -- } -- -- if (GET_CODE (x) == PLUS) -- { -- /* The fact that X is canonicalized means that this -- PLUS rtx is canonicalized. */ -- rtx x0 = XEXP (x, 0); -- rtx x1 = XEXP (x, 1); -- -- if (GET_CODE (y) == PLUS) -- { -- /* The fact that Y is canonicalized means that this -- PLUS rtx is canonicalized. */ -- rtx y0 = XEXP (y, 0); -- rtx y1 = XEXP (y, 1); -- -- if (rtx_equal_for_memref_p (x1, y1)) -- return memrefs_conflict_p (xsize, x0, ysize, y0, c); -- if (rtx_equal_for_memref_p (x0, y0)) -- return memrefs_conflict_p (xsize, x1, ysize, y1, c); -- if (GET_CODE (x1) == CONST_INT) -- if (GET_CODE (y1) == CONST_INT) -- return memrefs_conflict_p (xsize, x0, ysize, y0, -- c - INTVAL (x1) + INTVAL (y1)); -- else -- return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); -- else if (GET_CODE (y1) == CONST_INT) -- return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); -- -- /* Handle case where we cannot understand iteration operators, -- but we notice that the base addresses are distinct objects. */ -- x = find_symbolic_term (x); -- if (x == 0) -- return 1; -- y = find_symbolic_term (y); -- if (y == 0) -- return 1; -- return rtx_equal_for_memref_p (x, y); -- } -- else if (GET_CODE (x1) == CONST_INT) -- return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1)); -- } -- else if (GET_CODE (y) == PLUS) -- { -- /* The fact that Y is canonicalized means that this -- PLUS rtx is canonicalized. */ -- rtx y0 = XEXP (y, 0); -- rtx y1 = XEXP (y, 1); -- -- if (GET_CODE (y1) == CONST_INT) -- return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1)); -- else -- return 1; -- } -- -- if (GET_CODE (x) == GET_CODE (y)) -- switch (GET_CODE (x)) -- { -- case MULT: -- { -- /* Handle cases where we expect the second operands to be the -- same, and check only whether the first operand would conflict -- or not. */ -- rtx x0, y0; -- rtx x1 = canon_rtx (XEXP (x, 1)); -- rtx y1 = canon_rtx (XEXP (y, 1)); -- if (! rtx_equal_for_memref_p (x1, y1)) -- return 1; -- x0 = canon_rtx (XEXP (x, 0)); -- y0 = canon_rtx (XEXP (y, 0)); -- if (rtx_equal_for_memref_p (x0, y0)) -- return (xsize == 0 || ysize == 0 -- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -- -- /* Can't properly adjust our sizes. */ -- if (GET_CODE (x1) != CONST_INT) -- return 1; -- xsize /= INTVAL (x1); -- ysize /= INTVAL (x1); -- c /= INTVAL (x1); -- return memrefs_conflict_p (xsize, x0, ysize, y0, c); -- } -- } -- -- if (CONSTANT_P (x)) -- { -- if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT) -- { -- c += (INTVAL (y) - INTVAL (x)); -- return (xsize == 0 || ysize == 0 -- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)); -- } -- -- if (GET_CODE (x) == CONST) -- { -- if (GET_CODE (y) == CONST) -- return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), -- ysize, canon_rtx (XEXP (y, 0)), c); -- else -- return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)), -- ysize, y, c); -- } -- if (GET_CODE (y) == CONST) -- return memrefs_conflict_p (xsize, x, ysize, -- canon_rtx (XEXP (y, 0)), c); -- -- if (CONSTANT_P (y)) -- return (rtx_equal_for_memref_p (x, y) -- && (xsize == 0 || ysize == 0 -- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0))); -- -- return 1; -- } -- return 1; -- } -- -- /* Functions to compute memory dependencies. -- -- Since we process the insns in execution order, we can build tables -- to keep track of what registers are fixed (and not aliased), what registers -- are varying in known ways, and what registers are varying in unknown -- ways. -- -- If both memory references are volatile, then there must always be a -- dependence between the two references, since their order can not be -- changed. A volatile and non-volatile reference can be interchanged -- though. -- -- A MEM_IN_STRUCT reference at a non-QImode varying address can never -- conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must -- allow QImode aliasing because the ANSI C standard allows character -- pointers to alias anything. We are assuming that characters are -- always QImode here. */ -- -- /* Read dependence: X is read after read in MEM takes place. There can -- only be a dependence here if both reads are volatile. */ -- -- int -- read_dependence (mem, x) -- rtx mem; -- rtx x; -- { -- return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem); -- } -- -- /* True dependence: X is read after store in MEM takes place. */ -- -- int -- true_dependence (mem, x) -- rtx mem; -- rtx x; -- { -- /* If X is an unchanging read, then it can't possibly conflict with any -- non-unchanging store. It may conflict with an unchanging write though, -- because there may be a single store to this address to initialize it. -- Just fall through to the code below to resolve the case where we have -- both an unchanging read and an unchanging write. This won't handle all -- cases optimally, but the possible performance loss should be -- negligible. */ -- if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem)) -- return 0; -- -- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), -- SIZE_FOR_MODE (x), XEXP (x, 0), 0) -- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) -- && GET_MODE (mem) != QImode -- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) -- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) -- && GET_MODE (x) != QImode -- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); -- } -- -- /* Anti dependence: X is written after read in MEM takes place. */ -- -- int -- anti_dependence (mem, x) -- rtx mem; -- rtx x; -- { -- /* If MEM is an unchanging read, then it can't possibly conflict with -- the store to X, because there is at most one store to MEM, and it must -- have occurred somewhere before MEM. */ -- if (RTX_UNCHANGING_P (mem)) -- return 0; -- -- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), -- SIZE_FOR_MODE (x), XEXP (x, 0), 0) -- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) -- && GET_MODE (mem) != QImode -- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) -- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) -- && GET_MODE (x) != QImode -- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); -- } -- -- /* Output dependence: X is written after store in MEM takes place. */ -- -- int -- output_dependence (mem, x) -- rtx mem; -- rtx x; -- { -- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem)) -- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0), -- SIZE_FOR_MODE (x), XEXP (x, 0), 0) -- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem) -- && GET_MODE (mem) != QImode -- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x)) -- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x) -- && GET_MODE (x) != QImode -- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)))); -- } -- - /* Helper functions for instruction scheduling. */ - ---- 345,348 ---- -*************** sched_analyze_2 (x, insn) -*** 1922,1926 **** - /* If a dependency already exists, don't create a new one. */ - if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) -! if (true_dependence (XEXP (pending_mem, 0), x)) - add_dependence (insn, XEXP (pending, 0), 0); - ---- 1385,1390 ---- - /* If a dependency already exists, don't create a new one. */ - if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn))) -! if (true_dependence (XEXP (pending_mem, 0), VOIDmode, -! x, rtx_varies_p)) - add_dependence (insn, XEXP (pending, 0), 0); - -*************** sched_analyze_insn (x, insn, loop_notes) -*** 2021,2025 **** - register RTX_CODE code = GET_CODE (x); - rtx link; -! int maxreg = max_reg_num (); - int i; - ---- 1485,1489 ---- - register RTX_CODE code = GET_CODE (x); - rtx link; -! int maxreg = reg_last_uses_size; - int i; - -*************** sched_analyze_insn (x, insn, loop_notes) -*** 2058,2062 **** - if (loop_notes) - { -! int max_reg = max_reg_num (); - rtx link; - ---- 1522,1526 ---- - if (loop_notes) - { -! int max_reg = reg_last_uses_size; - rtx link; - -*************** sched_analyze (head, tail) -*** 2202,2207 **** - && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) - { -! int max_reg = max_reg_num (); -! for (i = 0; i < max_reg; i++) - { - for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) ---- 1666,1670 ---- - && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP) - { -! for (i = 0; i < reg_last_uses_size; i++) - { - for (u = reg_last_uses[i]; u; u = XEXP (u, 1)) -*************** sched_note_set (b, x, death) -*** 2372,2380 **** - - #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ -! do { if ((NEW_READY) - (OLD_READY) == 1) \ -! swap_sort (READY, NEW_READY); \ -! else if ((NEW_READY) - (OLD_READY) > 1) \ -! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); } \ -! while (0) - - /* Returns a positive value if y is preferred; returns a negative value if ---- 1835,1842 ---- - - #define SCHED_SORT(READY, NEW_READY, OLD_READY) \ -! if ((NEW_READY) - (OLD_READY) == 1) \ -! swap_sort (READY, NEW_READY); \ -! else if ((NEW_READY) - (OLD_READY) > 1) \ -! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); else \ - - /* Returns a positive value if y is preferred; returns a negative value if -*************** schedule_block (b, file) -*** 3174,3178 **** - b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); - -! i = max_reg_num (); - reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); - bzero ((char *) reg_last_uses, i * sizeof (rtx)); ---- 2636,2640 ---- - b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b])); - -! reg_last_uses_size = i = max_reg_num (); - reg_last_uses = (rtx *) alloca (i * sizeof (rtx)); - bzero ((char *) reg_last_uses, i * sizeof (rtx)); -*************** schedule_insns (dump_file) -*** 4718,4721 **** ---- 4180,4198 ---- - max_regno * sizeof (short)); - init_alias_analysis (); -+ #if 0 -+ if (dump_file) -+ { -+ extern rtx *reg_base_value; -+ extern int reg_base_value_size; -+ int i; -+ for (i = 0; i < reg_base_value_size; i++) -+ if (reg_base_value[i]) -+ { -+ fprintf (dump_file, ";; reg_base_value[%d] = ", i); -+ print_rtl (dump_file, reg_base_value[i]); -+ fputc ('\n', dump_file); -+ } -+ } -+ #endif - } - else -*************** schedule_insns (dump_file) -*** 4726,4731 **** - bb_dead_regs = 0; - bb_live_regs = 0; -! if (! flag_schedule_insns) -! init_alias_analysis (); - } - ---- 4203,4207 ---- - bb_dead_regs = 0; - bb_live_regs = 0; -! init_alias_analysis (); - } - -diff -rcp2N gcc-2.7.2.2/toplev.c gcc-2.7.2.2.f.2/toplev.c -*** gcc-2.7.2.2/toplev.c Fri Oct 20 17:56:35 1995 ---- gcc-2.7.2.2.f.2/toplev.c Fri Jan 10 23:18:24 1997 -*************** int flag_unroll_loops; -*** 388,391 **** ---- 388,405 ---- - int flag_unroll_all_loops; - -+ /* Nonzero forces all invariant computations in loops to be moved -+ outside the loop. */ -+ -+ int flag_move_all_movables = 0; -+ -+ /* Nonzero forces all general induction variables in loops to be -+ strength reduced. */ -+ -+ int flag_reduce_all_givs = 0; -+ -+ /* Nonzero gets another run of loop_optimize performed. */ -+ -+ int flag_rerun_loop_opt = 0; -+ - /* Nonzero for -fwritable-strings: - store string constants in data segment and don't uniquize them. */ -*************** int flag_gnu_linker = 1; -*** 522,525 **** ---- 536,550 ---- - int flag_pack_struct = 0; - -+ /* 1 if alias checking is on (by default, when -O). */ -+ int flag_alias_check = 0; -+ -+ /* 0 if pointer arguments may alias each other. True in C. -+ 1 if pointer arguments may not alias each other but may alias -+ global variables. -+ 2 if pointer arguments may not alias each other and may not -+ alias global variables. True in Fortran. -+ This defaults to 0 for C. */ -+ int flag_argument_noalias = 0; -+ - /* Table of language-independent -f options. - STRING is the option name. VARIABLE is the address of the variable. -*************** struct { char *string; int *variable; in -*** 542,545 **** ---- 567,573 ---- - {"unroll-loops", &flag_unroll_loops, 1}, - {"unroll-all-loops", &flag_unroll_all_loops, 1}, -+ {"move-all-movables", &flag_move_all_movables, 1}, -+ {"reduce-all-givs", &flag_reduce_all_givs, 1}, -+ {"rerun-loop-opt", &flag_rerun_loop_opt, 1}, - {"writable-strings", &flag_writable_strings, 1}, - {"peephole", &flag_no_peephole, 0}, -*************** struct { char *string; int *variable; in -*** 568,572 **** - {"gnu-linker", &flag_gnu_linker, 1}, - {"pack-struct", &flag_pack_struct, 1}, -! {"bytecode", &output_bytecode, 1} - }; - ---- 596,604 ---- - {"gnu-linker", &flag_gnu_linker, 1}, - {"pack-struct", &flag_pack_struct, 1}, -! {"bytecode", &output_bytecode, 1}, -! {"alias-check", &flag_alias_check, 1}, -! {"argument-alias", &flag_argument_noalias, 0}, -! {"argument-noalias", &flag_argument_noalias, 1}, -! {"argument-noalias-global", &flag_argument_noalias, 2} - }; - -*************** rest_of_compilation (decl) -*** 2894,2897 **** ---- 2926,2931 ---- - { - loop_optimize (insns, loop_dump_file); -+ if (flag_rerun_loop_opt) -+ loop_optimize (insns, loop_dump_file); - }); - } -*************** main (argc, argv, envp) -*** 3383,3386 **** ---- 3417,3421 ---- - flag_omit_frame_pointer = 1; - #endif -+ flag_alias_check = 1; - } - -diff -rcp2N gcc-2.7.2.2/unroll.c gcc-2.7.2.2.f.2/unroll.c -*** gcc-2.7.2.2/unroll.c Sat Aug 19 17:33:26 1995 ---- gcc-2.7.2.2.f.2/unroll.c Fri Jan 10 23:18:24 1997 -*************** unroll_loop (loop_end, insn_count, loop_ -*** 995,1000 **** - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) -! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); -! - /* The last copy needs the compare/branch insns at the end, - so reset copy_end here if the loop ends with a conditional ---- 995,1003 ---- - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) -! { -! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); -! record_base_value (REGNO (map->reg_map[j]), -! regno_reg_rtx[j]); -! } - /* The last copy needs the compare/branch insns at the end, - so reset copy_end here if the loop ends with a conditional -*************** unroll_loop (loop_end, insn_count, loop_ -*** 1136,1140 **** - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) -! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); - - /* If loop starts with a branch to the test, then fix it so that ---- 1139,1147 ---- - for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++) - if (local_regno[j]) -! { -! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j])); -! record_base_value (REGNO (map->reg_map[j]), -! regno_reg_rtx[j]); -! } - - /* If loop starts with a branch to the test, then fix it so that -*************** copy_loop_body (copy_start, copy_end, ma -*** 1631,1635 **** - incrementing the shared pseudo reg more than - once. */ -! if (! tv->same_insn) - { - /* tv->dest_reg may actually be a (PLUS (REG) ---- 1638,1642 ---- - incrementing the shared pseudo reg more than - once. */ -! if (! tv->same_insn && ! tv->shared) - { - /* tv->dest_reg may actually be a (PLUS (REG) -*************** copy_loop_body (copy_start, copy_end, ma -*** 1757,1760 **** ---- 1764,1768 ---- - giv_dest_reg = tem; - map->reg_map[regno] = tem; -+ record_base_value (REGNO (tem), giv_src_reg); - } - else -*************** find_splittable_regs (unroll_type, loop_ -*** 2443,2447 **** - { - rtx tem = gen_reg_rtx (bl->biv->mode); -! - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); ---- 2451,2456 ---- - { - rtx tem = gen_reg_rtx (bl->biv->mode); -! -! record_base_value (REGNO (tem), bl->biv->add_val); - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); -*************** find_splittable_regs (unroll_type, loop_ -*** 2500,2503 **** ---- 2509,2514 ---- - exits. */ - rtx tem = gen_reg_rtx (bl->biv->mode); -+ record_base_value (REGNO (tem), bl->biv->add_val); -+ - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); -*************** find_splittable_givs (bl, unroll_type, l -*** 2675,2678 **** ---- 2686,2690 ---- - rtx tem = gen_reg_rtx (bl->biv->mode); - -+ record_base_value (REGNO (tem), bl->biv->add_val); - emit_insn_before (gen_move_insn (tem, bl->biv->src_reg), - loop_start); -*************** find_splittable_givs (bl, unroll_type, l -*** 2716,2719 **** ---- 2728,2732 ---- - { - rtx tem = gen_reg_rtx (v->mode); -+ record_base_value (REGNO (tem), v->add_val); - emit_iv_add_mult (bl->initial_value, v->mult_val, - v->add_val, tem, loop_start); -*************** find_splittable_givs (bl, unroll_type, l -*** 2734,2747 **** - register for the split addr giv, just to be safe. */ - -! /* ??? If there are multiple address givs which have been -! combined with the same dest_reg giv, then we may only need -! one new register for them. Pulling out constants below will -! catch some of the common cases of this. Currently, I leave -! the work of simplifying multiple address givs to the -! following cse pass. */ -! -! /* As a special case, if we have multiple identical address givs -! within a single instruction, then we do use a single pseudo -! reg for both. This is necessary in case one is a match_dup - of the other. */ - ---- 2747,2753 ---- - register for the split addr giv, just to be safe. */ - -! /* If we have multiple identical address givs within a -! single instruction, then use a single pseudo reg for -! both. This is necessary in case one is a match_dup - of the other. */ - -*************** find_splittable_givs (bl, unroll_type, l -*** 2756,2759 **** ---- 2762,2776 ---- - INSN_UID (v->insn)); - } -+ /* If multiple address GIVs have been combined with the -+ same dest_reg GIV, do not create a new register for -+ each. */ -+ else if (unroll_type != UNROLL_COMPLETELY -+ && v->giv_type == DEST_ADDR -+ && v->same && v->same->giv_type == DEST_ADDR -+ && v->same->unrolled) -+ { -+ v->dest_reg = v->same->dest_reg; -+ v->shared = 1; -+ } - else if (unroll_type != UNROLL_COMPLETELY) - { -*************** find_splittable_givs (bl, unroll_type, l -*** 2761,2765 **** - register to hold the split value of the DEST_ADDR giv. - Emit insn to initialize its value before loop start. */ -! tem = gen_reg_rtx (v->mode); - - /* If the address giv has a constant in its new_reg value, ---- 2778,2785 ---- - register to hold the split value of the DEST_ADDR giv. - Emit insn to initialize its value before loop start. */ -! -! rtx tem = gen_reg_rtx (v->mode); -! record_base_value (REGNO (tem), v->add_val); -! v->unrolled = 1; - - /* If the address giv has a constant in its new_reg value, -*************** find_splittable_givs (bl, unroll_type, l -*** 2772,2776 **** - v->dest_reg - = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); -! - /* Only succeed if this will give valid addresses. - Try to validate both the first and the last ---- 2792,2796 ---- - v->dest_reg - = plus_constant (tem, INTVAL (XEXP (v->new_reg,1))); -! - /* Only succeed if this will give valid addresses. - Try to validate both the first and the last -*************** final_biv_value (bl, loop_start, loop_en -*** 3061,3064 **** ---- 3081,3085 ---- - - tem = gen_reg_rtx (bl->biv->mode); -+ record_base_value (REGNO (tem), bl->biv->add_val); - /* Make sure loop_end is not the last insn. */ - if (NEXT_INSN (loop_end) == 0) -*************** final_giv_value (v, loop_start, loop_end -*** 3154,3157 **** ---- 3175,3179 ---- - /* Put the final biv value in tem. */ - tem = gen_reg_rtx (bl->biv->mode); -+ record_base_value (REGNO (tem), bl->biv->add_val); - emit_iv_add_mult (increment, GEN_INT (loop_n_iterations), - bl->initial_value, tem, insert_before); -diff -rcp2N gcc-2.7.2.2/version.c gcc-2.7.2.2.f.2/version.c -*** gcc-2.7.2.2/version.c Thu Feb 20 19:24:33 1997 ---- gcc-2.7.2.2.f.2/version.c Sun Feb 23 16:30:36 1997 -*************** -*** 1 **** -! char *version_string = "2.7.2.2"; ---- 1 ---- -! char *version_string = "2.7.2.2.f.2"; diff --git a/gnu/usr.bin/gcc/f/intdoc.c b/gnu/usr.bin/gcc/f/intdoc.c deleted file mode 100644 index 478f3e0779e..00000000000 --- a/gnu/usr.bin/gcc/f/intdoc.c +++ /dev/null @@ -1,1248 +0,0 @@ -/* intdoc.c - Copyright (C) 1997 Free Software Foundation, Inc. - Contributed by James Craig Burley (burley@gnu.ai.mit.edu). - -This file is part of GNU Fortran. - -GNU Fortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -GNU Fortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Fortran; see the file COPYING. If not, write to -the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. */ - -#include "proj.h" -#define FFEINTRIN_DOC 1 -#include "intrin.h" - -char *family_name (ffeintrinFamily family); -static void dumpif (ffeintrinFamily fam); -static void dumpendif (void); -static void dumpclearif (void); -static void dumpem (void); -static void dumpgen (int menu, char *name, char *name_uc, - ffeintrinGen gen); -static void dumpspec (int menu, char *name, char *name_uc, - ffeintrinSpec spec); -static void dumpimp (int menu, char *name, char *name_uc, - size_t genno, ffeintrinFamily family, ffeintrinImp imp); -static char *argument_info_ptr (ffeintrinImp imp, int argno); -static char *argument_info_string (ffeintrinImp imp, int argno); -static char *argument_name_ptr (ffeintrinImp imp, int argno); -static char *argument_name_string (ffeintrinImp imp, int argno); -#if 0 -static char *elaborate_if_complex (ffeintrinImp imp, int argno); -static char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno); -static char *elaborate_if_real (ffeintrinImp imp, int argno); -#endif -static void print_type_string (char *c); - -int -main (int argc, char **argv __attribute__ ((unused))) -{ - if (argc != 1) - { - fprintf (stderr, "\ -Usage: intdoc > intdoc.texi - Collects and dumps documentation on g77 intrinsics - to the file named intdoc.texi.\n"); - exit (1); - } - - dumpem (); - return 0; -} - -struct _ffeintrin_name_ - { - char *name_uc; - char *name_lc; - char *name_ic; - ffeintrinGen generic; - ffeintrinSpec specific; - }; - -struct _ffeintrin_gen_ - { - char *name; /* Name as seen in program. */ - ffeintrinSpec specs[2]; - }; - -struct _ffeintrin_spec_ - { - char *name; /* Uppercase name as seen in source code, - lowercase if no source name, "none" if no - name at all (NONE case). */ - bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */ - ffeintrinFamily family; - ffeintrinImp implementation; - }; - -struct _ffeintrin_imp_ - { - char *name; /* Name of implementation. */ - ffeintrinImp cg_imp; /* Unique code-generation code. */ -#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ - ffecomGfrt gfrt; /* gfrt index in library. */ -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ - char *control; - }; - -static struct _ffeintrin_name_ names[] = { -#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \ - { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC }, -#define DEFGEN(CODE,NAME,SPEC1,SPEC2) -#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) -#define DEFIMP(CODE,NAME,GFRT,CONTROL) -#define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) -#include "intrin.def" -#undef DEFNAME -#undef DEFGEN -#undef DEFSPEC -#undef DEFIMP -#undef DEFIMQ -}; - -static struct _ffeintrin_gen_ gens[] = { -#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) -#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \ - { NAME, { SPEC1, SPEC2, }, }, -#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) -#define DEFIMP(CODE,NAME,GFRT,CONTROL) -#define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) -#include "intrin.def" -#undef DEFNAME -#undef DEFGEN -#undef DEFSPEC -#undef DEFIMP -#undef DEFIMQ -}; - -static struct _ffeintrin_imp_ imps[] = { -#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) -#define DEFGEN(CODE,NAME,SPEC1,SPEC2) -#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) -#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */ -#define DEFIMP(CODE,NAME,GFRT,CONTROL) \ - { NAME, FFEINTRIN_imp ## CODE, FFECOM_gfrt ## GFRT, CONTROL }, -#define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ - { NAME, FFEINTRIN_imp ## CGIMP, FFECOM_gfrt ## GFRT, CONTROL }, -#elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */ -#define DEFIMP(CODE,NAME,GFRT,CONTROL) \ - { NAME, FFEINTRIN_imp ## CODE, CONTROL }, -#define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) \ - { NAME, FFEINTRIN_imp ## CGIMP, CONTROL }, -#else -#error -#endif -#include "intrin.def" -#undef DEFNAME -#undef DEFGEN -#undef DEFSPEC -#undef DEFIMP -#undef DEFIMQ -}; - -static struct _ffeintrin_spec_ specs[] = { -#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) -#define DEFGEN(CODE,NAME,SPEC1,SPEC2) -#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \ - { NAME, CALLABLE, FAMILY, IMP, }, -#define DEFIMP(CODE,NAME,GFRT,CONTROL) -#define DEFIMQ(CODE,NAME,GFRT,CONTROL,CGIMP) -#include "intrin.def" -#undef DEFGEN -#undef DEFSPEC -#undef DEFIMP -#undef DEFIMQ -}; - -static char *descriptions[FFEINTRIN_imp] = { -#define DEFDOC(IMP,SUMMARY,DESCRIPTION) [FFEINTRIN_imp ## IMP] DESCRIPTION, -#include "intdoc.h" -#undef DEFDOC -}; - -static char *summaries[FFEINTRIN_imp] = { -#define DEFDOC(IMP,SUMMARY,DESCRIPTION) [FFEINTRIN_imp ## IMP] SUMMARY, -#include "intdoc.h" -#undef DEFDOC -}; - -char * -family_name (ffeintrinFamily family) -{ - switch (family) - { - case FFEINTRIN_familyF77: - return "familyF77"; - - case FFEINTRIN_familyASC: - return "familyASC"; - - case FFEINTRIN_familyMIL: - return "familyMIL"; - - case FFEINTRIN_familyGNU: - return "familyGNU"; - - case FFEINTRIN_familyF90: - return "familyF90"; - - case FFEINTRIN_familyVXT: - return "familyVXT"; - - case FFEINTRIN_familyFVZ: - return "familyFVZ"; - - case FFEINTRIN_familyF2C: - return "familyF2C"; - - case FFEINTRIN_familyF2U: - return "familyF2U"; - - default: - assert ("bad family" == NULL); - return "??"; - } -} - -static int in_ifset = 0; -static ffeintrinFamily latest_family = FFEINTRIN_familyNONE; - -static void -dumpif (ffeintrinFamily fam) -{ - assert (fam != FFEINTRIN_familyNONE); - if ((in_ifset != 2) - || (fam != latest_family)) - { - if (in_ifset == 2) - printf ("@end ifset\n"); - latest_family = fam; - printf ("@ifset %s\n", family_name (fam)); - } - in_ifset = 1; -} - -static void -dumpendif () -{ - in_ifset = 2; -} - -static void -dumpclearif () -{ - if ((in_ifset == 2) - || (latest_family != FFEINTRIN_familyNONE)) - printf ("@end ifset\n"); - latest_family = FFEINTRIN_familyNONE; - in_ifset = 0; -} - -static void -dumpem () -{ - int i; - - printf ("@menu\n"); - for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i) - { - if (names[i].generic != FFEINTRIN_genNONE) - dumpgen (1, names[i].name_ic, names[i].name_uc, - names[i].generic); - if (names[i].specific != FFEINTRIN_specNONE) - dumpspec (1, names[i].name_ic, names[i].name_uc, - names[i].specific); - } - dumpclearif (); - - printf ("@end menu\n\n"); - - for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i) - { - if (names[i].generic != FFEINTRIN_genNONE) - dumpgen (0, names[i].name_ic, names[i].name_uc, - names[i].generic); - if (names[i].specific != FFEINTRIN_specNONE) - dumpspec (0, names[i].name_ic, names[i].name_uc, - names[i].specific); - } - dumpclearif (); -} - -static void -dumpgen (int menu, char *name, char *name_uc, ffeintrinGen gen) -{ - size_t i; - - for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i) - { - ffeintrinSpec spec; - - if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE) - continue; - - if (specs[spec].implementation == FFEINTRIN_impNONE) - continue; - - dumpif (specs[spec].family); - dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation); - dumpendif (); - } -} - -static void -dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec) -{ - if (specs[spec].implementation == FFEINTRIN_impNONE) - return; - - dumpif (specs[spec].family); - dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation); - dumpendif (); -} - -static void -dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp) -{ - char *c = imps[imp].control; - bool subr = (c[0] == '-'); - char *argc; - char *argi; - int colon = (c[2] == ':') ? 2 : 3; - int argno; - - if (menu) - { - printf ("* %s Intrinsic", - name); - if (genno) - printf (" (Form %s)", imps[imp].name); - printf ("::"); - if (summaries[imp] != NULL) - { -#define INDENT_SUMMARY 24 - int spaces = INDENT_SUMMARY - 14 - strlen (name); - char *c = summaries[imp]; - - if (genno != 0) - spaces -= (8 + strlen (imps[imp].name)); - if (spaces < 1) - spaces = 1; - while (spaces--) - fputc (' ', stdout); - - while (c[0] != '\0') - { - if ((c[0] == '@') - && (c[1] >= '0') - && (c[1] <= '9')) - { - int argno = c[1] - '0'; - - c += 2; - while ((c[0] >= '0') - && (c[0] <= '9')) - { - argno = 10 * argno + (c[0] - '0'); - ++c; - } - assert (c[0] == '@'); - if (argno == 0) - printf ("%s", name); - else if (argno == 99) - { /* Yeah, this is a major kludge. */ - printf ("\n"); - spaces = INDENT_SUMMARY + 1; - while (spaces--) - fputc (' ', stdout); - } - else - printf ("%s", argument_name_string (imp, argno - 1)); - } - else - fputc (c[0], stdout); - ++c; - } - } - printf ("\n"); - return; - } - - printf ("@node %s Intrinsic", name); - if (genno) - printf (" (Form %s)", imps[imp].name); - printf ("\n@subsubsection %s Intrinsic", name); - if (genno) - printf (" (Form %s)", imps[imp].name); - printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n -@noindent -@example -%s%s(", - name, name, (subr ? "CALL " : ""), name); - - fflush (stdout); - - for (argno = 0; ; ++argno) - { - argc = argument_name_ptr (imp, argno); - if (argc == NULL) - break; - if (argno > 0) - printf (", "); - printf ("@var{%s}", argc); - argi = argument_info_string (imp, argno); - if ((argi[0] == '*') - || (argi[0] == 'n') - || (argi[0] == '+') - || (argi[0] == 'p')) - printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n", - argc, argc); - } - - printf (") -@end example\n -"); - - if (!subr) - { - int other_arg; - char *arg_string; - char *arg_info; - - if ((c[colon + 1] >= '0') - && (c[colon + 1] <= '9')) - { - other_arg = c[colon + 1] - '0'; - arg_string = argument_name_string (imp, other_arg); - arg_info = argument_info_string (imp, other_arg); - } - else - { - other_arg = -1; - arg_string = NULL; - arg_info = NULL; - } - - printf ("\ -@noindent -%s: ", name); - print_type_string (c); - printf (" function"); - - if ((c[0] == 'R') - && (c[1] == 'C')) - { - assert (other_arg >= 0); - - if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+') - || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p')) - ++arg_info; - if ((arg_info[0] == 'F') || (arg_info[0] == 'N')) - printf (". -The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is -any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}. -When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}, -this intrinsic is valid only when used as the argument to -@code{REAL()}, as explained below.\n\n", - arg_string, - arg_string); - else - printf (". -This intrinsic is valid when argument @var{%s} is -@code{COMPLEX(KIND=1)}. -When @var{%s} is any other @code{COMPLEX} type, -this intrinsic is valid only when used as the argument to -@code{REAL()}, as explained below.\n\n", - arg_string, - arg_string); - } -#if 0 - else if ((c[0] == 'I') - && (c[1] == 'p')) - printf (", the exact type being wide enough to hold a pointer -on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n"); -#endif - else if ((c[1] == '=') - && (c[colon + 1] >= '0') - && (c[colon + 1] <= '9')) - { - assert (other_arg >= 0); - - if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+') - || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p')) - ++arg_info; - - if (((c[0] == arg_info[0]) - && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I') - || (c[0] == 'L') || (c[0] == 'R'))) - || ((c[0] == 'R') - && (arg_info[0] == 'C')) - || ((c[0] == 'C') - && (arg_info[0] == 'R'))) - printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n", - arg_string); - else if ((c[0] == 'S') - && ((arg_info[0] == 'C') - || (arg_info[0] == 'F') - || (arg_info[0] == 'N'))) - printf (". -The exact type depends on that of argument @var{%s}---if @var{%s} is -@code{COMPLEX}, this function's type is @code{REAL} -with the same @samp{KIND=} value as the type of @var{%s}. -Otherwise, this function's type is the same as that of @var{%s}.\n\n", - arg_string, arg_string, arg_string, arg_string); - else - printf (", the exact type being that of argument @var{%s}.\n\n", - arg_string); - } - else if ((c[1] == '=') - && (c[colon + 1] == '*')) - printf (", the exact type being the result of cross-promoting the -types of all the arguments.\n\n"); - else if (c[1] == '=') - assert ("?0:?:" == NULL); - else - printf (".\n\n"); - } - - for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno) - { - char optionality = '\0'; - char extra = '\0'; - char basic; - char kind; - int length; - int elements; - - printf ("\ -@noindent -@var{"); - for (; ; ++argc) - { - if (argc[0] == '=') - break; - printf ("%c", *argc); - } - printf ("}: "); - - ++argc; - if ((*argc == '?') - || (*argc == '!') - || (*argc == '*') - || (*argc == '+') - || (*argc == 'n') - || (*argc == 'p')) - optionality = *(argc++); - basic = *(argc++); - kind = *(argc++); - if (*argc == '[') - { - length = *++argc - '0'; - if (*++argc != ']') - length = 10 * length + (*(argc++) - '0'); - ++argc; - } - else - length = -1; - if (*argc == '(') - { - elements = *++argc - '0'; - if (*++argc != ')') - elements = 10 * elements + (*(argc++) - '0'); - ++argc; - } - else if (*argc == '&') - { - elements = -1; - ++argc; - } - else - elements = 0; - if ((*argc == '&') - || (*argc == 'i') - || (*argc == 'w') - || (*argc == 'x')) - extra = *(argc++); - if (*argc == ',') - ++argc; - - switch (basic) - { - case '-': - switch (kind) - { - case '*': - printf ("Any type"); - break; - - default: - assert ("kind arg" == NULL); - break; - } - break; - - case 'A': - assert ((kind == '1') || (kind == '*')); - printf ("@code{CHARACTER"); - if (length != -1) - printf ("*%d", length); - printf ("}"); - break; - - case 'C': - switch (kind) - { - case '*': - printf ("@code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{COMPLEX(KIND=%d)}", (kind - '0')); - break; - - case 'A': - printf ("Same @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("Ca" == NULL); - break; - } - break; - - case 'I': - switch (kind) - { - case '*': - printf ("@code{INTEGER}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)}", (kind - '0')); - break; - - case 'A': - printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - case 'p': - printf ("@code{INTEGER} wide enough to hold a pointer"); - break; - - default: - assert ("Ia" == NULL); - break; - } - break; - - case 'L': - switch (kind) - { - case '*': - printf ("@code{LOGICAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{LOGICAL(KIND=%d)}", (kind - '0')); - break; - - case 'A': - printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("La" == NULL); - break; - } - break; - - case 'R': - switch (kind) - { - case '*': - printf ("@code{REAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{REAL(KIND=%d)}", (kind - '0')); - break; - - case 'A': - printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("Ra" == NULL); - break; - } - break; - - case 'B': - switch (kind) - { - case '*': - printf ("@code{INTEGER} or @code{LOGICAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - case 'A': - printf ("Same type and @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("Ba" == NULL); - break; - } - break; - - case 'F': - switch (kind) - { - case '*': - printf ("@code{REAL} or @code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - case 'A': - printf ("Same type as @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("Fa" == NULL); - break; - } - break; - - case 'N': - switch (kind) - { - case '*': - printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}", - (kind - '0'), (kind - '0'), (kind - '0')); - break; - - default: - assert ("N1" == NULL); - break; - } - break; - - case 'S': - switch (kind) - { - case '*': - printf ("@code{INTEGER} or @code{REAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - case 'A': - printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}", - argument_name_string (imp, 0)); - break; - - default: - assert ("Sa" == NULL); - break; - } - break; - - case 'g': - printf ("@samp{*@var{label}}, where @var{label} is the label -of an executable statement"); - break; - - case 's': - printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE}) -or dummy/global @code{INTEGER(KIND=1)} scalar"); - break; - - default: - assert ("arg type?" == NULL); - break; - } - - switch (optionality) - { - case '\0': - break; - - case '!': - printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})", - argument_name_string (imp, argno-1)); - break; - - case '?': - printf ("; OPTIONAL"); - break; - - case '*': - printf ("; OPTIONAL"); - break; - - case 'n': - case '+': - break; - - case 'p': - printf ("; at least two such arguments must be provided"); - break; - - default: - assert ("optionality!" == NULL); - break; - } - - switch (elements) - { - case -1: - break; - - case 0: - if ((basic != 'g') - && (basic != 's')) - printf ("; scalar"); - break; - - default: - assert (extra != '\0'); - printf ("; DIMENSION(%d)", elements); - break; - } - - switch (extra) - { - case '\0': - if ((basic != 'g') - && (basic != 's')) - printf ("; INTENT(IN)"); - break; - - case 'i': - break; - - case '&': - printf ("; cannot be a constant or expression"); - break; - - case 'w': - printf ("; INTENT(OUT)"); - break; - - case 'x': - printf ("; INTENT(INOUT)"); - break; - } - - printf (".\n\n"); - } - - printf ("\ -@noindent -Intrinsic groups: "); - switch (family) - { - case FFEINTRIN_familyF77: - printf ("(standard FORTRAN 77)."); - break; - - case FFEINTRIN_familyGNU: - printf ("@code{gnu}."); - break; - - case FFEINTRIN_familyASC: - printf ("@code{f2c}, @code{f90}."); - break; - - case FFEINTRIN_familyMIL: - printf ("@code{mil}, @code{f90}, @code{vxt}."); - break; - - case FFEINTRIN_familyF90: - printf ("@code{f90}."); - break; - - case FFEINTRIN_familyVXT: - printf ("@code{vxt}."); - break; - - case FFEINTRIN_familyFVZ: - printf ("@code{f2c}, @code{vxt}."); - break; - - case FFEINTRIN_familyF2C: - printf ("@code{f2c}."); - break; - - case FFEINTRIN_familyF2U: - printf ("@code{unix}."); - break; - - default: - assert ("bad family" == NULL); - printf ("@code{???}."); - break; - } - printf ("\n\n"); - - if (descriptions[imp] != NULL) - { - char *c = descriptions[imp]; - - printf ("\ -@noindent -Description: -\n"); - - while (c[0] != '\0') - { - if ((c[0] == '@') - && (c[1] >= '0') - && (c[1] <= '9')) - { - int argno = c[1] - '0'; - - c += 2; - while ((c[0] >= '0') - && (c[0] <= '9')) - { - argno = 10 * argno + (c[0] - '0'); - ++c; - } - assert (c[0] == '@'); - if (argno == 0) - printf ("%s", name_uc); - else - printf ("%s", argument_name_string (imp, argno - 1)); - } - else - fputc (c[0], stdout); - ++c; - } - - printf ("\n"); - } -} - -static char * -argument_info_ptr (ffeintrinImp imp, int argno) -{ - char *c = imps[imp].control; - static char arginfos[8][32]; - static int argx = 0; - int i; - - if (c[2] == ':') - c += 5; - else - c += 6; - - while (argno--) - { - while ((c[0] != ',') && (c[0] != '\0')) - ++c; - if (c[0] != ',') - break; - ++c; - } - - if (c[0] == '\0') - return NULL; - - for (; (c[0] != '=') && (c[0] != '\0'); ++c) - ; - - assert (c[0] == '='); - - for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i) - arginfos[argx][i] = c[0]; - - arginfos[argx][i] = '\0'; - - c = &arginfos[argx][0]; - ++argx; - if (((size_t) argx) >= ARRAY_SIZE (arginfos)) - argx = 0; - - return c; -} - -static char * -argument_info_string (ffeintrinImp imp, int argno) -{ - char *p; - - p = argument_info_ptr (imp, argno); - assert (p != NULL); - return p; -} - -static char * -argument_name_ptr (ffeintrinImp imp, int argno) -{ - char *c = imps[imp].control; - static char argnames[8][32]; - static int argx = 0; - int i; - - if (c[2] == ':') - c += 5; - else - c += 6; - - while (argno--) - { - while ((c[0] != ',') && (c[0] != '\0')) - ++c; - if (c[0] != ',') - break; - ++c; - } - - if (c[0] == '\0') - return NULL; - - for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i) - argnames[argx][i] = c[0]; - - assert (c[0] == '='); - argnames[argx][i] = '\0'; - - c = &argnames[argx][0]; - ++argx; - if (((size_t) argx) >= ARRAY_SIZE (argnames)) - argx = 0; - - return c; -} - -static char * -argument_name_string (ffeintrinImp imp, int argno) -{ - char *p; - - p = argument_name_ptr (imp, argno); - assert (p != NULL); - return p; -} - -static void -print_type_string (char *c) -{ - char basic = c[0]; - char kind = c[1]; - - switch (basic) - { - case 'A': - assert ((kind == '1') || (kind == '=')); - if (c[2] == ':') - printf ("@code{CHARACTER*1}"); - else - { - assert (c[2] == '*'); - printf ("@code{CHARACTER*(*)}"); - } - break; - - case 'C': - switch (kind) - { - case '=': - printf ("@code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{COMPLEX(KIND=%d)}", (kind - '0')); - break; - - default: - assert ("Ca" == NULL); - break; - } - break; - - case 'I': - switch (kind) - { - case '=': - printf ("@code{INTEGER}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)}", (kind - '0')); - break; - - case 'p': - printf ("@code{INTEGER(KIND=0)}"); - break; - - default: - assert ("Ia" == NULL); - break; - } - break; - - case 'L': - switch (kind) - { - case '=': - printf ("@code{LOGICAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{LOGICAL(KIND=%d)}", (kind - '0')); - break; - - default: - assert ("La" == NULL); - break; - } - break; - - case 'R': - switch (kind) - { - case '=': - printf ("@code{REAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{REAL(KIND=%d)}", (kind - '0')); - break; - - case 'C': - printf ("@code{REAL}"); - break; - - default: - assert ("Ra" == NULL); - break; - } - break; - - case 'B': - switch (kind) - { - case '=': - printf ("@code{INTEGER} or @code{LOGICAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - default: - assert ("Ba" == NULL); - break; - } - break; - - case 'F': - switch (kind) - { - case '=': - printf ("@code{REAL} or @code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - default: - assert ("Fa" == NULL); - break; - } - break; - - case 'N': - switch (kind) - { - case '=': - printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}", - (kind - '0'), (kind - '0'), (kind - '0')); - break; - - default: - assert ("N1" == NULL); - break; - } - break; - - case 'S': - switch (kind) - { - case '=': - printf ("@code{INTEGER} or @code{REAL}"); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}", - (kind - '0'), (kind - '0')); - break; - - default: - assert ("Sa" == NULL); - break; - } - break; - - default: - assert ("arg type?" == NULL); - break; - } -} diff --git a/gnu/usr.bin/gcc/f/intdoc.h b/gnu/usr.bin/gcc/f/intdoc.h deleted file mode 100644 index aa14419ab62..00000000000 --- a/gnu/usr.bin/gcc/f/intdoc.h +++ /dev/null @@ -1,1297 +0,0 @@ -/* Copyright (C) 1997 Free Software Foundation, Inc. - * This is part of the G77 manual. - * For copying conditions, see the file g77.texi. */ - -/* This is the file containing the verbage for the - intrinsics. It consists of a data base built up - via DEFDOC macros of the form: - - DEFDOC (IMP, SUMMARY, DESCRIPTION) - - IMP is the implementation keyword used in the intrin module. - SUMMARY is the short summary to go in the "* Menu:" section - of the Info document. DESCRIPTION is the longer description - to go in the documentation itself. - - Note that IMP is leveraged across multiple intrinsic names. - - To make for more accurate and consistent documentation, - the translation made by intdoc.c of the text in SUMMARY - and DESCRIPTION includes the special sequence - - @ARGNO@ - - where ARGNO is a series of digits forming a number that - is substituted by intdoc.c as follows: - - 0 The initial-caps form of the intrinsic name (e.g. Float). - 1-98 The initial-caps form of the ARGNO'th argument. - 99 (SUMMARY only) a newline plus the appropriate # of spaces. - - Hope this info is enough to encourage people to feel free to - add documentation to this file! - -*/ - -DEFDOC (ABS, "Absolute value.", "\ -Returns the absolute value of @var{@1@}. - -If @var{@1@} is type @code{COMPLEX}, the absolute -value is computed as: - -@example -SQRT(REALPART(@var{@1@})**2, IMAGPART(@var{@1@})**2) -@end example - -@noindent -Otherwise, it is computed by negating the @var{@1@} if -it is negative, or returning @var{@1@}. - -@xref{Sign Intrinsic}, for how to explicitly -compute the positive or negative form of the absolute -value of an expression. -") - -DEFDOC (CABS, "Absolute value (archaic).", "\ -Archaic form of @code{ABS()} that is specific -to one type for @var{@1@}. -@xref{Abs Intrinsic}. -") - -DEFDOC (DABS, "Absolute value (archaic).", "\ -Archaic form of @code{ABS()} that is specific -to one type for @var{@1@}. -@xref{Abs Intrinsic}. -") - -DEFDOC (IABS, "Absolute value (archaic).", "\ -Archaic form of @code{ABS()} that is specific -to one type for @var{@1@}. -@xref{Abs Intrinsic}. -") - -DEFDOC (CDABS, "Absolute value (archaic).", "\ -Archaic form of @code{ABS()} that is specific -to one type for @var{@1@}. -@xref{Abs Intrinsic}. -") - -DEFDOC (ACHAR, "ASCII character from code.", "\ -Returns the ASCII character corresponding to the -code specified by @var{@1@}. - -@xref{IAChar Intrinsic}, for the inverse function. - -@xref{Char Intrinsic}, for the function corresponding -to the system's native character set. -") - -DEFDOC (IACHAR, "ASCII code for character.", "\ -Returns the code for the ASCII character in the -first character position of @var{@1@}. - -@xref{AChar Intrinsic}, for the inverse function. - -@xref{IChar Intrinsic}, for the function corresponding -to the system's native character set. -") - -DEFDOC (CHAR, "Character from code.", "\ -Returns the character corresponding to the -code specified by @var{@1@}, using the system's -native character set. - -Because the system's native character set is used, -the correspondence between character and their codes -is not necessarily the same between GNU Fortran -implementations. - -@xref{IChar Intrinsic}, for the inverse function. - -@xref{AChar Intrinsic}, for the function corresponding -to the ASCII character set. -") - -DEFDOC (ICHAR, "Code for character.", "\ -Returns the code for the character in the -first character position of @var{@1@}. - -Because the system's native character set is used, -the correspondence between character and their codes -is not necessarily the same between GNU Fortran -implementations. - -@xref{Char Intrinsic}, for the inverse function. - -@xref{IAChar Intrinsic}, for the function corresponding -to the ASCII character set. -") - -DEFDOC (ACOS, "Arc cosine.", "\ -Returns the arc-cosine (inverse cosine) of @var{@1@} -in radians. - -@xref{Cos Intrinsic}, for the inverse function. -") - -DEFDOC (DACOS, "Arc cosine (archaic).", "\ -Archaic form of @code{ACOS()} that is specific -to one type for @var{@1@}. -@xref{ACos Intrinsic}. -") - -DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\ -Returns the (possibly converted) imaginary part of @var{@1@}. - -Use of @code{@0@()} with an argument of a type -other than @code{COMPLEX(KIND=1)} is restricted to the following case: - -@example -REAL(AIMAG(@1@)) -@end example - -@noindent -This expression converts the imaginary part of @1@ to -@code{REAL(KIND=1)}. - -@xref{REAL() and AIMAG() of Complex}, for more information. -") - -DEFDOC (AINT, "Truncate to whole number.", "\ -Returns @var{@1@} with the fractional portion of its -magnitude truncated and its sign preserved. -(Also called ``truncation towards zero''.) - -@xref{ANInt Intrinsic}, for how to round to nearest -whole number. - -@xref{Int Intrinsic}, for how to truncate and then convert -number to @code{INTEGER}. -") - -DEFDOC (DINT, "Truncate to whole number (archaic).", "\ -Archaic form of @code{AINT()} that is specific -to one type for @var{@1@}. -@xref{AInt Intrinsic}. -") - -DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\ -Returns @var{@1@} with the fractional portion of its -magnitude truncated and its sign preserved, converted -to type @code{INTEGER(KIND=1)}. - -If @var{@1@} is type @code{COMPLEX}, its real part is -truncated and converted. - -@xref{NInt Intrinsic}, for how to convert, rounded to nearest -whole number. - -@xref{AInt Intrinsic}, for how to truncate to whole number -without converting. -") - -DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", "\ -Archaic form of @code{INT()} that is specific -to one type for @var{@1@}. -@xref{Int Intrinsic}. -") - -DEFDOC (ANINT, "Round to nearest whole number.", "\ -Returns @var{@1@} with the fractional portion of its -magnitude eliminated by rounding to the nearest whole -number and with its sign preserved. - -A fractional portion exactly equal to -@samp{.5} is rounded to the whole number that -is larger in magnitude. -(Also called ``Fortran round''.) - -@xref{AInt Intrinsic}, for how to truncate to -whole number. - -@xref{NInt Intrinsic}, for how to round and then convert -number to @code{INTEGER}. -") - -DEFDOC (DNINT, "Round to nearest whole number (archaic).", "\ -Archaic form of @code{ANINT()} that is specific -to one type for @var{@1@}. -@xref{ANInt Intrinsic}. -") - -DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\ -Returns @var{@1@} with the fractional portion of its -magnitude eliminated by rounding to the nearest whole -number and with its sign preserved, converted -to type @code{INTEGER(KIND=1)}. - -If @var{@1@} is type @code{COMPLEX}, its real part is -rounded and converted. - -A fractional portion exactly equal to -@samp{.5} is rounded to the whole number that -is larger in magnitude. -(Also called ``Fortran round''.) - -@xref{Int Intrinsic}, for how to convert, truncate to -whole number. - -@xref{ANInt Intrinsic}, for how to round to nearest whole number -without converting. -") - -DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", "\ -Archaic form of @code{NINT()} that is specific -to one type for @var{@1@}. -@xref{NInt Intrinsic}. -") - -DEFDOC (LOG, "Natural logarithm.", "\ -Returns the natural logarithm of @var{@1@}, which must -be greater than zero or, if type @code{COMPLEX}, must not -be zero. - -@xref{Exp Intrinsic}, for the inverse function. - -@xref{Log10 Intrinsic}, for the base-10 logarithm function. -") - -DEFDOC (ALOG, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG()} that is specific -to one type for @var{@1@}. -@xref{Log Intrinsic}. -") - -DEFDOC (CLOG, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG()} that is specific -to one type for @var{@1@}. -@xref{Log Intrinsic}. -") - -DEFDOC (DLOG, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG()} that is specific -to one type for @var{@1@}. -@xref{Log Intrinsic}. -") - -DEFDOC (CDLOG, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG()} that is specific -to one type for @var{@1@}. -@xref{Log Intrinsic}. -") - -DEFDOC (LOG10, "Natural logarithm.", "\ -Returns the natural logarithm of @var{@1@}, which must -be greater than zero or, if type @code{COMPLEX}, must not -be zero. - -The inverse function is @samp{10. ** LOG10(@var{@1@})}. - -@xref{Log Intrinsic}, for the natural logarithm function. -") - -DEFDOC (ALOG10, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG10()} that is specific -to one type for @var{@1@}. -@xref{Log10 Intrinsic}. -") - -DEFDOC (DLOG10, "Natural logarithm (archaic).", "\ -Archaic form of @code{LOG10()} that is specific -to one type for @var{@1@}. -@xref{Log10 Intrinsic}. -") - -DEFDOC (MAX, "Maximum value.", "\ -Returns the argument with the largest value. - -@xref{Min Intrinsic}, for the opposite function. -") - -DEFDOC (AMAX0, "Maximum value (archaic).", "\ -Archaic form of @code{MAX()} that is specific -to one type for @var{@1@} and a different return type. -@xref{Max Intrinsic}. -") - -DEFDOC (AMAX1, "Maximum value (archaic).", "\ -Archaic form of @code{MAX()} that is specific -to one type for @var{@1@}. -@xref{Max Intrinsic}. -") - -DEFDOC (DMAX1, "Maximum value (archaic).", "\ -Archaic form of @code{MAX()} that is specific -to one type for @var{@1@}. -@xref{Max Intrinsic}. -") - -DEFDOC (MAX0, "Maximum value (archaic).", "\ -Archaic form of @code{MAX()} that is specific -to one type for @var{@1@}. -@xref{Max Intrinsic}. -") - -DEFDOC (MAX1, "Maximum value (archaic).", "\ -Archaic form of @code{MAX()} that is specific -to one type for @var{@1@} and a different return type. -@xref{Max Intrinsic}. -") - -DEFDOC (MIN, "Minimum value.", "\ -Returns the argument with the smallest value. - -@xref{Max Intrinsic}, for the opposite function. -") - -DEFDOC (AMIN0, "Minimum value (archaic).", "\ -Archaic form of @code{MIN()} that is specific -to one type for @var{@1@} and a different return type. -@xref{Min Intrinsic}. -") - -DEFDOC (AMIN1, "Minimum value (archaic).", "\ -Archaic form of @code{MIN()} that is specific -to one type for @var{@1@}. -@xref{Min Intrinsic}. -") - -DEFDOC (DMIN1, "Minimum value (archaic).", "\ -Archaic form of @code{MIN()} that is specific -to one type for @var{@1@}. -@xref{Min Intrinsic}. -") - -DEFDOC (MIN0, "Minimum value (archaic).", "\ -Archaic form of @code{MIN()} that is specific -to one type for @var{@1@}. -@xref{Min Intrinsic}. -") - -DEFDOC (MIN1, "Minimum value (archaic).", "\ -Archaic form of @code{MIN()} that is specific -to one type for @var{@1@} and a different return type. -@xref{Min Intrinsic}. -") - -DEFDOC (MOD, "Remainder.", "\ -Returns remainder calculated as: - -@smallexample -@var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@}) -@end smallexample - -@var{@2@} must not be zero. -") - -DEFDOC (AMOD, "Remainder (archaic).", "\ -Archaic form of @code{MOD()} that is specific -to one type for @var{@1@}. -@xref{Mod Intrinsic}. -") - -DEFDOC (DMOD, "Remainder (archaic).", "\ -Archaic form of @code{MOD()} that is specific -to one type for @var{@1@}. -@xref{Mod Intrinsic}. -") - -DEFDOC (AND, "Boolean AND.", "\ -Returns value resulting from boolean AND of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (IAND, "Boolean AND.", "\ -Returns value resulting from boolean AND of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (OR, "Boolean OR.", "\ -Returns value resulting from boolean OR of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (IOR, "Boolean OR.", "\ -Returns value resulting from boolean OR of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (XOR, "Boolean XOR.", "\ -Returns value resulting from boolean exclusive-OR of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (IEOR, "Boolean XOR.", "\ -Returns value resulting from boolean exclusive-OR of -pair of bits in each of @var{@1@} and @var{@2@}. -") - -DEFDOC (NOT, "Boolean NOT.", "\ -Returns value resulting from boolean NOT of each bit -in @var{@1@}. -") - -DEFDOC (ASIN, "Arc sine.", "\ -Returns the arc-sine (inverse sine) of @var{@1@} -in radians. - -@xref{Sin Intrinsic}, for the inverse function. -") - -DEFDOC (DASIN, "Arc sine (archaic).", "\ -Archaic form of @code{ASIN()} that is specific -to one type for @var{@1@}. -@xref{ASin Intrinsic}. -") - -DEFDOC (ATAN, "Arc tangent.", "\ -Returns the arc-tangent (inverse tangent) of @var{@1@} -in radians. - -@xref{Tan Intrinsic}, for the inverse function. -") - -DEFDOC (DATAN, "Arc tangent (archaic).", "\ -Archaic form of @code{ATAN()} that is specific -to one type for @var{@1@}. -@xref{ATan Intrinsic}. -") - -DEFDOC (ATAN2, "Arc tangent.", "\ -Returns the arc-tangent (inverse tangent) of the complex -number (@var{@1@}, @var{@2@}) in radians. - -@xref{Tan Intrinsic}, for the inverse function. -") - -DEFDOC (DATAN2, "Arc tangent (archaic).", "\ -Archaic form of @code{ATAN2()} that is specific -to one type for @var{@1@} and @var{@2@}. -@xref{ATan2 Intrinsic}. -") - -DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\ -Returns the number of bits (integer precision plus sign bit) -represented by the type for @var{@1@}. - -@xref{BTest Intrinsic}, for how to test the value of a -bit in a variable or array. - -@xref{IBSet Intrinsic}, for how to set a bit in a -variable or array to 1. -") - -DEFDOC (BTEST, "Test bit.", "\ -Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is -1, @code{.FALSE.} otherwise. - -(Bit 0 is the low-order bit, adding the value 2**0, or 1, -to the number if set to 1; -bit 1 is the next-higher-order bit, adding 2**1, or 2; -bit 2 adds 2**2, or 4; and so on.) - -@xref{Bit_Size Intrinsic}, for how to obtain the number of bits -in a type. -") - -DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\ -If @var{@1@} is not type @code{COMPLEX}, -constructs a value of type @code{COMPLEX(KIND=1)} from the -real and imaginary values specified by @var{@1@} and -@var{@2@}, respectively. -If @var{@2@} is omitted, @samp{0.} is assumed. - -If @var{@1@} is type @code{COMPLEX}, -converts it to type @code{COMPLEX(KIND=1)}. - -@xref{Complex Intrinsic}, for information on easily constructing -a @code{COMPLEX} value of arbitrary precision from @code{REAL} -arguments. -") - -DEFDOC (CONJG, "Complex conjugate.", "\ -Returns the complex conjugate: - -@example -COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@})) -@end example -") - -DEFDOC (DCONJG, "Complex conjugate (archaic).", "\ -Archaic form of @code{CONJG()} that is specific -to one type for @var{@1@}. -@xref{ATan2 Intrinsic}. -") - -/* ~~~~~ to do: - COS - COSH - SQRT - DBLE - DIM - ERF - DPROD - SIGN - EXP - FLOAT - IBCLR - IBITS - IBSET - IFIX - INDEX - ISHFT - ISHFTC - LEN - LGE - LONG - SHORT - LSHIFT - RSHIFT - MVBITS - SIN - SINH - SNGL - TAN - TANH -*/ - -DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\ -Converts @var{@1@} to @code{REAL(KIND=1)}. - -Use of @code{@0@()} with a @code{COMPLEX} argument -(other than @code{COMPLEX(KIND=1)}) is restricted to the following case: - -@example -REAL(REAL(@1@)) -@end example - -@noindent -This expression converts the real part of @1@ to -@code{REAL(KIND=1)}. - -@xref{REAL() and AIMAG() of Complex}, for more information. -") - -DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\ -The imaginary part of @var{@1@} is returned, without conversion. - -@emph{Note:} The way to do this in standard Fortran 90 -is @samp{AIMAG(@var{@1@})}. -However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX}, -@samp{AIMAG(@var{@1@})} means something different for some compilers -that are not true Fortran 90 compilers but offer some -extensions standardized by Fortran 90 (such as the -@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - -The advantage of @code{@0@()} is that, while not necessarily -more or less portable than @code{AIMAG()}, it is more likely to -cause a compiler that doesn't support it to produce a diagnostic -than generate incorrect code. - -@xref{REAL() and AIMAG() of Complex}, for more information. -") - -DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\ -Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its -real and imaginary parts, respectively. - -If @var{@1@} and @var{@2@} are the same type, and that type is not -@code{INTEGER}, no data conversion is performed, and the type of -the resulting value has the same kind value as the types -of @var{@1@} and @var{@2@}. - -If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion -rules are applied to both, converting either or both to the -appropriate @code{REAL} type. -The type of the resulting value has the same kind value as the -type to which both @var{@1@} and @var{@2@} were converted, in this case. - -If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted -to @code{REAL(KIND=1)}, and the result of the @code{@0@()} -invocation is type @code{COMPLEX(KIND=1)}. - -@emph{Note:} The way to do this in standard Fortran 90 -is too hairy to describe here, but it is important to -note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)} -result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}. -Hence the availability of @code{COMPLEX()} in GNU Fortran. -") - -DEFDOC (LOC, "Address of entity in core.", "\ -The @code{LOC()} intrinsic works the -same way as the @code{%LOC()} construct. -@xref{%LOC(),,The @code{%LOC()} Construct}, for -more information. -") - -DEFDOC (REALPART, "Extract real part of complex.", "\ -The real part of @var{@1@} is returned, without conversion. - -@emph{Note:} The way to do this in standard Fortran 90 -is @samp{REAL(@var{@1@})}. -However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)}, -@samp{REAL(@var{@1@})} means something different for some compilers -that are not true Fortran 90 compilers but offer some -extensions standardized by Fortran 90 (such as the -@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - -The advantage of @code{@0@()} is that, while not necessarily -more or less portable than @code{REAL()}, it is more likely to -cause a compiler that doesn't support it to produce a diagnostic -than generate incorrect code. - -@xref{REAL() and AIMAG() of Complex}, for more information. -") - -DEFDOC (GETARG, "Obtain command-line argument.", "\ -Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all -blanks if there are fewer than @var{@2@} command-line arguments); -@code{CALL @0@(0, @var{value})} sets @var{value} to the name of the -program (on systems that support this feature). - -@xref{IArgC Intrinsic}, for information on how to get the number -of arguments. -") - -DEFDOC (ABORT, "Abort the program.", "\ -Prints a message and potentially causes a core dump via @code{abort(3)}. -") - -DEFDOC (EXIT, "Terminate the program.", "\ -Exit the program with status @var{@1@} after closing open Fortran -i/o units and otherwise behaving as @code{exit(2)}. If @var{@1@} -is omitted the canonical `success' value will be returned to the -system. -") - -DEFDOC (IARGC, "Obtain count of command-line arguments.", "\ -Returns the number of command-line arguments. - -This count does not include the specification of the program -name itself. -") - -DEFDOC (CTIME, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\ -Converts @var{@1@}, a system time value, such as returned by -@code{TIME()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}. - -@xref{Time Intrinsic}. -") - -DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\ -Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}}, -representing the numeric day of the month @var{dd}, a three-character -abbreviation of the month name @var{mmm} and the last two digits of -the year @var{yy}, e.g.@ @samp{25-Nov-96}. - -This intrinsic is not recommended, due to the year 2000 approaching. -@xref{CTime Intrinsic}, for information on obtaining more digits -for the current (or any) date. -") - -DEFDOC (DTIME, "Get elapsed time since last time.", "\ -Initially, return in seconds the runtime (since the start of the -process' execution) as the function value and the user and system -components of this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} -respectively. -The functions' value is equal to @samp{@var{@1@}(1) + @samp{@1@}(2)}. - -Subsequent invocations of @samp{@0@()} return values accumulated since the -previous invocation. -") - -DEFDOC (ETIME, "Get elapsed time for process.", "\ -Return in seconds the runtime (since the start of the process' -execution) as the function value and the user and system components of -this in @samp{@var{@1@}(1)} and @samp{@var{@1@}(2)} respectively. -The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}. -") - -DEFDOC (FDATE, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\ -Returns the current date in the same format as @code{CTIME()}. - -Equivalent to: - -@example -CTIME(TIME()) -@end example - -@xref{CTime Intrinsic}. -") - -DEFDOC (GMTIME, "Convert time to GMT time info.", "\ -Given a system time value @var{@1@}, fills @var{@2@} with values -extracted from it appropriate to the GMT time zone using -@code{gmtime(3)}. - -The array elements are as follows: - -@enumerate -@item -Seconds after the minute, range 0--59 or 0--61 to allow for leap -seconds - -@item -Minutes after the hour, range 0--59 - -@item -Hours past midnight, range 0--23 - -@item -Day of month, range 0--31 - -@item -Number of months since January, range 0--12 - -@item -Number of days since Sunday, range 0--6 - -@item -Years since 1900 - -@item -Days since January 1 - -@item -Daylight savings indicator: positive if daylight savings is in effect, -zero if not, and negative if the information isn't available. -@end enumerate -") - -DEFDOC (LTIME, "Convert time to local time info.", "\ -Given a system time value @var{@1@}, fills @var{@2@} with values -extracted from it appropriate to the GMT time zone using -@code{localtime(3)}. - -The array elements are as follows: - -@enumerate -@item -Seconds after the minute, range 0--59 or 0--61 to allow for leap -seconds - -@item -Minutes after the hour, range 0--59 - -@item -Hours past midnight, range 0--23 - -@item -Day of month, range 0--31 - -@item -Number of months since January, range 0--12 - -@item -Number of days since Sunday, range 0--6 - -@item -Years since 1900 - -@item -Days since January 1 - -@item -Daylight savings indicator: positive if daylight savings is in effect, -zero if not, and negative if the information isn't available. -@end enumerate -") - -DEFDOC (IDATE, "Get local time info.", "\ -Fills @var{@1@} with the numerical values at the current local time -of day, month (in the range 1--12), and year in elements 1, 2, and 3, -respectively. -The year has four significant digits. -") - -DEFDOC (IDATEVXT, "Get local time info (VAX/VMS).", "\ -Returns the numerical values of the current local time. -The date is returned in @var{@1@}, -the month in @var{@2@} (in the range 1--12), -and the year in @var{@3@} (in the range 0--99). - -This intrinsic is not recommended, due to the year 2000 approaching. -@xref{IDate Intrinsic}, for information on obtaining more digits -for the current local date. -") - -DEFDOC (ITIME, "Get local time of day.", "\ -Returns the current local time hour, minutes, and seconds in elements -1, 2, and 3 of @var{@1@}, respectively. -") - -DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\ -Returns the number of clock ticks since the start of the process. -Only defined on systems with @code{clock(3)} (q.v.). -") - -DEFDOC (SECNDS, "Get local time offset since midnight.", "\ -Returns the local time in seconds since midnight minus the value -@var{@1@}. -") - -DEFDOC (SECONDFUNC, "Get CPU time for process in seconds.", "\ -Returns the process' runtime in seconds---the same value as the -UNIX function @code{etime} returns. - -This routine is known from Cray Fortran. -") - -DEFDOC (SECONDSUBR, "Get CPU time for process@99@in seconds.", "\ -Returns the process' runtime in seconds in @var{@1@}---the same value -as the UNIX function @code{etime} returns. - -This routine is known from Cray Fortran. -") - -DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\ -Returns in @var{@1@} the current value of the system clock; this is -the value returned by the UNIX function @code{times(2)} -in this implementation, but -isn't in general. -@var{@2@} is the number of clock ticks per second and -@var{@3@} is the maximum value this can take, which isn't very useful -in this implementation since it's just the maximum C @code{unsigned -int} value. -") - -DEFDOC (TIME, "Get current time as time value.", "\ -Returns the current time encoded as an integer in the manner of -the UNIX function @code{time(3)}. -This value is suitable for passing to @code{CTIME}, -@code{GMTIME}, and @code{LTIME}. -") - -#define BES(num,n) "\ -Calculates the Bessel function of the " #num " kind of \ -order " #n ".\n\ -See @code{bessel(3m)}, on whose implementation the \ -function depends.\ -" - -DEFDOC (BESJ0, "Bessel function.", BES (first, 0)) -DEFDOC (BESJ1, "Bessel function.", BES (first, 1)) -DEFDOC (BESJN, "Bessel function.", BES (first, @var{N})) -DEFDOC (BESY0, "Bessel function.", BES (second, 0)) -DEFDOC (BESY1, "Bessel function.", BES (second, 1)) -DEFDOC (BESYN, "Bessel function.", BES (second, @var{N})) - -DEFDOC (ERF, "Error function.", "\ -Returns the error function of @var{@1@}. -See @code{erf(3m)}, which provides the implementation. -") - -DEFDOC (ERFC, "Complementary error function.", "\ -Returns the complementary error function of @var{@1@}: -@code{ERFC(R) = 1 - ERF(R)} (except that the result may be more -accurate than explicitly evaluating that formulae would give). -See @code{erfc(3m)}, which provides the implementation. -") - -DEFDOC (IRAND, "Random number.", "\ -Returns a uniform quasi-random number up to a system-dependent limit. -If @var{@1@} is 0, the next number in sequence is returned; if -@var{@1@} is 1, the generator is restarted by calling the UNIX function -@samp{srand(0)}; if @var{@1@} has any other value, -it is used as a new seed with @code{srand()}. - -@xref{SRand Intrinsic}. - -@emph{Note:} As typically implemented (by the routine of the same -name in the C library), this random number generator is a very poor -one, though the BSD and GNU libraries provide a much better -implementation than the `traditional' one. -On a different system you almost certainly want to use something better. -") - -DEFDOC (RAND, "Random number.", "\ -Returns a uniform quasi-random number between 0 and 1. -If @var{@1@} is 0, the next number in sequence is returned; if -@var{@1@} is 1, the generator is restarted by calling @samp{srand(0)}; -if @var{@1@} has any other value, it is used as a new seed with -@code{srand}. - -@xref{SRand Intrinsic}. - -@emph{Note:} As typically implemented (by the routine of the same -name in the C library), this random number generator is a very poor -one, though the BSD and GNU libraries provide a much better -implementation than the `traditional' one. -On a different system you -almost certainly want to use something better. -") - -DEFDOC (SRAND, "Random seed.", "\ -Reinitialises the generator with the seed in @var{@1@}. -@xref{IRand Intrinsic}. @xref{Rand Intrinsic}. -") - -DEFDOC (ACCESS, "Check file accessibility.", "\ -Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and -returns 0 if the file is accessible in that mode, otherwise an error -code if the file is inaccessible or @var{@2@} is invalid. See -@code{access(2)}. @var{@2@} may be a concatenation of any of the -following characters: - -@table @samp -@item r -Read permission - -@item w -Write permission - -@item x -Execute permission - -@item @kbd{SPC} -Existence -@end table -") - -DEFDOC (CHDIR, "Change directory.", "\ -Sets the current working directory to be @var{@1@}. -If the @var{@2@} argument is supplied, it contains 0 -on success or an error code otherwise upon return. -See @code{chdir(3)}. -") - -DEFDOC (CHMOD, "Change file modes.", "\ -Changes the access mode of file @var{@1@} according to the -specification @var{@2@}, which is given in the format of -@code{chmod(1)}. -If the @var{Status} argument is supplied, it contains 0 -on success or an error code otherwise upon return. -Note that this currently works -by actually invoking @code{/bin/chmod} (or the @code{chmod} found when -the library was configured) and so may fail in some circumstances and -will, anyway, be slow. -") - -DEFDOC (GETCWD, "Get current working directory.", "\ -Places the current working directory in @var{@1@}. -Returns 0 on -success, otherwise an error code. -") - -DEFDOC (FSTAT, "Get file information.", "\ -Obtains data about the file open on Fortran I/O unit @var{@1@} and -places them in the array @var{@2@}. -The values in this array are -extracted from the @code{stat} structure as returned by -@code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. -") - -DEFDOC (LSTAT, "Get file information.", "\ -Obtains data about the given @var{@1@} and places them in the array -@var{@2@}. -If @var{@1@} is a symbolic link it returns data on the -link itself, so the routine is available only on systems that support -symbolic links. -The values in this array are extracted from the -@code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. -") - -DEFDOC (STAT, "Get file information.", "\ -Obtains data about the given @var{@1@} and places them in the array -@var{@2@}. -The values in this array are extracted from the -@code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. -") - -DEFDOC (LINK, "Make hard link in file system.", "\ -Makes a (hard) link from @var{@1@} to @var{@2@}. -If the -@var{@3@} argument is supplied, it contains 0 on success or an error -code otherwise. -See @code{link(2)}. -") - -DEFDOC (SYMLNK, "Make symbolic link in file system.", "\ -Makes a symbolic link from @var{@1@} to @var{@2@}. -If the -@var{@3@} argument is supplied, it contains 0 on success or an error -code otherwise. -Available only on systems that support symbolic -links (see @code{symlink(2)}). -") - -DEFDOC (RENAME, "Rename file.", "\ -Renames the file @var{@1@} to @var{@2@}. -See @code{rename(2)}. -If the @var{@3@} argument is supplied, it contains 0 on success or an -error code otherwise upon return. -") - -DEFDOC (UMASK, "Set file creation permissions mask.", "\ -Sets the file creation mask to @var{@2@} and returns the old value in -argument @var{@2@} if it is supplied. -See @code{umask(2)}. -") - -DEFDOC (UNLINK, "Unlink file.", "\ -Unlink the file @var{@1@}. -If the @var{@2@} argument is supplied, it -contains 0 on success or an error code otherwise. -See @code{unlink(2)}. -") - -DEFDOC (GERROR, "Get error message for last error.", "\ -Returns the system error message corresponding to the last system -error (C @code{errno}). -") - -DEFDOC (IERRNO, "Get error number for last error.", "\ -Returns the last system error number (corresponding to the C -@code{errno}). -") - -DEFDOC (PERROR, "Print error message for last error.", "\ -Prints (on the C @code{stderr} stream) a newline-terminated error -message corresponding to the last system error. -This is prefixed by @var{@1@}, a colon and a space. -See @code{perror(3)}. -") - -DEFDOC (GETGID, "Get process group id.", "\ -Returns the group id for the current process. -") - -DEFDOC (GETUID, "Get process user id.", "\ -Returns the user id for the current process. -") - -DEFDOC (GETPID, "Get process id.", "\ -Returns the process id for the current process. -") - -DEFDOC (GETENV, "Get environment variable.", "\ -Sets @var{@2@} to the value of environment variable given by the -value of @var{@1@} (@code{$name} in shell terms) or to blanks if -@code{$name} has not been set. -") - -DEFDOC (GETLOG, "Get login name.", "\ -Returns the login name for the process in @var{@1@}. -") - -DEFDOC (HOSTNM, "Get host name.", "\ -Fills @var{@1@} with the system's host name returned by -@code{gethostname(2)}, returning 0 on success or an error code. -This function is not available on all systems. -") - -/* Fixme: stream i/o */ - -DEFDOC (FLUSH, "Flush buffered output.", "\ -Flushes Fortran unit(s) currently open for output. -Without the optional argument, all such units are flushed, -otherwise just the unit specified by @var{@1@}. -") - -DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\ -Returns the Unix file descriptor number corresponding to the open -Fortran I/O unit @var{@1@}. -This could be passed to an interface to C I/O routines. -") - -DEFDOC (FSEEK, "Position file (low-level).", "\ -Attempts to move Fortran unit @var{@1@} to the specified -@var{Offset}: absolute offset if @var{@2@}=0; relative to the -current offset if @var{@2@}=1; relative to the end of the file if -@var{@2@}=2. -It branches to label @var{@3@} if @var{@1@} is -not open or if the call otherwise fails. -") - -DEFDOC (FTELL, "Get file position (low-level).", "\ -Returns the current offset of Fortran unit @var{@1@} (or @minus{}1 if -@var{@1@} is not open). -") - -DEFDOC (ISATTY, "Is unit connected to a terminal?", "\ -Returns @code{.TRUE.} if and only if the Fortran I/O unit -specified by @var{@1@} is connected -to a terminal device. -See @code{isatty(3)}. -") - -DEFDOC (TTYNAM, "Get name of terminal device for unit.", "\ -Returns the name of the terminal device open on logical unit -@var{@1@} or a blank string if @var{@1@} is not connected to a -terminal. -") - -DEFDOC (SIGNAL, "Muck with signal handling.", "\ -If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be -invoked with a single integer argument (of system-dependent length) -when signal @var{@1@} occurs. -If @var{@1@} is an integer it can be -used to turn off handling of signal @var{@2@} or revert to its default -action. -See @code{signal(2)}. - -Note that @var{@2@} will be called with C conventions, so its value in -Fortran terms is obtained by applying @code{%loc} (or @var{loc}) to it. -") - -DEFDOC (KILL, "Signal a process.", "\ -Sends the signal specified by @var{@2@} to the process @var{@1@}. Returns zero -on success, otherwise an error number. -See @code{kill(2)}. -") - -DEFDOC (LNBLNK, "Get last non-blank character in string.", "\ -Returns the index of the last non-blank character in @var{@1@}. -@code{LNBLNK} and @code{LEN_TRIM} are equivalent. -") - -DEFDOC (SLEEP, "Sleep for a specified time.", "\ -Causes the process to pause for @var{@1@} seconds. -See @code{sleep(2)}. -") - -DEFDOC (SYSTEM, "Invoke shell (system) command.", "\ -Passes the command @var{@1@} to a shell (see @code{system(3)}). -If argument @var{@2@} is present, it contains the value returned by -@code{system(3)}, presumably 0 if the shell command succeeded. -Note that which shell is used to invoke the command is system-dependent -and environment-dependent. -") diff --git a/gnu/usr.bin/gcc/f/intdoc.texi b/gnu/usr.bin/gcc/f/intdoc.texi deleted file mode 100644 index 144a9f5ded5..00000000000 --- a/gnu/usr.bin/gcc/f/intdoc.texi +++ /dev/null @@ -1,6000 +0,0 @@ -@menu -@ifset familyF2U -* Abort Intrinsic:: Abort the program. -@end ifset -@ifset familyF77 -* Abs Intrinsic:: Absolute value. -@end ifset -@ifset familyF2U -* Access Intrinsic:: Check file accessibility. -@end ifset -@ifset familyASC -* AChar Intrinsic:: ASCII character from code. -@end ifset -@ifset familyF77 -* ACos Intrinsic:: Arc cosine. -* AImag Intrinsic:: Convert/extract imaginary part of complex. -* AInt Intrinsic:: Truncate to whole number. -* ALog Intrinsic:: Natural logarithm (archaic). -* ALog10 Intrinsic:: Natural logarithm (archaic). -* AMax0 Intrinsic:: Maximum value (archaic). -* AMax1 Intrinsic:: Maximum value (archaic). -* AMin0 Intrinsic:: Minimum value (archaic). -* AMin1 Intrinsic:: Minimum value (archaic). -* AMod Intrinsic:: Remainder (archaic). -@end ifset -@ifset familyF2C -* And Intrinsic:: Boolean AND. -@end ifset -@ifset familyF77 -* ANInt Intrinsic:: Round to nearest whole number. -* ASin Intrinsic:: Arc sine. -* ATan Intrinsic:: Arc tangent. -* ATan2 Intrinsic:: Arc tangent. -@end ifset -@ifset familyF2U -* BesJ0 Intrinsic:: Bessel function. -* BesJ1 Intrinsic:: Bessel function. -* BesJN Intrinsic:: Bessel function. -* BesY0 Intrinsic:: Bessel function. -* BesY1 Intrinsic:: Bessel function. -* BesYN Intrinsic:: Bessel function. -@end ifset -@ifset familyF90 -* Bit_Size Intrinsic:: Number of bits in argument's type. -@end ifset -@ifset familyMIL -* BTest Intrinsic:: Test bit. -@end ifset -@ifset familyF77 -* CAbs Intrinsic:: Absolute value (archaic). -* CCos Intrinsic:: -@end ifset -@ifset familyFVZ -* CDAbs Intrinsic:: Absolute value (archaic). -* CDCos Intrinsic:: -* CDExp Intrinsic:: -* CDLog Intrinsic:: Natural logarithm (archaic). -* CDSin Intrinsic:: -* CDSqRt Intrinsic:: -@end ifset -@ifset familyF77 -* CExp Intrinsic:: -* Char Intrinsic:: Character from code. -@end ifset -@ifset familyF2U -* ChDir Intrinsic:: Change directory. -* ChMod Intrinsic:: Change file modes. -@end ifset -@ifset familyF77 -* CLog Intrinsic:: Natural logarithm (archaic). -* Cmplx Intrinsic:: Construct @code{COMPLEX(KIND=1)} value. -@end ifset -@ifset familyGNU -* Complex Intrinsic:: Build complex value from real and - imaginary parts. -@end ifset -@ifset familyF77 -* Conjg Intrinsic:: Complex conjugate. -* Cos Intrinsic:: -* CosH Intrinsic:: -* CSin Intrinsic:: -* CSqRt Intrinsic:: -@end ifset -@ifset familyF2U -* CTime Intrinsic:: Convert time to Day Mon dd hh:mm:ss yyyy. -@end ifset -@ifset familyF77 -* DAbs Intrinsic:: Absolute value (archaic). -* DACos Intrinsic:: Arc cosine (archaic). -* DASin Intrinsic:: Arc sine (archaic). -* DATan Intrinsic:: Arc tangent (archaic). -* DATan2 Intrinsic:: Arc tangent (archaic). -@end ifset -@ifset familyVXT -* Date Intrinsic:: Get current date as dd-Mon-yy. -@end ifset -@ifset familyF2U -* DbesJ0 Intrinsic:: -* DbesJ1 Intrinsic:: -* DbesJN Intrinsic:: -* DbesY0 Intrinsic:: -* DbesY1 Intrinsic:: -* DbesYN Intrinsic:: -@end ifset -@ifset familyF77 -* Dble Intrinsic:: -@end ifset -@ifset familyFVZ -* DCmplx Intrinsic:: -* DConjg Intrinsic:: Complex conjugate (archaic). -@end ifset -@ifset familyF77 -* DCos Intrinsic:: -* DCosH Intrinsic:: -* DDiM Intrinsic:: -@end ifset -@ifset familyF2U -* DErF Intrinsic:: -* DErFC Intrinsic:: -@end ifset -@ifset familyF77 -* DExp Intrinsic:: -@end ifset -@ifset familyFVZ -* DFloat Intrinsic:: -@end ifset -@ifset familyF77 -* DiM Intrinsic:: -@end ifset -@ifset familyFVZ -* DImag Intrinsic:: -@end ifset -@ifset familyF77 -* DInt Intrinsic:: Truncate to whole number (archaic). -* DLog Intrinsic:: Natural logarithm (archaic). -* DLog10 Intrinsic:: Natural logarithm (archaic). -* DMax1 Intrinsic:: Maximum value (archaic). -* DMin1 Intrinsic:: Minimum value (archaic). -* DMod Intrinsic:: Remainder (archaic). -* DNInt Intrinsic:: Round to nearest whole number (archaic). -* DProd Intrinsic:: -@end ifset -@ifset familyVXT -* DReal Intrinsic:: -@end ifset -@ifset familyF77 -* DSign Intrinsic:: -* DSin Intrinsic:: -* DSinH Intrinsic:: -* DSqRt Intrinsic:: -* DTan Intrinsic:: -* DTanH Intrinsic:: -@end ifset -@ifset familyF2U -* Dtime Intrinsic:: Get elapsed time since last time. -* ErF Intrinsic:: Error function. -* ErFC Intrinsic:: Complementary error function. -* ETime Intrinsic:: Get elapsed time for process. -* Exit Intrinsic:: Terminate the program. -@end ifset -@ifset familyF77 -* Exp Intrinsic:: -@end ifset -@ifset familyF2U -* Fdate Intrinsic:: Get current time as Day Mon dd hh:mm:ss yyyy. -* FGetC Intrinsic:: -@end ifset -@ifset familyF77 -* Float Intrinsic:: -@end ifset -@ifset familyF2U -* Flush Intrinsic:: Flush buffered output. -* FNum Intrinsic:: Get file descriptor from Fortran unit number. -* FPutC Intrinsic:: -* FSeek Intrinsic:: Position file (low-level). -* FStat Intrinsic:: Get file information. -* FTell Intrinsic:: Get file position (low-level). -* GError Intrinsic:: Get error message for last error. -* GetArg Intrinsic:: Obtain command-line argument. -* GetCWD Intrinsic:: Get current working directory. -* GetEnv Intrinsic:: Get environment variable. -* GetGId Intrinsic:: Get process group id. -* GetLog Intrinsic:: Get login name. -* GetPId Intrinsic:: Get process id. -* GetUId Intrinsic:: Get process user id. -* GMTime Intrinsic:: Convert time to GMT time info. -* HostNm Intrinsic:: Get host name. -@end ifset -@ifset familyF77 -* IAbs Intrinsic:: Absolute value (archaic). -@end ifset -@ifset familyASC -* IAChar Intrinsic:: ASCII code for character. -@end ifset -@ifset familyMIL -* IAnd Intrinsic:: Boolean AND. -@end ifset -@ifset familyF2U -* IArgC Intrinsic:: Obtain count of command-line arguments. -@end ifset -@ifset familyMIL -* IBClr Intrinsic:: -* IBits Intrinsic:: -* IBSet Intrinsic:: -@end ifset -@ifset familyF77 -* IChar Intrinsic:: Code for character. -@end ifset -@ifset familyF2U -* IDate Intrinsic:: Get local time info. -@end ifset -@ifset familyVXT -* IDate Intrinsic (Form IDATE (VXT)):: Get local time info (VAX/VMS). -@end ifset -@ifset familyF77 -* IDiM Intrinsic:: -* IDInt Intrinsic:: Convert to @code{INTEGER} value truncated - to whole number (archaic). -* IDNInt Intrinsic:: Convert to @code{INTEGER} value rounded - to nearest whole number (archaic). -@end ifset -@ifset familyMIL -* IEOr Intrinsic:: Boolean XOR. -@end ifset -@ifset familyF2U -* IErrNo Intrinsic:: Get error number for last error. -@end ifset -@ifset familyF77 -* IFix Intrinsic:: Convert to @code{INTEGER} value truncated - to whole number. -@end ifset -@ifset familyF2C -* Imag Intrinsic:: Extract imaginary part of complex. -@end ifset -@ifset familyGNU -* ImagPart Intrinsic:: Extract imaginary part of complex. -@end ifset -@ifset familyF77 -* Index Intrinsic:: -* Int Intrinsic:: Convert to @code{INTEGER} value truncated - to whole number. -@end ifset -@ifset familyMIL -* IOr Intrinsic:: Boolean OR. -@end ifset -@ifset familyF2U -* IRand Intrinsic:: Random number. -* IsaTty Intrinsic:: Is unit connected to a terminal? -@end ifset -@ifset familyMIL -* IShft Intrinsic:: -* IShftC Intrinsic:: -@end ifset -@ifset familyF77 -* ISign Intrinsic:: -@end ifset -@ifset familyF2U -* ITime Intrinsic:: Get local time of day. -* Kill Intrinsic:: Signal a process. -@end ifset -@ifset familyF77 -* Len Intrinsic:: -@end ifset -@ifset familyF90 -* Len_Trim Intrinsic:: Get last non-blank character in string. -@end ifset -@ifset familyF77 -* LGe Intrinsic:: -* LGt Intrinsic:: -@end ifset -@ifset familyF2U -* Link Intrinsic:: Make hard link in file system. -@end ifset -@ifset familyF77 -* LLe Intrinsic:: -* LLt Intrinsic:: -@end ifset -@ifset familyF2U -* LnBlnk Intrinsic:: Get last non-blank character in string. -* Loc Intrinsic:: Address of entity in core. -@end ifset -@ifset familyF77 -* Log Intrinsic:: Natural logarithm. -* Log10 Intrinsic:: Natural logarithm. -@end ifset -@ifset familyF2U -* Long Intrinsic:: -@end ifset -@ifset familyF2C -* LShift Intrinsic:: -@end ifset -@ifset familyF2U -* LStat Intrinsic:: Get file information. -* LTime Intrinsic:: Convert time to local time info. -@end ifset -@ifset familyF77 -* Max Intrinsic:: Maximum value. -* Max0 Intrinsic:: Maximum value (archaic). -* Max1 Intrinsic:: Maximum value (archaic). -@end ifset -@ifset familyF2U -* MClock Intrinsic:: Get number of clock ticks for process. -@end ifset -@ifset familyF77 -* Min Intrinsic:: Minimum value. -* Min0 Intrinsic:: Minimum value (archaic). -* Min1 Intrinsic:: Minimum value (archaic). -* Mod Intrinsic:: Remainder. -@end ifset -@ifset familyMIL -* MvBits Intrinsic:: -@end ifset -@ifset familyF77 -* NInt Intrinsic:: Convert to @code{INTEGER} value rounded - to nearest whole number. -@end ifset -@ifset familyMIL -* Not Intrinsic:: Boolean NOT. -@end ifset -@ifset familyF2C -* Or Intrinsic:: Boolean OR. -@end ifset -@ifset familyF2U -* PError Intrinsic:: Print error message for last error. -* Rand Intrinsic:: Random number. -@end ifset -@ifset familyF77 -* Real Intrinsic:: Convert value to type @code{REAL(KIND=1)}. -@end ifset -@ifset familyGNU -* RealPart Intrinsic:: Extract real part of complex. -@end ifset -@ifset familyF2U -* Rename Intrinsic:: Rename file. -@end ifset -@ifset familyF2C -* RShift Intrinsic:: -@end ifset -@ifset familyVXT -* Secnds Intrinsic:: Get local time offset since midnight. -@end ifset -@ifset familyF2U -* Second Intrinsic:: Get CPU time for process in seconds. -* Second Intrinsic (Form SECOND (subroutine)):: Get CPU time for process - in seconds. -* Short Intrinsic:: -@end ifset -@ifset familyF77 -* Sign Intrinsic:: -@end ifset -@ifset familyF2U -* Signal Intrinsic:: Muck with signal handling. -@end ifset -@ifset familyF77 -* Sin Intrinsic:: -* SinH Intrinsic:: -@end ifset -@ifset familyF2U -* Sleep Intrinsic:: Sleep for a specified time. -@end ifset -@ifset familyF77 -* Sngl Intrinsic:: -* SqRt Intrinsic:: -@end ifset -@ifset familyF2U -* SRand Intrinsic:: Random seed. -* Stat Intrinsic:: Get file information. -* SymLnk Intrinsic:: Make symbolic link in file system. -* System Intrinsic:: Invoke shell (system) command. -@end ifset -@ifset familyF90 -* System_Clock Intrinsic:: Get current system clock value. -@end ifset -@ifset familyF77 -* Tan Intrinsic:: -* TanH Intrinsic:: -@end ifset -@ifset familyF2U -* Time Intrinsic:: Get current time as time value. -@end ifset -@ifset familyVXT -* Time Intrinsic (Form TIME (VXT)):: -@end ifset -@ifset familyF2U -* TtyNam Intrinsic:: Get name of terminal device for unit. -* UMask Intrinsic:: Set file creation permissions mask. -* Unlink Intrinsic:: Unlink file. -@end ifset -@ifset familyF2C -* XOr Intrinsic:: Boolean XOR. -* ZAbs Intrinsic:: Absolute value (archaic). -* ZCos Intrinsic:: -* ZExp Intrinsic:: -* ZLog Intrinsic:: Natural logarithm (archaic). -* ZSin Intrinsic:: -* ZSqRt Intrinsic:: -@end ifset -@end menu - -@ifset familyF2U -@node Abort Intrinsic -@subsubsection Abort Intrinsic -@cindex Abort intrinsic -@cindex intrinsics, Abort - -@noindent -@example -CALL Abort() -@end example - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Prints a message and potentially causes a core dump via @code{abort(3)}. - -@end ifset -@ifset familyF77 -@node Abs Intrinsic -@subsubsection Abs Intrinsic -@cindex Abs intrinsic -@cindex intrinsics, Abs - -@noindent -@example -Abs(@var{A}) -@end example - -@noindent -Abs: @code{INTEGER} or @code{REAL} function. -The exact type depends on that of argument @var{A}---if @var{A} is -@code{COMPLEX}, this function's type is @code{REAL} -with the same @samp{KIND=} value as the type of @var{A}. -Otherwise, this function's type is the same as that of @var{A}. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the absolute value of @var{A}. - -If @var{A} is type @code{COMPLEX}, the absolute -value is computed as: - -@example -SQRT(REALPART(@var{A})**2, IMAGPART(@var{A})**2) -@end example - -@noindent -Otherwise, it is computed by negating the @var{A} if -it is negative, or returning @var{A}. - -@xref{Sign Intrinsic}, for how to explicitly -compute the positive or negative form of the absolute -value of an expression. - -@end ifset -@ifset familyF2U -@node Access Intrinsic -@subsubsection Access Intrinsic -@cindex Access intrinsic -@cindex intrinsics, Access - -@noindent -@example -Access(@var{Name}, @var{Mode}) -@end example - -@noindent -Access: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Name}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Checks file @var{Name} for accessibility in the mode specified by @var{Mode} and -returns 0 if the file is accessible in that mode, otherwise an error -code if the file is inaccessible or @var{Mode} is invalid. See -@code{access(2)}. @var{Mode} may be a concatenation of any of the -following characters: - -@table @samp -@item r -Read permission - -@item w -Write permission - -@item x -Execute permission - -@item @kbd{SPC} -Existence -@end table - -@end ifset -@ifset familyASC -@node AChar Intrinsic -@subsubsection AChar Intrinsic -@cindex AChar intrinsic -@cindex intrinsics, AChar - -@noindent -@example -AChar(@var{I}) -@end example - -@noindent -AChar: @code{CHARACTER*1} function. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{f90}. - -@noindent -Description: - -Returns the ASCII character corresponding to the -code specified by @var{I}. - -@xref{IAChar Intrinsic}, for the inverse function. - -@xref{Char Intrinsic}, for the function corresponding -to the system's native character set. - -@end ifset -@ifset familyF77 -@node ACos Intrinsic -@subsubsection ACos Intrinsic -@cindex ACos intrinsic -@cindex intrinsics, ACos - -@noindent -@example -ACos(@var{X}) -@end example - -@noindent -ACos: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the arc-cosine (inverse cosine) of @var{X} -in radians. - -@xref{Cos Intrinsic}, for the inverse function. - -@node AImag Intrinsic -@subsubsection AImag Intrinsic -@cindex AImag intrinsic -@cindex intrinsics, AImag - -@noindent -@example -AImag(@var{Z}) -@end example - -@noindent -AImag: @code{REAL} function. -This intrinsic is valid when argument @var{Z} is -@code{COMPLEX(KIND=1)}. -When @var{Z} is any other @code{COMPLEX} type, -this intrinsic is valid only when used as the argument to -@code{REAL()}, as explained below. - -@noindent -@var{Z}: @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the (possibly converted) imaginary part of @var{Z}. - -Use of @code{AIMAG()} with an argument of a type -other than @code{COMPLEX(KIND=1)} is restricted to the following case: - -@example -REAL(AIMAG(Z)) -@end example - -@noindent -This expression converts the imaginary part of Z to -@code{REAL(KIND=1)}. - -@xref{REAL() and AIMAG() of Complex}, for more information. - -@node AInt Intrinsic -@subsubsection AInt Intrinsic -@cindex AInt intrinsic -@cindex intrinsics, AInt - -@noindent -@example -AInt(@var{A}) -@end example - -@noindent -AInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}. - -@noindent -@var{A}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns @var{A} with the fractional portion of its -magnitude truncated and its sign preserved. -(Also called ``truncation towards zero''.) - -@xref{ANInt Intrinsic}, for how to round to nearest -whole number. - -@xref{Int Intrinsic}, for how to truncate and then convert -number to @code{INTEGER}. - -@node ALog Intrinsic -@subsubsection ALog Intrinsic -@cindex ALog intrinsic -@cindex intrinsics, ALog - -@noindent -@example -ALog(@var{X}) -@end example - -@noindent -ALog: @code{REAL(KIND=1)} function. - -@noindent -@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{LOG()} that is specific -to one type for @var{X}. -@xref{Log Intrinsic}. - -@node ALog10 Intrinsic -@subsubsection ALog10 Intrinsic -@cindex ALog10 intrinsic -@cindex intrinsics, ALog10 - -@noindent -@example -ALog10(@var{X}) -@end example - -@noindent -ALog10: @code{REAL(KIND=1)} function. - -@noindent -@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{LOG10()} that is specific -to one type for @var{X}. -@xref{Log10 Intrinsic}. - -@node AMax0 Intrinsic -@subsubsection AMax0 Intrinsic -@cindex AMax0 intrinsic -@cindex intrinsics, AMax0 - -@noindent -@example -AMax0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -AMax0: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MAX()} that is specific -to one type for @var{A} and a different return type. -@xref{Max Intrinsic}. - -@node AMax1 Intrinsic -@subsubsection AMax1 Intrinsic -@cindex AMax1 intrinsic -@cindex intrinsics, AMax1 - -@noindent -@example -AMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -AMax1: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MAX()} that is specific -to one type for @var{A}. -@xref{Max Intrinsic}. - -@node AMin0 Intrinsic -@subsubsection AMin0 Intrinsic -@cindex AMin0 intrinsic -@cindex intrinsics, AMin0 - -@noindent -@example -AMin0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -AMin0: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MIN()} that is specific -to one type for @var{A} and a different return type. -@xref{Min Intrinsic}. - -@node AMin1 Intrinsic -@subsubsection AMin1 Intrinsic -@cindex AMin1 intrinsic -@cindex intrinsics, AMin1 - -@noindent -@example -AMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -AMin1: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MIN()} that is specific -to one type for @var{A}. -@xref{Min Intrinsic}. - -@node AMod Intrinsic -@subsubsection AMod Intrinsic -@cindex AMod intrinsic -@cindex intrinsics, AMod - -@noindent -@example -AMod(@var{A}, @var{P}) -@end example - -@noindent -AMod: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{P}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MOD()} that is specific -to one type for @var{A}. -@xref{Mod Intrinsic}. - -@end ifset -@ifset familyF2C -@node And Intrinsic -@subsubsection And Intrinsic -@cindex And intrinsic -@cindex intrinsics, And - -@noindent -@example -And(@var{I}, @var{J}) -@end example - -@noindent -And: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -Returns value resulting from boolean AND of -pair of bits in each of @var{I} and @var{J}. - -@end ifset -@ifset familyF77 -@node ANInt Intrinsic -@subsubsection ANInt Intrinsic -@cindex ANInt intrinsic -@cindex intrinsics, ANInt - -@noindent -@example -ANInt(@var{A}) -@end example - -@noindent -ANInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}. - -@noindent -@var{A}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns @var{A} with the fractional portion of its -magnitude eliminated by rounding to the nearest whole -number and with its sign preserved. - -A fractional portion exactly equal to -@samp{.5} is rounded to the whole number that -is larger in magnitude. -(Also called ``Fortran round''.) - -@xref{AInt Intrinsic}, for how to truncate to -whole number. - -@xref{NInt Intrinsic}, for how to round and then convert -number to @code{INTEGER}. - -@node ASin Intrinsic -@subsubsection ASin Intrinsic -@cindex ASin intrinsic -@cindex intrinsics, ASin - -@noindent -@example -ASin(@var{X}) -@end example - -@noindent -ASin: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the arc-sine (inverse sine) of @var{X} -in radians. - -@xref{Sin Intrinsic}, for the inverse function. - -@node ATan Intrinsic -@subsubsection ATan Intrinsic -@cindex ATan intrinsic -@cindex intrinsics, ATan - -@noindent -@example -ATan(@var{X}) -@end example - -@noindent -ATan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the arc-tangent (inverse tangent) of @var{X} -in radians. - -@xref{Tan Intrinsic}, for the inverse function. - -@node ATan2 Intrinsic -@subsubsection ATan2 Intrinsic -@cindex ATan2 intrinsic -@cindex intrinsics, ATan2 - -@noindent -@example -ATan2(@var{Y}, @var{X}) -@end example - -@noindent -ATan2: @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{Y}: @code{REAL}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the arc-tangent (inverse tangent) of the complex -number (@var{Y}, @var{X}) in radians. - -@xref{Tan Intrinsic}, for the inverse function. - -@end ifset -@ifset familyF2U -@node BesJ0 Intrinsic -@subsubsection BesJ0 Intrinsic -@cindex BesJ0 intrinsic -@cindex intrinsics, BesJ0 - -@noindent -@example -BesJ0(@var{X}) -@end example - -@noindent -BesJ0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the first kind of order 0. -See @code{bessel(3m)}, on whose implementation the function depends. -@node BesJ1 Intrinsic -@subsubsection BesJ1 Intrinsic -@cindex BesJ1 intrinsic -@cindex intrinsics, BesJ1 - -@noindent -@example -BesJ1(@var{X}) -@end example - -@noindent -BesJ1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the first kind of order 1. -See @code{bessel(3m)}, on whose implementation the function depends. -@node BesJN Intrinsic -@subsubsection BesJN Intrinsic -@cindex BesJN intrinsic -@cindex intrinsics, BesJN - -@noindent -@example -BesJN(@var{N}, @var{X}) -@end example - -@noindent -BesJN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{N}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the first kind of order @var{N}. -See @code{bessel(3m)}, on whose implementation the function depends. -@node BesY0 Intrinsic -@subsubsection BesY0 Intrinsic -@cindex BesY0 intrinsic -@cindex intrinsics, BesY0 - -@noindent -@example -BesY0(@var{X}) -@end example - -@noindent -BesY0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the second kind of order 0. -See @code{bessel(3m)}, on whose implementation the function depends. -@node BesY1 Intrinsic -@subsubsection BesY1 Intrinsic -@cindex BesY1 intrinsic -@cindex intrinsics, BesY1 - -@noindent -@example -BesY1(@var{X}) -@end example - -@noindent -BesY1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the second kind of order 1. -See @code{bessel(3m)}, on whose implementation the function depends. -@node BesYN Intrinsic -@subsubsection BesYN Intrinsic -@cindex BesYN intrinsic -@cindex intrinsics, BesYN - -@noindent -@example -BesYN(@var{N}, @var{X}) -@end example - -@noindent -BesYN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{N}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Calculates the Bessel function of the second kind of order @var{N}. -See @code{bessel(3m)}, on whose implementation the function depends. -@end ifset -@ifset familyF90 -@node Bit_Size Intrinsic -@subsubsection Bit_Size Intrinsic -@cindex Bit_Size intrinsic -@cindex intrinsics, Bit_Size - -@noindent -@example -Bit_Size(@var{I}) -@end example - -@noindent -Bit_Size: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar. - -@noindent -Intrinsic groups: @code{f90}. - -@noindent -Description: - -Returns the number of bits (integer precision plus sign bit) -represented by the type for @var{I}. - -@xref{BTest Intrinsic}, for how to test the value of a -bit in a variable or array. - -@xref{IBSet Intrinsic}, for how to set a bit in a -variable or array to 1. - -@end ifset -@ifset familyMIL -@node BTest Intrinsic -@subsubsection BTest Intrinsic -@cindex BTest intrinsic -@cindex intrinsics, BTest - -@noindent -@example -BTest(@var{I}, @var{Pos}) -@end example - -@noindent -BTest: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Pos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@noindent -Description: - -Returns @code{.TRUE.} if bit @var{Pos} in @var{I} is -1, @code{.FALSE.} otherwise. - -(Bit 0 is the low-order bit, adding the value 2**0, or 1, -to the number if set to 1; -bit 1 is the next-higher-order bit, adding 2**1, or 2; -bit 2 adds 2**2, or 4; and so on.) - -@xref{Bit_Size Intrinsic}, for how to obtain the number of bits -in a type. - -@end ifset -@ifset familyF77 -@node CAbs Intrinsic -@subsubsection CAbs Intrinsic -@cindex CAbs intrinsic -@cindex intrinsics, CAbs - -@noindent -@example -CAbs(@var{A}) -@end example - -@noindent -CAbs: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ABS()} that is specific -to one type for @var{A}. -@xref{Abs Intrinsic}. - -@node CCos Intrinsic -@subsubsection CCos Intrinsic -@cindex CCos intrinsic -@cindex intrinsics, CCos - -@noindent -@example -CCos(@var{X}) -@end example - -@noindent -CCos: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyFVZ -@node CDAbs Intrinsic -@subsubsection CDAbs Intrinsic -@cindex CDAbs intrinsic -@cindex intrinsics, CDAbs - -@noindent -@example -CDAbs(@var{A}) -@end example - -@noindent -CDAbs: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@noindent -Description: - -Archaic form of @code{ABS()} that is specific -to one type for @var{A}. -@xref{Abs Intrinsic}. - -@node CDCos Intrinsic -@subsubsection CDCos Intrinsic -@cindex CDCos intrinsic -@cindex intrinsics, CDCos - -@noindent -@example -CDCos(@var{X}) -@end example - -@noindent -CDCos: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@node CDExp Intrinsic -@subsubsection CDExp Intrinsic -@cindex CDExp intrinsic -@cindex intrinsics, CDExp - -@noindent -@example -CDExp(@var{X}) -@end example - -@noindent -CDExp: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@node CDLog Intrinsic -@subsubsection CDLog Intrinsic -@cindex CDLog intrinsic -@cindex intrinsics, CDLog - -@noindent -@example -CDLog(@var{X}) -@end example - -@noindent -CDLog: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@noindent -Description: - -Archaic form of @code{LOG()} that is specific -to one type for @var{X}. -@xref{Log Intrinsic}. - -@node CDSin Intrinsic -@subsubsection CDSin Intrinsic -@cindex CDSin intrinsic -@cindex intrinsics, CDSin - -@noindent -@example -CDSin(@var{X}) -@end example - -@noindent -CDSin: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@node CDSqRt Intrinsic -@subsubsection CDSqRt Intrinsic -@cindex CDSqRt intrinsic -@cindex intrinsics, CDSqRt - -@noindent -@example -CDSqRt(@var{X}) -@end example - -@noindent -CDSqRt: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node CExp Intrinsic -@subsubsection CExp Intrinsic -@cindex CExp intrinsic -@cindex intrinsics, CExp - -@noindent -@example -CExp(@var{X}) -@end example - -@noindent -CExp: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node Char Intrinsic -@subsubsection Char Intrinsic -@cindex Char intrinsic -@cindex intrinsics, Char - -@noindent -@example -Char(@var{I}) -@end example - -@noindent -Char: @code{CHARACTER*1} function. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the character corresponding to the -code specified by @var{I}, using the system's -native character set. - -Because the system's native character set is used, -the correspondence between character and their codes -is not necessarily the same between GNU Fortran -implementations. - -@xref{IChar Intrinsic}, for the inverse function. - -@xref{AChar Intrinsic}, for the function corresponding -to the ASCII character set. - -@end ifset -@ifset familyF2U -@node ChDir Intrinsic -@subsubsection ChDir Intrinsic -@cindex ChDir intrinsic -@cindex intrinsics, ChDir - -@noindent -@example -CALL ChDir(@var{Dir}, @var{Status}) -@end example - -@noindent -@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Sets the current working directory to be @var{Dir}. -If the @var{Status} argument is supplied, it contains 0 -on success or an error code otherwise upon return. -See @code{chdir(3)}. - -@node ChMod Intrinsic -@subsubsection ChMod Intrinsic -@cindex ChMod intrinsic -@cindex intrinsics, ChMod - -@noindent -@example -CALL ChMod(@var{Name}, @var{Mode}, @var{Status}) -@end example - -@noindent -@var{Name}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Changes the access mode of file @var{Name} according to the -specification @var{Mode}, which is given in the format of -@code{chmod(1)}. -If the @var{Status} argument is supplied, it contains 0 -on success or an error code otherwise upon return. -Note that this currently works -by actually invoking @code{/bin/chmod} (or the @code{chmod} found when -the library was configured) and so may fail in some circumstances and -will, anyway, be slow. - -@end ifset -@ifset familyF77 -@node CLog Intrinsic -@subsubsection CLog Intrinsic -@cindex CLog intrinsic -@cindex intrinsics, CLog - -@noindent -@example -CLog(@var{X}) -@end example - -@noindent -CLog: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{LOG()} that is specific -to one type for @var{X}. -@xref{Log Intrinsic}. - -@node Cmplx Intrinsic -@subsubsection Cmplx Intrinsic -@cindex Cmplx intrinsic -@cindex intrinsics, Cmplx - -@noindent -@example -Cmplx(@var{X}, @var{Y}) -@end example - -@noindent -Cmplx: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -If @var{X} is not type @code{COMPLEX}, -constructs a value of type @code{COMPLEX(KIND=1)} from the -real and imaginary values specified by @var{X} and -@var{Y}, respectively. -If @var{Y} is omitted, @samp{0.} is assumed. - -If @var{X} is type @code{COMPLEX}, -converts it to type @code{COMPLEX(KIND=1)}. - -@xref{Complex Intrinsic}, for information on easily constructing -a @code{COMPLEX} value of arbitrary precision from @code{REAL} -arguments. - -@end ifset -@ifset familyGNU -@node Complex Intrinsic -@subsubsection Complex Intrinsic -@cindex Complex intrinsic -@cindex intrinsics, Complex - -@noindent -@example -Complex(@var{Real}, @var{Imag}) -@end example - -@noindent -Complex: @code{COMPLEX} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{Real}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -@var{Imag}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{gnu}. - -@noindent -Description: - -Returns a @code{COMPLEX} value that has @samp{Real} and @samp{Imag} as its -real and imaginary parts, respectively. - -If @var{Real} and @var{Imag} are the same type, and that type is not -@code{INTEGER}, no data conversion is performed, and the type of -the resulting value has the same kind value as the types -of @var{Real} and @var{Imag}. - -If @var{Real} and @var{Imag} are not the same type, the usual type-promotion -rules are applied to both, converting either or both to the -appropriate @code{REAL} type. -The type of the resulting value has the same kind value as the -type to which both @var{Real} and @var{Imag} were converted, in this case. - -If @var{Real} and @var{Imag} are both @code{INTEGER}, they are both converted -to @code{REAL(KIND=1)}, and the result of the @code{COMPLEX()} -invocation is type @code{COMPLEX(KIND=1)}. - -@emph{Note:} The way to do this in standard Fortran 90 -is too hairy to describe here, but it is important to -note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)} -result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}. -Hence the availability of @code{COMPLEX()} in GNU Fortran. - -@end ifset -@ifset familyF77 -@node Conjg Intrinsic -@subsubsection Conjg Intrinsic -@cindex Conjg intrinsic -@cindex intrinsics, Conjg - -@noindent -@example -Conjg(@var{Z}) -@end example - -@noindent -Conjg: @code{COMPLEX} function, the @samp{KIND=} value of the type being that of argument @var{Z}. - -@noindent -@var{Z}: @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the complex conjugate: - -@example -COMPLEX(REALPART(@var{Z}), -IMAGPART(@var{Z})) -@end example - -@node Cos Intrinsic -@subsubsection Cos Intrinsic -@cindex Cos intrinsic -@cindex intrinsics, Cos - -@noindent -@example -Cos(@var{X}) -@end example - -@noindent -Cos: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node CosH Intrinsic -@subsubsection CosH Intrinsic -@cindex CosH intrinsic -@cindex intrinsics, CosH - -@noindent -@example -CosH(@var{X}) -@end example - -@noindent -CosH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node CSin Intrinsic -@subsubsection CSin Intrinsic -@cindex CSin intrinsic -@cindex intrinsics, CSin - -@noindent -@example -CSin(@var{X}) -@end example - -@noindent -CSin: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node CSqRt Intrinsic -@subsubsection CSqRt Intrinsic -@cindex CSqRt intrinsic -@cindex intrinsics, CSqRt - -@noindent -@example -CSqRt(@var{X}) -@end example - -@noindent -CSqRt: @code{COMPLEX(KIND=1)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node CTime Intrinsic -@subsubsection CTime Intrinsic -@cindex CTime intrinsic -@cindex intrinsics, CTime - -@noindent -@example -CTime(@var{STime}) -@end example - -@noindent -CTime: @code{CHARACTER*(*)} function. - -@noindent -@var{STime}: @code{INTEGER(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Converts @var{STime}, a system time value, such as returned by -@code{TIME()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995}. - -@xref{Time Intrinsic}. - -@end ifset -@ifset familyF77 -@node DAbs Intrinsic -@subsubsection DAbs Intrinsic -@cindex DAbs intrinsic -@cindex intrinsics, DAbs - -@noindent -@example -DAbs(@var{A}) -@end example - -@noindent -DAbs: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ABS()} that is specific -to one type for @var{A}. -@xref{Abs Intrinsic}. - -@node DACos Intrinsic -@subsubsection DACos Intrinsic -@cindex DACos intrinsic -@cindex intrinsics, DACos - -@noindent -@example -DACos(@var{X}) -@end example - -@noindent -DACos: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ACOS()} that is specific -to one type for @var{X}. -@xref{ACos Intrinsic}. - -@node DASin Intrinsic -@subsubsection DASin Intrinsic -@cindex DASin intrinsic -@cindex intrinsics, DASin - -@noindent -@example -DASin(@var{X}) -@end example - -@noindent -DASin: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ASIN()} that is specific -to one type for @var{X}. -@xref{ASin Intrinsic}. - -@node DATan Intrinsic -@subsubsection DATan Intrinsic -@cindex DATan intrinsic -@cindex intrinsics, DATan - -@noindent -@example -DATan(@var{X}) -@end example - -@noindent -DATan: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ATAN()} that is specific -to one type for @var{X}. -@xref{ATan Intrinsic}. - -@node DATan2 Intrinsic -@subsubsection DATan2 Intrinsic -@cindex DATan2 intrinsic -@cindex intrinsics, DATan2 - -@noindent -@example -DATan2(@var{Y}, @var{X}) -@end example - -@noindent -DATan2: @code{REAL(KIND=2)} function. - -@noindent -@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ATAN2()} that is specific -to one type for @var{Y} and @var{X}. -@xref{ATan2 Intrinsic}. - -@end ifset -@ifset familyVXT -@node Date Intrinsic -@subsubsection Date Intrinsic -@cindex Date intrinsic -@cindex intrinsics, Date - -@noindent -@example -CALL Date(@var{Date}) -@end example - -@noindent -@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{vxt}. - -@noindent -Description: - -Returns @var{Date} in the form @samp{@var{dd}-@var{mmm}-@var{yy}}, -representing the numeric day of the month @var{dd}, a three-character -abbreviation of the month name @var{mmm} and the last two digits of -the year @var{yy}, e.g.@ @samp{25-Nov-96}. - -This intrinsic is not recommended, due to the year 2000 approaching. -@xref{CTime Intrinsic}, for information on obtaining more digits -for the current (or any) date. - -@end ifset -@ifset familyF2U -@node DbesJ0 Intrinsic -@subsubsection DbesJ0 Intrinsic -@cindex DbesJ0 intrinsic -@cindex intrinsics, DbesJ0 - -@noindent -@example -DbesJ0(@var{X}) -@end example - -@noindent -DbesJ0: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DbesJ1 Intrinsic -@subsubsection DbesJ1 Intrinsic -@cindex DbesJ1 intrinsic -@cindex intrinsics, DbesJ1 - -@noindent -@example -DbesJ1(@var{X}) -@end example - -@noindent -DbesJ1: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DbesJN Intrinsic -@subsubsection DbesJN Intrinsic -@cindex DbesJN intrinsic -@cindex intrinsics, DbesJN - -@noindent -@example -DbesJN(@var{N}, @var{X}) -@end example - -@noindent -DbesJN: @code{REAL(KIND=2)} function. - -@noindent -@var{N}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DbesY0 Intrinsic -@subsubsection DbesY0 Intrinsic -@cindex DbesY0 intrinsic -@cindex intrinsics, DbesY0 - -@noindent -@example -DbesY0(@var{X}) -@end example - -@noindent -DbesY0: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DbesY1 Intrinsic -@subsubsection DbesY1 Intrinsic -@cindex DbesY1 intrinsic -@cindex intrinsics, DbesY1 - -@noindent -@example -DbesY1(@var{X}) -@end example - -@noindent -DbesY1: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DbesYN Intrinsic -@subsubsection DbesYN Intrinsic -@cindex DbesYN intrinsic -@cindex intrinsics, DbesYN - -@noindent -@example -DbesYN(@var{N}, @var{X}) -@end example - -@noindent -DbesYN: @code{REAL(KIND=2)} function. - -@noindent -@var{N}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@end ifset -@ifset familyF77 -@node Dble Intrinsic -@subsubsection Dble Intrinsic -@cindex Dble intrinsic -@cindex intrinsics, Dble - -@noindent -@example -Dble(@var{A}) -@end example - -@noindent -Dble: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyFVZ -@node DCmplx Intrinsic -@subsubsection DCmplx Intrinsic -@cindex DCmplx intrinsic -@cindex intrinsics, DCmplx - -@noindent -@example -DCmplx(@var{X}, @var{Y}) -@end example - -@noindent -DCmplx: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@node DConjg Intrinsic -@subsubsection DConjg Intrinsic -@cindex DConjg intrinsic -@cindex intrinsics, DConjg - -@noindent -@example -DConjg(@var{Z}) -@end example - -@noindent -DConjg: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@noindent -Description: - -Archaic form of @code{CONJG()} that is specific -to one type for @var{Z}. -@xref{ATan2 Intrinsic}. - -@end ifset -@ifset familyF77 -@node DCos Intrinsic -@subsubsection DCos Intrinsic -@cindex DCos intrinsic -@cindex intrinsics, DCos - -@noindent -@example -DCos(@var{X}) -@end example - -@noindent -DCos: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DCosH Intrinsic -@subsubsection DCosH Intrinsic -@cindex DCosH intrinsic -@cindex intrinsics, DCosH - -@noindent -@example -DCosH(@var{X}) -@end example - -@noindent -DCosH: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DDiM Intrinsic -@subsubsection DDiM Intrinsic -@cindex DDiM intrinsic -@cindex intrinsics, DDiM - -@noindent -@example -DDiM(@var{X}, @var{Y}) -@end example - -@noindent -DDiM: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node DErF Intrinsic -@subsubsection DErF Intrinsic -@cindex DErF intrinsic -@cindex intrinsics, DErF - -@noindent -@example -DErF(@var{X}) -@end example - -@noindent -DErF: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@node DErFC Intrinsic -@subsubsection DErFC Intrinsic -@cindex DErFC intrinsic -@cindex intrinsics, DErFC - -@noindent -@example -DErFC(@var{X}) -@end example - -@noindent -DErFC: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@end ifset -@ifset familyF77 -@node DExp Intrinsic -@subsubsection DExp Intrinsic -@cindex DExp intrinsic -@cindex intrinsics, DExp - -@noindent -@example -DExp(@var{X}) -@end example - -@noindent -DExp: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyFVZ -@node DFloat Intrinsic -@subsubsection DFloat Intrinsic -@cindex DFloat intrinsic -@cindex intrinsics, DFloat - -@noindent -@example -DFloat(@var{A}) -@end example - -@noindent -DFloat: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node DiM Intrinsic -@subsubsection DiM Intrinsic -@cindex DiM intrinsic -@cindex intrinsics, DiM - -@noindent -@example -DiM(@var{X}, @var{Y}) -@end example - -@noindent -DiM: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{X}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyFVZ -@node DImag Intrinsic -@subsubsection DImag Intrinsic -@cindex DImag intrinsic -@cindex intrinsics, DImag - -@noindent -@example -DImag(@var{Z}) -@end example - -@noindent -DImag: @code{REAL(KIND=2)} function. - -@noindent -@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node DInt Intrinsic -@subsubsection DInt Intrinsic -@cindex DInt intrinsic -@cindex intrinsics, DInt - -@noindent -@example -DInt(@var{A}) -@end example - -@noindent -DInt: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{AINT()} that is specific -to one type for @var{A}. -@xref{AInt Intrinsic}. - -@node DLog Intrinsic -@subsubsection DLog Intrinsic -@cindex DLog intrinsic -@cindex intrinsics, DLog - -@noindent -@example -DLog(@var{X}) -@end example - -@noindent -DLog: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{LOG()} that is specific -to one type for @var{X}. -@xref{Log Intrinsic}. - -@node DLog10 Intrinsic -@subsubsection DLog10 Intrinsic -@cindex DLog10 intrinsic -@cindex intrinsics, DLog10 - -@noindent -@example -DLog10(@var{X}) -@end example - -@noindent -DLog10: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{LOG10()} that is specific -to one type for @var{X}. -@xref{Log10 Intrinsic}. - -@node DMax1 Intrinsic -@subsubsection DMax1 Intrinsic -@cindex DMax1 intrinsic -@cindex intrinsics, DMax1 - -@noindent -@example -DMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -DMax1: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MAX()} that is specific -to one type for @var{A}. -@xref{Max Intrinsic}. - -@node DMin1 Intrinsic -@subsubsection DMin1 Intrinsic -@cindex DMin1 intrinsic -@cindex intrinsics, DMin1 - -@noindent -@example -DMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -DMin1: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MIN()} that is specific -to one type for @var{A}. -@xref{Min Intrinsic}. - -@node DMod Intrinsic -@subsubsection DMod Intrinsic -@cindex DMod intrinsic -@cindex intrinsics, DMod - -@noindent -@example -DMod(@var{A}, @var{P}) -@end example - -@noindent -DMod: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -@var{P}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MOD()} that is specific -to one type for @var{A}. -@xref{Mod Intrinsic}. - -@node DNInt Intrinsic -@subsubsection DNInt Intrinsic -@cindex DNInt intrinsic -@cindex intrinsics, DNInt - -@noindent -@example -DNInt(@var{A}) -@end example - -@noindent -DNInt: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ANINT()} that is specific -to one type for @var{A}. -@xref{ANInt Intrinsic}. - -@node DProd Intrinsic -@subsubsection DProd Intrinsic -@cindex DProd intrinsic -@cindex intrinsics, DProd - -@noindent -@example -DProd(@var{X}, @var{Y}) -@end example - -@noindent -DProd: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyVXT -@node DReal Intrinsic -@subsubsection DReal Intrinsic -@cindex DReal intrinsic -@cindex intrinsics, DReal - -@noindent -@example -DReal(@var{A}) -@end example - -@noindent -DReal: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{vxt}. - -@end ifset -@ifset familyF77 -@node DSign Intrinsic -@subsubsection DSign Intrinsic -@cindex DSign intrinsic -@cindex intrinsics, DSign - -@noindent -@example -DSign(@var{A}, @var{B}) -@end example - -@noindent -DSign: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -@var{B}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DSin Intrinsic -@subsubsection DSin Intrinsic -@cindex DSin intrinsic -@cindex intrinsics, DSin - -@noindent -@example -DSin(@var{X}) -@end example - -@noindent -DSin: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DSinH Intrinsic -@subsubsection DSinH Intrinsic -@cindex DSinH intrinsic -@cindex intrinsics, DSinH - -@noindent -@example -DSinH(@var{X}) -@end example - -@noindent -DSinH: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DSqRt Intrinsic -@subsubsection DSqRt Intrinsic -@cindex DSqRt intrinsic -@cindex intrinsics, DSqRt - -@noindent -@example -DSqRt(@var{X}) -@end example - -@noindent -DSqRt: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DTan Intrinsic -@subsubsection DTan Intrinsic -@cindex DTan intrinsic -@cindex intrinsics, DTan - -@noindent -@example -DTan(@var{X}) -@end example - -@noindent -DTan: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node DTanH Intrinsic -@subsubsection DTanH Intrinsic -@cindex DTanH intrinsic -@cindex intrinsics, DTanH - -@noindent -@example -DTanH(@var{X}) -@end example - -@noindent -DTanH: @code{REAL(KIND=2)} function. - -@noindent -@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Dtime Intrinsic -@subsubsection Dtime Intrinsic -@cindex Dtime intrinsic -@cindex intrinsics, Dtime - -@noindent -@example -Dtime(@var{TArray}) -@end example - -@noindent -Dtime: @code{REAL(KIND=1)} function. - -@noindent -@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Initially, return in seconds the runtime (since the start of the -process' execution) as the function value and the user and system -components of this in @samp{@var{TArray}(1)} and @samp{@var{TArray}(2)} -respectively. -The functions' value is equal to @samp{@var{TArray}(1) + @samp{TArray}(2)}. - -Subsequent invocations of @samp{DTIME()} return values accumulated since the -previous invocation. - -@node ErF Intrinsic -@subsubsection ErF Intrinsic -@cindex ErF intrinsic -@cindex intrinsics, ErF - -@noindent -@example -ErF(@var{X}) -@end example - -@noindent -ErF: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the error function of @var{X}. -See @code{erf(3m)}, which provides the implementation. - -@node ErFC Intrinsic -@subsubsection ErFC Intrinsic -@cindex ErFC intrinsic -@cindex intrinsics, ErFC - -@noindent -@example -ErFC(@var{X}) -@end example - -@noindent -ErFC: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the complementary error function of @var{X}: -@code{ERFC(R) = 1 - ERF(R)} (except that the result may be more -accurate than explicitly evaluating that formulae would give). -See @code{erfc(3m)}, which provides the implementation. - -@node ETime Intrinsic -@subsubsection ETime Intrinsic -@cindex ETime intrinsic -@cindex intrinsics, ETime - -@noindent -@example -ETime(@var{TArray}) -@end example - -@noindent -ETime: @code{REAL(KIND=1)} function. - -@noindent -@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Return in seconds the runtime (since the start of the process' -execution) as the function value and the user and system components of -this in @samp{@var{TArray}(1)} and @samp{@var{TArray}(2)} respectively. -The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}. - -@node Exit Intrinsic -@subsubsection Exit Intrinsic -@cindex Exit intrinsic -@cindex intrinsics, Exit - -@noindent -@example -CALL Exit(@var{Status}) -@end example - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Exit the program with status @var{Status} after closing open Fortran -i/o units and otherwise behaving as @code{exit(2)}. If @var{Status} -is omitted the canonical `success' value will be returned to the -system. - -@end ifset -@ifset familyF77 -@node Exp Intrinsic -@subsubsection Exp Intrinsic -@cindex Exp intrinsic -@cindex intrinsics, Exp - -@noindent -@example -Exp(@var{X}) -@end example - -@noindent -Exp: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Fdate Intrinsic -@subsubsection Fdate Intrinsic -@cindex Fdate intrinsic -@cindex intrinsics, Fdate - -@noindent -@example -Fdate() -@end example - -@noindent -Fdate: @code{CHARACTER*(*)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the current date in the same format as @code{CTIME()}. - -Equivalent to: - -@example -CTIME(TIME()) -@end example - -@xref{CTime Intrinsic}. - -@node FGetC Intrinsic -@subsubsection FGetC Intrinsic -@cindex FGetC intrinsic -@cindex intrinsics, FGetC - -@noindent -@example -CALL FGetC(@var{Unit}, @var{C}, @var{Status}) -@end example - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{C}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -@var{Status}: @code{INTEGER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@end ifset -@ifset familyF77 -@node Float Intrinsic -@subsubsection Float Intrinsic -@cindex Float intrinsic -@cindex intrinsics, Float - -@noindent -@example -Float(@var{A}) -@end example - -@noindent -Float: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Flush Intrinsic -@subsubsection Flush Intrinsic -@cindex Flush intrinsic -@cindex intrinsics, Flush - -@noindent -@example -CALL Flush(@var{Unit}) -@end example - -@noindent -@var{Unit}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Flushes Fortran unit(s) currently open for output. -Without the optional argument, all such units are flushed, -otherwise just the unit specified by @var{Unit}. - -@node FNum Intrinsic -@subsubsection FNum Intrinsic -@cindex FNum intrinsic -@cindex intrinsics, FNum - -@noindent -@example -FNum(@var{Unit}) -@end example - -@noindent -FNum: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the Unix file descriptor number corresponding to the open -Fortran I/O unit @var{Unit}. -This could be passed to an interface to C I/O routines. - -@node FPutC Intrinsic -@subsubsection FPutC Intrinsic -@cindex FPutC intrinsic -@cindex intrinsics, FPutC - -@noindent -@example -CALL FPutC(@var{Unit}, @var{C}, @var{Status}) -@end example - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{C}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@node FSeek Intrinsic -@subsubsection FSeek Intrinsic -@cindex FSeek intrinsic -@cindex intrinsics, FSeek - -@noindent -@example -CALL FSeek(@var{Unit}, @var{Offset}, @var{Whence}, @var{ErrLab}) -@end example - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Offset}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Whence}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{ErrLab}: @samp{*@var{label}}, where @var{label} is the label -of an executable statement; OPTIONAL. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Attempts to move Fortran unit @var{Unit} to the specified -@var{Offset}: absolute offset if @var{Offset}=0; relative to the -current offset if @var{Offset}=1; relative to the end of the file if -@var{Offset}=2. -It branches to label @var{Whence} if @var{Unit} is -not open or if the call otherwise fails. - -@node FStat Intrinsic -@subsubsection FStat Intrinsic -@cindex FStat intrinsic -@cindex intrinsics, FStat - -@noindent -@example -FStat(@var{Unit}, @var{SArray}) -@end example - -@noindent -FStat: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Obtains data about the file open on Fortran I/O unit @var{Unit} and -places them in the array @var{SArray}. -The values in this array are -extracted from the @code{stat} structure as returned by -@code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. - -@node FTell Intrinsic -@subsubsection FTell Intrinsic -@cindex FTell intrinsic -@cindex intrinsics, FTell - -@noindent -@example -FTell(@var{Unit}) -@end example - -@noindent -FTell: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the current offset of Fortran unit @var{Unit} (or @minus{}1 if -@var{Unit} is not open). - -@node GError Intrinsic -@subsubsection GError Intrinsic -@cindex GError intrinsic -@cindex intrinsics, GError - -@noindent -@example -CALL GError(@var{Message}) -@end example - -@noindent -@var{Message}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the system error message corresponding to the last system -error (C @code{errno}). - -@node GetArg Intrinsic -@subsubsection GetArg Intrinsic -@cindex GetArg intrinsic -@cindex intrinsics, GetArg - -@noindent -@example -CALL GetArg(@var{Pos}, @var{Value}) -@end example - -@noindent -@var{Pos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Sets @var{Value} to the @var{Pos}-th command-line argument (or to all -blanks if there are fewer than @var{Value} command-line arguments); -@code{CALL GETARG(0, @var{value})} sets @var{value} to the name of the -program (on systems that support this feature). - -@xref{IArgC Intrinsic}, for information on how to get the number -of arguments. - -@node GetCWD Intrinsic -@subsubsection GetCWD Intrinsic -@cindex GetCWD intrinsic -@cindex intrinsics, GetCWD - -@noindent -@example -GetCWD(@var{Name}) -@end example - -@noindent -GetCWD: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Places the current working directory in @var{Name}. -Returns 0 on -success, otherwise an error code. - -@node GetEnv Intrinsic -@subsubsection GetEnv Intrinsic -@cindex GetEnv intrinsic -@cindex intrinsics, GetEnv - -@noindent -@example -CALL GetEnv(@var{Name}, @var{Value}) -@end example - -@noindent -@var{Name}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Sets @var{Value} to the value of environment variable given by the -value of @var{Name} (@code{$name} in shell terms) or to blanks if -@code{$name} has not been set. - -@node GetGId Intrinsic -@subsubsection GetGId Intrinsic -@cindex GetGId intrinsic -@cindex intrinsics, GetGId - -@noindent -@example -GetGId() -@end example - -@noindent -GetGId: @code{INTEGER(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the group id for the current process. - -@node GetLog Intrinsic -@subsubsection GetLog Intrinsic -@cindex GetLog intrinsic -@cindex intrinsics, GetLog - -@noindent -@example -CALL GetLog(@var{Login}) -@end example - -@noindent -@var{Login}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the login name for the process in @var{Login}. - -@node GetPId Intrinsic -@subsubsection GetPId Intrinsic -@cindex GetPId intrinsic -@cindex intrinsics, GetPId - -@noindent -@example -GetPId() -@end example - -@noindent -GetPId: @code{INTEGER(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the process id for the current process. - -@node GetUId Intrinsic -@subsubsection GetUId Intrinsic -@cindex GetUId intrinsic -@cindex intrinsics, GetUId - -@noindent -@example -GetUId() -@end example - -@noindent -GetUId: @code{INTEGER(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the user id for the current process. - -@node GMTime Intrinsic -@subsubsection GMTime Intrinsic -@cindex GMTime intrinsic -@cindex intrinsics, GMTime - -@noindent -@example -CALL GMTime(@var{STime}, @var{TArray}) -@end example - -@noindent -@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Given a system time value @var{STime}, fills @var{TArray} with values -extracted from it appropriate to the GMT time zone using -@code{gmtime(3)}. - -The array elements are as follows: - -@enumerate -@item -Seconds after the minute, range 0--59 or 0--61 to allow for leap -seconds - -@item -Minutes after the hour, range 0--59 - -@item -Hours past midnight, range 0--23 - -@item -Day of month, range 0--31 - -@item -Number of months since January, range 0--12 - -@item -Number of days since Sunday, range 0--6 - -@item -Years since 1900 - -@item -Days since January 1 - -@item -Daylight savings indicator: positive if daylight savings is in effect, -zero if not, and negative if the information isn't available. -@end enumerate - -@node HostNm Intrinsic -@subsubsection HostNm Intrinsic -@cindex HostNm intrinsic -@cindex intrinsics, HostNm - -@noindent -@example -HostNm(@var{Name}) -@end example - -@noindent -HostNm: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Fills @var{Name} with the system's host name returned by -@code{gethostname(2)}, returning 0 on success or an error code. -This function is not available on all systems. - -@end ifset -@ifset familyF77 -@node IAbs Intrinsic -@subsubsection IAbs Intrinsic -@cindex IAbs intrinsic -@cindex intrinsics, IAbs - -@noindent -@example -IAbs(@var{A}) -@end example - -@noindent -IAbs: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{ABS()} that is specific -to one type for @var{A}. -@xref{Abs Intrinsic}. - -@end ifset -@ifset familyASC -@node IAChar Intrinsic -@subsubsection IAChar Intrinsic -@cindex IAChar intrinsic -@cindex intrinsics, IAChar - -@noindent -@example -IAChar(@var{C}) -@end example - -@noindent -IAChar: @code{INTEGER(KIND=1)} function. - -@noindent -@var{C}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}, @code{f90}. - -@noindent -Description: - -Returns the code for the ASCII character in the -first character position of @var{C}. - -@xref{AChar Intrinsic}, for the inverse function. - -@xref{IChar Intrinsic}, for the function corresponding -to the system's native character set. - -@end ifset -@ifset familyMIL -@node IAnd Intrinsic -@subsubsection IAnd Intrinsic -@cindex IAnd intrinsic -@cindex intrinsics, IAnd - -@noindent -@example -IAnd(@var{I}, @var{J}) -@end example - -@noindent -IAnd: @code{INTEGER} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@noindent -Description: - -Returns value resulting from boolean AND of -pair of bits in each of @var{I} and @var{J}. - -@end ifset -@ifset familyF2U -@node IArgC Intrinsic -@subsubsection IArgC Intrinsic -@cindex IArgC intrinsic -@cindex intrinsics, IArgC - -@noindent -@example -IArgC() -@end example - -@noindent -IArgC: @code{INTEGER(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the number of command-line arguments. - -This count does not include the specification of the program -name itself. - -@end ifset -@ifset familyMIL -@node IBClr Intrinsic -@subsubsection IBClr Intrinsic -@cindex IBClr intrinsic -@cindex intrinsics, IBClr - -@noindent -@example -IBClr(@var{I}, @var{Pos}) -@end example - -@noindent -IBClr: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Pos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@node IBits Intrinsic -@subsubsection IBits Intrinsic -@cindex IBits intrinsic -@cindex intrinsics, IBits - -@noindent -@example -IBits(@var{I}, @var{Pos}, @var{Len}) -@end example - -@noindent -IBits: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Pos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Len}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@node IBSet Intrinsic -@subsubsection IBSet Intrinsic -@cindex IBSet intrinsic -@cindex intrinsics, IBSet - -@noindent -@example -IBSet(@var{I}, @var{Pos}) -@end example - -@noindent -IBSet: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Pos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node IChar Intrinsic -@subsubsection IChar Intrinsic -@cindex IChar intrinsic -@cindex intrinsics, IChar - -@noindent -@example -IChar(@var{C}) -@end example - -@noindent -IChar: @code{INTEGER(KIND=1)} function. - -@noindent -@var{C}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the code for the character in the -first character position of @var{C}. - -Because the system's native character set is used, -the correspondence between character and their codes -is not necessarily the same between GNU Fortran -implementations. - -@xref{Char Intrinsic}, for the inverse function. - -@xref{IAChar Intrinsic}, for the function corresponding -to the ASCII character set. - -@end ifset -@ifset familyF2U -@node IDate Intrinsic -@subsubsection IDate Intrinsic -@cindex IDate intrinsic -@cindex intrinsics, IDate - -@noindent -@example -CALL IDate(@var{TArray}) -@end example - -@noindent -@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Fills @var{TArray} with the numerical values at the current local time -of day, month (in the range 1--12), and year in elements 1, 2, and 3, -respectively. -The year has four significant digits. - -@end ifset -@ifset familyVXT -@node IDate Intrinsic (Form IDATE (VXT)) -@subsubsection IDate Intrinsic (Form IDATE (VXT)) -@cindex IDate intrinsic -@cindex intrinsics, IDate - -@noindent -@example -CALL IDate(@var{D}, @var{M}, @var{Y}) -@end example - -@noindent -@var{D}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -@var{M}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{vxt}. - -@noindent -Description: - -Returns the numerical values of the current local time. -The date is returned in @var{D}, -the month in @var{M} (in the range 1--12), -and the year in @var{Y} (in the range 0--99). - -This intrinsic is not recommended, due to the year 2000 approaching. -@xref{IDate Intrinsic}, for information on obtaining more digits -for the current local date. - -@end ifset -@ifset familyF77 -@node IDiM Intrinsic -@subsubsection IDiM Intrinsic -@cindex IDiM intrinsic -@cindex intrinsics, IDiM - -@noindent -@example -IDiM(@var{X}, @var{Y}) -@end example - -@noindent -IDiM: @code{INTEGER(KIND=1)} function. - -@noindent -@var{X}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node IDInt Intrinsic -@subsubsection IDInt Intrinsic -@cindex IDInt intrinsic -@cindex intrinsics, IDInt - -@noindent -@example -IDInt(@var{A}) -@end example - -@noindent -IDInt: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{INT()} that is specific -to one type for @var{A}. -@xref{Int Intrinsic}. - -@node IDNInt Intrinsic -@subsubsection IDNInt Intrinsic -@cindex IDNInt intrinsic -@cindex intrinsics, IDNInt - -@noindent -@example -IDNInt(@var{A}) -@end example - -@noindent -IDNInt: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{NINT()} that is specific -to one type for @var{A}. -@xref{NInt Intrinsic}. - -@end ifset -@ifset familyMIL -@node IEOr Intrinsic -@subsubsection IEOr Intrinsic -@cindex IEOr intrinsic -@cindex intrinsics, IEOr - -@noindent -@example -IEOr(@var{I}, @var{J}) -@end example - -@noindent -IEOr: @code{INTEGER} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@noindent -Description: - -Returns value resulting from boolean exclusive-OR of -pair of bits in each of @var{I} and @var{J}. - -@end ifset -@ifset familyF2U -@node IErrNo Intrinsic -@subsubsection IErrNo Intrinsic -@cindex IErrNo intrinsic -@cindex intrinsics, IErrNo - -@noindent -@example -IErrNo() -@end example - -@noindent -IErrNo: @code{INTEGER(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the last system error number (corresponding to the C -@code{errno}). - -@end ifset -@ifset familyF77 -@node IFix Intrinsic -@subsubsection IFix Intrinsic -@cindex IFix intrinsic -@cindex intrinsics, IFix - -@noindent -@example -IFix(@var{A}) -@end example - -@noindent -IFix: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns @var{A} with the fractional portion of its -magnitude truncated and its sign preserved, converted -to type @code{INTEGER(KIND=1)}. - -If @var{A} is type @code{COMPLEX}, its real part is -truncated and converted. - -@xref{NInt Intrinsic}, for how to convert, rounded to nearest -whole number. - -@xref{AInt Intrinsic}, for how to truncate to whole number -without converting. - -@end ifset -@ifset familyF2C -@node Imag Intrinsic -@subsubsection Imag Intrinsic -@cindex Imag intrinsic -@cindex intrinsics, Imag - -@noindent -@example -Imag(@var{Z}) -@end example - -@noindent -Imag: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}. - -@noindent -@var{Z}: @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -The imaginary part of @var{Z} is returned, without conversion. - -@emph{Note:} The way to do this in standard Fortran 90 -is @samp{AIMAG(@var{Z})}. -However, when, for example, @var{Z} is @code{DOUBLE COMPLEX}, -@samp{AIMAG(@var{Z})} means something different for some compilers -that are not true Fortran 90 compilers but offer some -extensions standardized by Fortran 90 (such as the -@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - -The advantage of @code{IMAG()} is that, while not necessarily -more or less portable than @code{AIMAG()}, it is more likely to -cause a compiler that doesn't support it to produce a diagnostic -than generate incorrect code. - -@xref{REAL() and AIMAG() of Complex}, for more information. - -@end ifset -@ifset familyGNU -@node ImagPart Intrinsic -@subsubsection ImagPart Intrinsic -@cindex ImagPart intrinsic -@cindex intrinsics, ImagPart - -@noindent -@example -ImagPart(@var{Z}) -@end example - -@noindent -ImagPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}. - -@noindent -@var{Z}: @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{gnu}. - -@noindent -Description: - -The imaginary part of @var{Z} is returned, without conversion. - -@emph{Note:} The way to do this in standard Fortran 90 -is @samp{AIMAG(@var{Z})}. -However, when, for example, @var{Z} is @code{DOUBLE COMPLEX}, -@samp{AIMAG(@var{Z})} means something different for some compilers -that are not true Fortran 90 compilers but offer some -extensions standardized by Fortran 90 (such as the -@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - -The advantage of @code{IMAGPART()} is that, while not necessarily -more or less portable than @code{AIMAG()}, it is more likely to -cause a compiler that doesn't support it to produce a diagnostic -than generate incorrect code. - -@xref{REAL() and AIMAG() of Complex}, for more information. - -@end ifset -@ifset familyF77 -@node Index Intrinsic -@subsubsection Index Intrinsic -@cindex Index intrinsic -@cindex intrinsics, Index - -@noindent -@example -Index(@var{String}, @var{Substring}) -@end example - -@noindent -Index: @code{INTEGER(KIND=1)} function. - -@noindent -@var{String}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Substring}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node Int Intrinsic -@subsubsection Int Intrinsic -@cindex Int intrinsic -@cindex intrinsics, Int - -@noindent -@example -Int(@var{A}) -@end example - -@noindent -Int: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns @var{A} with the fractional portion of its -magnitude truncated and its sign preserved, converted -to type @code{INTEGER(KIND=1)}. - -If @var{A} is type @code{COMPLEX}, its real part is -truncated and converted. - -@xref{NInt Intrinsic}, for how to convert, rounded to nearest -whole number. - -@xref{AInt Intrinsic}, for how to truncate to whole number -without converting. - -@end ifset -@ifset familyMIL -@node IOr Intrinsic -@subsubsection IOr Intrinsic -@cindex IOr intrinsic -@cindex intrinsics, IOr - -@noindent -@example -IOr(@var{I}, @var{J}) -@end example - -@noindent -IOr: @code{INTEGER} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@noindent -Description: - -Returns value resulting from boolean OR of -pair of bits in each of @var{I} and @var{J}. - -@end ifset -@ifset familyF2U -@node IRand Intrinsic -@subsubsection IRand Intrinsic -@cindex IRand intrinsic -@cindex intrinsics, IRand - -@noindent -@example -IRand(@var{Flag}) -@end example - -@noindent -IRand: @code{INTEGER(KIND=1)} function. - -@noindent -@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns a uniform quasi-random number up to a system-dependent limit. -If @var{Flag} is 0, the next number in sequence is returned; if -@var{Flag} is 1, the generator is restarted by calling the UNIX function -@samp{srand(0)}; if @var{Flag} has any other value, -it is used as a new seed with @code{srand()}. - -@xref{SRand Intrinsic}. - -@emph{Note:} As typically implemented (by the routine of the same -name in the C library), this random number generator is a very poor -one, though the BSD and GNU libraries provide a much better -implementation than the `traditional' one. -On a different system you almost certainly want to use something better. - -@node IsaTty Intrinsic -@subsubsection IsaTty Intrinsic -@cindex IsaTty intrinsic -@cindex intrinsics, IsaTty - -@noindent -@example -IsaTty(@var{Unit}) -@end example - -@noindent -IsaTty: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns @code{.TRUE.} if and only if the Fortran I/O unit -specified by @var{Unit} is connected -to a terminal device. -See @code{isatty(3)}. - -@end ifset -@ifset familyMIL -@node IShft Intrinsic -@subsubsection IShft Intrinsic -@cindex IShft intrinsic -@cindex intrinsics, IShft - -@noindent -@example -IShft(@var{I}, @var{Shift}) -@end example - -@noindent -IShft: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Shift}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@node IShftC Intrinsic -@subsubsection IShftC Intrinsic -@cindex IShftC intrinsic -@cindex intrinsics, IShftC - -@noindent -@example -IShftC(@var{I}, @var{Shift}, @var{Size}) -@end example - -@noindent -IShftC: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Shift}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Size}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node ISign Intrinsic -@subsubsection ISign Intrinsic -@cindex ISign intrinsic -@cindex intrinsics, ISign - -@noindent -@example -ISign(@var{A}, @var{B}) -@end example - -@noindent -ISign: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{B}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node ITime Intrinsic -@subsubsection ITime Intrinsic -@cindex ITime intrinsic -@cindex intrinsics, ITime - -@noindent -@example -CALL ITime(@var{TArray}) -@end example - -@noindent -@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the current local time hour, minutes, and seconds in elements -1, 2, and 3 of @var{TArray}, respectively. - -@node Kill Intrinsic -@subsubsection Kill Intrinsic -@cindex Kill intrinsic -@cindex intrinsics, Kill - -@noindent -@example -CALL Kill(@var{Pid}, @var{Signal}, @var{Status}) -@end example - -@noindent -@var{Pid}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Signal}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Sends the signal specified by @var{Signal} to the process @var{Pid}. Returns zero -on success, otherwise an error number. -See @code{kill(2)}. - -@end ifset -@ifset familyF77 -@node Len Intrinsic -@subsubsection Len Intrinsic -@cindex Len intrinsic -@cindex intrinsics, Len - -@noindent -@example -Len(@var{String}) -@end example - -@noindent -Len: @code{INTEGER(KIND=1)} function. - -@noindent -@var{String}: @code{CHARACTER}; scalar. - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF90 -@node Len_Trim Intrinsic -@subsubsection Len_Trim Intrinsic -@cindex Len_Trim intrinsic -@cindex intrinsics, Len_Trim - -@noindent -@example -Len_Trim(@var{String}) -@end example - -@noindent -Len_Trim: @code{INTEGER(KIND=1)} function. - -@noindent -@var{String}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f90}. - -@noindent -Description: - -Returns the index of the last non-blank character in @var{String}. -@code{LNBLNK} and @code{LEN_TRIM} are equivalent. - -@end ifset -@ifset familyF77 -@node LGe Intrinsic -@subsubsection LGe Intrinsic -@cindex LGe intrinsic -@cindex intrinsics, LGe - -@noindent -@example -LGe(@var{String_A}, @var{String_B}) -@end example - -@noindent -LGe: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node LGt Intrinsic -@subsubsection LGt Intrinsic -@cindex LGt intrinsic -@cindex intrinsics, LGt - -@noindent -@example -LGt(@var{String_A}, @var{String_B}) -@end example - -@noindent -LGt: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Link Intrinsic -@subsubsection Link Intrinsic -@cindex Link intrinsic -@cindex intrinsics, Link - -@noindent -@example -CALL Link(@var{Path1}, @var{Path2}, @var{Status}) -@end example - -@noindent -@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Makes a (hard) link from @var{Path1} to @var{Path2}. -If the -@var{Status} argument is supplied, it contains 0 on success or an error -code otherwise. -See @code{link(2)}. - -@end ifset -@ifset familyF77 -@node LLe Intrinsic -@subsubsection LLe Intrinsic -@cindex LLe intrinsic -@cindex intrinsics, LLe - -@noindent -@example -LLe(@var{String_A}, @var{String_B}) -@end example - -@noindent -LLe: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node LLt Intrinsic -@subsubsection LLt Intrinsic -@cindex LLt intrinsic -@cindex intrinsics, LLt - -@noindent -@example -LLt(@var{String_A}, @var{String_B}) -@end example - -@noindent -LLt: @code{LOGICAL(KIND=1)} function. - -@noindent -@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node LnBlnk Intrinsic -@subsubsection LnBlnk Intrinsic -@cindex LnBlnk intrinsic -@cindex intrinsics, LnBlnk - -@noindent -@example -LnBlnk(@var{String}) -@end example - -@noindent -LnBlnk: @code{INTEGER(KIND=1)} function. - -@noindent -@var{String}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the index of the last non-blank character in @var{String}. -@code{LNBLNK} and @code{LEN_TRIM} are equivalent. - -@node Loc Intrinsic -@subsubsection Loc Intrinsic -@cindex Loc intrinsic -@cindex intrinsics, Loc - -@noindent -@example -Loc(@var{Entity}) -@end example - -@noindent -Loc: @code{INTEGER(KIND=0)} function. - -@noindent -@var{Entity}: Any type; cannot be a constant or expression. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -The @code{LOC()} intrinsic works the -same way as the @code{%LOC()} construct. -@xref{%LOC(),,The @code{%LOC()} Construct}, for -more information. - -@end ifset -@ifset familyF77 -@node Log Intrinsic -@subsubsection Log Intrinsic -@cindex Log intrinsic -@cindex intrinsics, Log - -@noindent -@example -Log(@var{X}) -@end example - -@noindent -Log: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the natural logarithm of @var{X}, which must -be greater than zero or, if type @code{COMPLEX}, must not -be zero. - -@xref{Exp Intrinsic}, for the inverse function. - -@xref{Log10 Intrinsic}, for the base-10 logarithm function. - -@node Log10 Intrinsic -@subsubsection Log10 Intrinsic -@cindex Log10 intrinsic -@cindex intrinsics, Log10 - -@noindent -@example -Log10(@var{X}) -@end example - -@noindent -Log10: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the natural logarithm of @var{X}, which must -be greater than zero or, if type @code{COMPLEX}, must not -be zero. - -The inverse function is @samp{10. ** LOG10(@var{X})}. - -@xref{Log Intrinsic}, for the natural logarithm function. - -@end ifset -@ifset familyF2U -@node Long Intrinsic -@subsubsection Long Intrinsic -@cindex Long intrinsic -@cindex intrinsics, Long - -@noindent -@example -Long(@var{A}) -@end example - -@noindent -Long: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@end ifset -@ifset familyF2C -@node LShift Intrinsic -@subsubsection LShift Intrinsic -@cindex LShift intrinsic -@cindex intrinsics, LShift - -@noindent -@example -LShift(@var{I}, @var{Shift}) -@end example - -@noindent -LShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Shift}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@end ifset -@ifset familyF2U -@node LStat Intrinsic -@subsubsection LStat Intrinsic -@cindex LStat intrinsic -@cindex intrinsics, LStat - -@noindent -@example -LStat(@var{File}, @var{SArray}) -@end example - -@noindent -LStat: @code{INTEGER(KIND=1)} function. - -@noindent -@var{File}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Obtains data about the given @var{File} and places them in the array -@var{SArray}. -If @var{File} is a symbolic link it returns data on the -link itself, so the routine is available only on systems that support -symbolic links. -The values in this array are extracted from the -@code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. - -@node LTime Intrinsic -@subsubsection LTime Intrinsic -@cindex LTime intrinsic -@cindex intrinsics, LTime - -@noindent -@example -CALL LTime(@var{STime}, @var{TArray}) -@end example - -@noindent -@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Given a system time value @var{STime}, fills @var{TArray} with values -extracted from it appropriate to the GMT time zone using -@code{localtime(3)}. - -The array elements are as follows: - -@enumerate -@item -Seconds after the minute, range 0--59 or 0--61 to allow for leap -seconds - -@item -Minutes after the hour, range 0--59 - -@item -Hours past midnight, range 0--23 - -@item -Day of month, range 0--31 - -@item -Number of months since January, range 0--12 - -@item -Number of days since Sunday, range 0--6 - -@item -Years since 1900 - -@item -Days since January 1 - -@item -Daylight savings indicator: positive if daylight savings is in effect, -zero if not, and negative if the information isn't available. -@end enumerate - -@end ifset -@ifset familyF77 -@node Max Intrinsic -@subsubsection Max Intrinsic -@cindex Max intrinsic -@cindex intrinsics, Max - -@noindent -@example -Max(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Max: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the argument with the largest value. - -@xref{Min Intrinsic}, for the opposite function. - -@node Max0 Intrinsic -@subsubsection Max0 Intrinsic -@cindex Max0 intrinsic -@cindex intrinsics, Max0 - -@noindent -@example -Max0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Max0: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MAX()} that is specific -to one type for @var{A}. -@xref{Max Intrinsic}. - -@node Max1 Intrinsic -@subsubsection Max1 Intrinsic -@cindex Max1 intrinsic -@cindex intrinsics, Max1 - -@noindent -@example -Max1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Max1: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MAX()} that is specific -to one type for @var{A} and a different return type. -@xref{Max Intrinsic}. - -@end ifset -@ifset familyF2U -@node MClock Intrinsic -@subsubsection MClock Intrinsic -@cindex MClock intrinsic -@cindex intrinsics, MClock - -@noindent -@example -MClock() -@end example - -@noindent -MClock: @code{INTEGER(KIND=2)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the number of clock ticks since the start of the process. -Only defined on systems with @code{clock(3)} (q.v.). - -@end ifset -@ifset familyF77 -@node Min Intrinsic -@subsubsection Min Intrinsic -@cindex Min intrinsic -@cindex intrinsics, Min - -@noindent -@example -Min(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Min: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns the argument with the smallest value. - -@xref{Max Intrinsic}, for the opposite function. - -@node Min0 Intrinsic -@subsubsection Min0 Intrinsic -@cindex Min0 intrinsic -@cindex intrinsics, Min0 - -@noindent -@example -Min0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Min0: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MIN()} that is specific -to one type for @var{A}. -@xref{Min Intrinsic}. - -@node Min1 Intrinsic -@subsubsection Min1 Intrinsic -@cindex Min1 intrinsic -@cindex intrinsics, Min1 - -@noindent -@example -Min1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n) -@end example - -@noindent -Min1: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Archaic form of @code{MIN()} that is specific -to one type for @var{A} and a different return type. -@xref{Min Intrinsic}. - -@node Mod Intrinsic -@subsubsection Mod Intrinsic -@cindex Mod intrinsic -@cindex intrinsics, Mod - -@noindent -@example -Mod(@var{A}, @var{P}) -@end example - -@noindent -Mod: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -@var{P}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns remainder calculated as: - -@smallexample -@var{A} - (INT(@var{A} / @var{P}) * @var{P}) -@end smallexample - -@var{P} must not be zero. - -@end ifset -@ifset familyMIL -@node MvBits Intrinsic -@subsubsection MvBits Intrinsic -@cindex MvBits intrinsic -@cindex intrinsics, MvBits - -@noindent -@example -CALL MvBits(@var{From}, @var{FromPos}, @var{Len}, @var{TO}, @var{ToPos}) -@end example - -@noindent -@var{From}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{FromPos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Len}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{TO}: @code{INTEGER} with same @samp{KIND=} value as for @var{From}; scalar; INTENT(INOUT). - -@noindent -@var{ToPos}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@end ifset -@ifset familyF77 -@node NInt Intrinsic -@subsubsection NInt Intrinsic -@cindex NInt intrinsic -@cindex intrinsics, NInt - -@noindent -@example -NInt(@var{A}) -@end example - -@noindent -NInt: @code{INTEGER(KIND=1)} function. - -@noindent -@var{A}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Returns @var{A} with the fractional portion of its -magnitude eliminated by rounding to the nearest whole -number and with its sign preserved, converted -to type @code{INTEGER(KIND=1)}. - -If @var{A} is type @code{COMPLEX}, its real part is -rounded and converted. - -A fractional portion exactly equal to -@samp{.5} is rounded to the whole number that -is larger in magnitude. -(Also called ``Fortran round''.) - -@xref{Int Intrinsic}, for how to convert, truncate to -whole number. - -@xref{ANInt Intrinsic}, for how to round to nearest whole number -without converting. - -@end ifset -@ifset familyMIL -@node Not Intrinsic -@subsubsection Not Intrinsic -@cindex Not intrinsic -@cindex intrinsics, Not - -@noindent -@example -Not(@var{I}) -@end example - -@noindent -Not: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}. - -@noindent -Description: - -Returns value resulting from boolean NOT of each bit -in @var{I}. - -@end ifset -@ifset familyF2C -@node Or Intrinsic -@subsubsection Or Intrinsic -@cindex Or intrinsic -@cindex intrinsics, Or - -@noindent -@example -Or(@var{I}, @var{J}) -@end example - -@noindent -Or: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -Returns value resulting from boolean OR of -pair of bits in each of @var{I} and @var{J}. - -@end ifset -@ifset familyF2U -@node PError Intrinsic -@subsubsection PError Intrinsic -@cindex PError intrinsic -@cindex intrinsics, PError - -@noindent -@example -CALL PError(@var{String}) -@end example - -@noindent -@var{String}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Prints (on the C @code{stderr} stream) a newline-terminated error -message corresponding to the last system error. -This is prefixed by @var{String}, a colon and a space. -See @code{perror(3)}. - -@node Rand Intrinsic -@subsubsection Rand Intrinsic -@cindex Rand intrinsic -@cindex intrinsics, Rand - -@noindent -@example -Rand(@var{Flag}) -@end example - -@noindent -Rand: @code{REAL(KIND=1)} function. - -@noindent -@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns a uniform quasi-random number between 0 and 1. -If @var{Flag} is 0, the next number in sequence is returned; if -@var{Flag} is 1, the generator is restarted by calling @samp{srand(0)}; -if @var{Flag} has any other value, it is used as a new seed with -@code{srand}. - -@xref{SRand Intrinsic}. - -@emph{Note:} As typically implemented (by the routine of the same -name in the C library), this random number generator is a very poor -one, though the BSD and GNU libraries provide a much better -implementation than the `traditional' one. -On a different system you -almost certainly want to use something better. - -@end ifset -@ifset familyF77 -@node Real Intrinsic -@subsubsection Real Intrinsic -@cindex Real intrinsic -@cindex intrinsics, Real - -@noindent -@example -Real(@var{A}) -@end example - -@noindent -Real: @code{REAL} function. -The exact type is @samp{REAL(KIND=1)} when argument @var{A} is -any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}. -When @var{A} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}, -this intrinsic is valid only when used as the argument to -@code{REAL()}, as explained below. - -@noindent -@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@noindent -Description: - -Converts @var{A} to @code{REAL(KIND=1)}. - -Use of @code{REAL()} with a @code{COMPLEX} argument -(other than @code{COMPLEX(KIND=1)}) is restricted to the following case: - -@example -REAL(REAL(A)) -@end example - -@noindent -This expression converts the real part of A to -@code{REAL(KIND=1)}. - -@xref{REAL() and AIMAG() of Complex}, for more information. - -@end ifset -@ifset familyGNU -@node RealPart Intrinsic -@subsubsection RealPart Intrinsic -@cindex RealPart intrinsic -@cindex intrinsics, RealPart - -@noindent -@example -RealPart(@var{Z}) -@end example - -@noindent -RealPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}. - -@noindent -@var{Z}: @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{gnu}. - -@noindent -Description: - -The real part of @var{Z} is returned, without conversion. - -@emph{Note:} The way to do this in standard Fortran 90 -is @samp{REAL(@var{Z})}. -However, when, for example, @var{Z} is @code{COMPLEX(KIND=2)}, -@samp{REAL(@var{Z})} means something different for some compilers -that are not true Fortran 90 compilers but offer some -extensions standardized by Fortran 90 (such as the -@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}). - -The advantage of @code{REALPART()} is that, while not necessarily -more or less portable than @code{REAL()}, it is more likely to -cause a compiler that doesn't support it to produce a diagnostic -than generate incorrect code. - -@xref{REAL() and AIMAG() of Complex}, for more information. - -@end ifset -@ifset familyF2U -@node Rename Intrinsic -@subsubsection Rename Intrinsic -@cindex Rename intrinsic -@cindex intrinsics, Rename - -@noindent -@example -CALL Rename(@var{Path1}, @var{Path2}, @var{Status}) -@end example - -@noindent -@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Renames the file @var{Path1} to @var{Path2}. -See @code{rename(2)}. -If the @var{Status} argument is supplied, it contains 0 on success or an -error code otherwise upon return. - -@end ifset -@ifset familyF2C -@node RShift Intrinsic -@subsubsection RShift Intrinsic -@cindex RShift intrinsic -@cindex intrinsics, RShift - -@noindent -@example -RShift(@var{I}, @var{Shift}) -@end example - -@noindent -RShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}. - -@noindent -@var{I}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Shift}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@end ifset -@ifset familyVXT -@node Secnds Intrinsic -@subsubsection Secnds Intrinsic -@cindex Secnds intrinsic -@cindex intrinsics, Secnds - -@noindent -@example -Secnds(@var{T}) -@end example - -@noindent -Secnds: @code{REAL(KIND=1)} function. - -@noindent -@var{T}: @code{REAL(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{vxt}. - -@noindent -Description: - -Returns the local time in seconds since midnight minus the value -@var{T}. - -@end ifset -@ifset familyF2U -@node Second Intrinsic -@subsubsection Second Intrinsic -@cindex Second intrinsic -@cindex intrinsics, Second - -@noindent -@example -Second() -@end example - -@noindent -Second: @code{REAL(KIND=1)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the process' runtime in seconds---the same value as the -UNIX function @code{etime} returns. - -This routine is known from Cray Fortran. - -@node Second Intrinsic (Form SECOND (subroutine)) -@subsubsection Second Intrinsic (Form SECOND (subroutine)) -@cindex Second intrinsic -@cindex intrinsics, Second - -@noindent -@example -CALL Second(@var{Seconds}) -@end example - -@noindent -@var{Seconds}: @code{REAL(KIND=1)}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the process' runtime in seconds in @var{Seconds}---the same value -as the UNIX function @code{etime} returns. - -This routine is known from Cray Fortran. - -@node Short Intrinsic -@subsubsection Short Intrinsic -@cindex Short intrinsic -@cindex intrinsics, Short - -@noindent -@example -Short(@var{A}) -@end example - -@noindent -Short: @code{INTEGER(KIND=6)} function. - -@noindent -@var{A}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@end ifset -@ifset familyF77 -@node Sign Intrinsic -@subsubsection Sign Intrinsic -@cindex Sign intrinsic -@cindex intrinsics, Sign - -@noindent -@example -Sign(@var{A}, @var{B}) -@end example - -@noindent -Sign: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -@var{B}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Signal Intrinsic -@subsubsection Signal Intrinsic -@cindex Signal intrinsic -@cindex intrinsics, Signal - -@noindent -@example -CALL Signal(@var{Number}, @var{Handler}) -@end example - -@noindent -@var{Number}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE}) -or dummy/global @code{INTEGER(KIND=1)} scalar. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be -invoked with a single integer argument (of system-dependent length) -when signal @var{Number} occurs. -If @var{Number} is an integer it can be -used to turn off handling of signal @var{Handler} or revert to its default -action. -See @code{signal(2)}. - -Note that @var{Handler} will be called with C conventions, so its value in -Fortran terms is obtained by applying @code{%loc} (or @var{loc}) to it. - -@end ifset -@ifset familyF77 -@node Sin Intrinsic -@subsubsection Sin Intrinsic -@cindex Sin intrinsic -@cindex intrinsics, Sin - -@noindent -@example -Sin(@var{X}) -@end example - -@noindent -Sin: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node SinH Intrinsic -@subsubsection SinH Intrinsic -@cindex SinH intrinsic -@cindex intrinsics, SinH - -@noindent -@example -SinH(@var{X}) -@end example - -@noindent -SinH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Sleep Intrinsic -@subsubsection Sleep Intrinsic -@cindex Sleep intrinsic -@cindex intrinsics, Sleep - -@noindent -@example -CALL Sleep(@var{Seconds}) -@end example - -@noindent -@var{Seconds}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Causes the process to pause for @var{Seconds} seconds. -See @code{sleep(2)}. - -@end ifset -@ifset familyF77 -@node Sngl Intrinsic -@subsubsection Sngl Intrinsic -@cindex Sngl intrinsic -@cindex intrinsics, Sngl - -@noindent -@example -Sngl(@var{A}) -@end example - -@noindent -Sngl: @code{REAL(KIND=1)} function. - -@noindent -@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node SqRt Intrinsic -@subsubsection SqRt Intrinsic -@cindex SqRt intrinsic -@cindex intrinsics, SqRt - -@noindent -@example -SqRt(@var{X}) -@end example - -@noindent -SqRt: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node SRand Intrinsic -@subsubsection SRand Intrinsic -@cindex SRand intrinsic -@cindex intrinsics, SRand - -@noindent -@example -CALL SRand(@var{Seed}) -@end example - -@noindent -@var{Seed}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Reinitialises the generator with the seed in @var{Seed}. -@xref{IRand Intrinsic}. @xref{Rand Intrinsic}. - -@node Stat Intrinsic -@subsubsection Stat Intrinsic -@cindex Stat intrinsic -@cindex intrinsics, Stat - -@noindent -@example -Stat(@var{File}, @var{SArray}) -@end example - -@noindent -Stat: @code{INTEGER(KIND=1)} function. - -@noindent -@var{File}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Obtains data about the given @var{File} and places them in the array -@var{SArray}. -The values in this array are extracted from the -@code{stat} structure as returned by @code{fstat(2)} q.v., as follows: - -@enumerate -@item -File mode - -@item -Inode number - -@item -ID of device containing directory entry for file - -@item -Device id (if relevant) - -@item -Number of links - -@item -Owner's uid - -@item -Owner's gid - -@item -File size (bytes) - -@item -Last access time - -@item -Last modification time - -@item -Last file status change time - -@item -Preferred i/o block size - -@item -Number of blocks allocated -@end enumerate - -Not all these elements are relevant on all systems. -If an element is not relevant, it is returned as 0. - -Returns 0 on success, otherwise an error number. - -@node SymLnk Intrinsic -@subsubsection SymLnk Intrinsic -@cindex SymLnk intrinsic -@cindex intrinsics, SymLnk - -@noindent -@example -CALL SymLnk(@var{Path1}, @var{Path2}, @var{Status}) -@end example - -@noindent -@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Makes a symbolic link from @var{Path1} to @var{Path2}. -If the -@var{Status} argument is supplied, it contains 0 on success or an error -code otherwise. -Available only on systems that support symbolic -links (see @code{symlink(2)}). - -@node System Intrinsic -@subsubsection System Intrinsic -@cindex System intrinsic -@cindex intrinsics, System - -@noindent -@example -CALL System(@var{Command}, @var{Status}) -@end example - -@noindent -@var{Command}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Passes the command @var{Command} to a shell (see @code{system(3)}). -If argument @var{Status} is present, it contains the value returned by -@code{system(3)}, presumably 0 if the shell command succeeded. -Note that which shell is used to invoke the command is system-dependent -and environment-dependent. - -@end ifset -@ifset familyF90 -@node System_Clock Intrinsic -@subsubsection System_Clock Intrinsic -@cindex System_Clock intrinsic -@cindex intrinsics, System_Clock - -@noindent -@example -CALL System_Clock(@var{Count}, @var{Rate}, @var{Max}) -@end example - -@noindent -@var{Count}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -@var{Rate}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -@var{Max}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{f90}. - -@noindent -Description: - -Returns in @var{Count} the current value of the system clock; this is -the value returned by the UNIX function @code{times(2)} -in this implementation, but -isn't in general. -@var{Rate} is the number of clock ticks per second and -@var{Max} is the maximum value this can take, which isn't very useful -in this implementation since it's just the maximum C @code{unsigned -int} value. - -@end ifset -@ifset familyF77 -@node Tan Intrinsic -@subsubsection Tan Intrinsic -@cindex Tan intrinsic -@cindex intrinsics, Tan - -@noindent -@example -Tan(@var{X}) -@end example - -@noindent -Tan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@node TanH Intrinsic -@subsubsection TanH Intrinsic -@cindex TanH intrinsic -@cindex intrinsics, TanH - -@noindent -@example -TanH(@var{X}) -@end example - -@noindent -TanH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}. - -@noindent -@var{X}: @code{REAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: (standard FORTRAN 77). - -@end ifset -@ifset familyF2U -@node Time Intrinsic -@subsubsection Time Intrinsic -@cindex Time intrinsic -@cindex intrinsics, Time - -@noindent -@example -Time() -@end example - -@noindent -Time: @code{INTEGER(KIND=2)} function. - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the current time encoded as an integer in the manner of -the UNIX function @code{time(3)}. -This value is suitable for passing to @code{CTIME}, -@code{GMTIME}, and @code{LTIME}. - -@end ifset -@ifset familyVXT -@node Time Intrinsic (Form TIME (VXT)) -@subsubsection Time Intrinsic (Form TIME (VXT)) -@cindex Time intrinsic -@cindex intrinsics, Time - -@noindent -@example -CALL Time(@var{Time}) -@end example - -@noindent -@var{Time}: @code{CHARACTER*8}; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{vxt}. - -@end ifset -@ifset familyF2U -@node TtyNam Intrinsic -@subsubsection TtyNam Intrinsic -@cindex TtyNam intrinsic -@cindex intrinsics, TtyNam - -@noindent -@example -TtyNam(@var{Unit}) -@end example - -@noindent -TtyNam: @code{CHARACTER*(*)} function. - -@noindent -@var{Unit}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Returns the name of the terminal device open on logical unit -@var{Unit} or a blank string if @var{Unit} is not connected to a -terminal. - -@node UMask Intrinsic -@subsubsection UMask Intrinsic -@cindex UMask intrinsic -@cindex intrinsics, UMask - -@noindent -@example -CALL UMask(@var{Mask}, @var{Old}) -@end example - -@noindent -@var{Mask}: @code{INTEGER}; scalar; INTENT(IN). - -@noindent -@var{Old}: @code{INTEGER}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Sets the file creation mask to @var{Old} and returns the old value in -argument @var{Old} if it is supplied. -See @code{umask(2)}. - -@node Unlink Intrinsic -@subsubsection Unlink Intrinsic -@cindex Unlink intrinsic -@cindex intrinsics, Unlink - -@noindent -@example -CALL Unlink(@var{File}, @var{Status}) -@end example - -@noindent -@var{File}: @code{CHARACTER}; scalar; INTENT(IN). - -@noindent -@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT). - -@noindent -Intrinsic groups: @code{unix}. - -@noindent -Description: - -Unlink the file @var{File}. -If the @var{Status} argument is supplied, it -contains 0 on success or an error code otherwise. -See @code{unlink(2)}. - -@end ifset -@ifset familyF2C -@node XOr Intrinsic -@subsubsection XOr Intrinsic -@cindex XOr intrinsic -@cindex intrinsics, XOr - -@noindent -@example -XOr(@var{I}, @var{J}) -@end example - -@noindent -XOr: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the -types of all the arguments. - -@noindent -@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -Returns value resulting from boolean exclusive-OR of -pair of bits in each of @var{I} and @var{J}. - -@node ZAbs Intrinsic -@subsubsection ZAbs Intrinsic -@cindex ZAbs intrinsic -@cindex intrinsics, ZAbs - -@noindent -@example -ZAbs(@var{A}) -@end example - -@noindent -ZAbs: @code{REAL(KIND=2)} function. - -@noindent -@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -Archaic form of @code{ABS()} that is specific -to one type for @var{A}. -@xref{Abs Intrinsic}. - -@node ZCos Intrinsic -@subsubsection ZCos Intrinsic -@cindex ZCos intrinsic -@cindex intrinsics, ZCos - -@noindent -@example -ZCos(@var{X}) -@end example - -@noindent -ZCos: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@node ZExp Intrinsic -@subsubsection ZExp Intrinsic -@cindex ZExp intrinsic -@cindex intrinsics, ZExp - -@noindent -@example -ZExp(@var{X}) -@end example - -@noindent -ZExp: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@node ZLog Intrinsic -@subsubsection ZLog Intrinsic -@cindex ZLog intrinsic -@cindex intrinsics, ZLog - -@noindent -@example -ZLog(@var{X}) -@end example - -@noindent -ZLog: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@noindent -Description: - -Archaic form of @code{LOG()} that is specific -to one type for @var{X}. -@xref{Log Intrinsic}. - -@node ZSin Intrinsic -@subsubsection ZSin Intrinsic -@cindex ZSin intrinsic -@cindex intrinsics, ZSin - -@noindent -@example -ZSin(@var{X}) -@end example - -@noindent -ZSin: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@node ZSqRt Intrinsic -@subsubsection ZSqRt Intrinsic -@cindex ZSqRt intrinsic -@cindex intrinsics, ZSqRt - -@noindent -@example -ZSqRt(@var{X}) -@end example - -@noindent -ZSqRt: @code{COMPLEX(KIND=2)} function. - -@noindent -@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN). - -@noindent -Intrinsic groups: @code{f2c}. - -@end ifset diff --git a/gnu/usr.bin/gcc/f/runtime/libF77/makefile b/gnu/usr.bin/gcc/f/runtime/libF77/makefile deleted file mode 100644 index 30de0ee759a..00000000000 --- a/gnu/usr.bin/gcc/f/runtime/libF77/makefile +++ /dev/null @@ -1,84 +0,0 @@ -.SUFFIXES: .c .o -CC = cc -SHELL = /bin/sh -CFLAGS = -O - -# If your system lacks onexit() and you are not using an -# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS, -# e.g., by changing the above "CFLAGS =" line to -# CFLAGS = -O -DNO_ONEXIT - -# On at least some Sun systems, it is more appropriate to change the -# "CFLAGS =" line to -# CFLAGS = -O -Donexit=on_exit - -# compile, then strip unnecessary symbols -.c.o: - $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c - ld -r -x -o $*.xxx $*.o - mv $*.xxx $*.o -## Under Solaris, omit -x in the ld line above. - -MISC = F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \ - getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\ - derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit.o -POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o -CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o -DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o -REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ - r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ - r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ - r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o -DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ - d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ - d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ - d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ - d_sqrt.o d_tan.o d_tanh.o -INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o -HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o -CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o -EFL = ef1asc_.o ef1cmc_.o -CHAR = s_cat.o s_cmp.o s_copy.o -F90BIT = lbitbits.o lbitshft.o - -libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ - $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) - ar r libF77.a $? - -ranlib libF77.a - -### If your system lacks ranlib, you don't need it; see README. - -Version.o: Version.c - $(CC) -c Version.c - -# To compile with C++, first "make f2c.h" -f2c.h: f2ch.add - cat /usr/include/f2c.h f2ch.add >f2c.h - -install: libF77.a - mv libF77.a /usr/lib - ranlib /usr/lib/libF77.a - -clean: - rm -f libF77.a *.o - -check: - xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \ - c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \ - d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \ - d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \ - d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \ - derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c exit.c f2ch.add \ - getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ - h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ - i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \ - i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \ - main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \ - pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \ - r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ - r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ - r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ - r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \ - s_paus.c s_rnge.c s_stop.c sig_die.c signal_.c system_.c \ - z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap - cmp zap libF77.xsum && rm zap || diff libF77.xsum zap diff --git a/gnu/usr.bin/gcc/f/runtime/libI77/makefile b/gnu/usr.bin/gcc/f/runtime/libI77/makefile deleted file mode 100644 index 3e9b516863c..00000000000 --- a/gnu/usr.bin/gcc/f/runtime/libI77/makefile +++ /dev/null @@ -1,101 +0,0 @@ -.SUFFIXES: .c .o -CC = cc -CFLAGS = -O -SHELL = /bin/sh - -# compile, then strip unnecessary symbols -.c.o: - $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c - ld -r -x -o $*.xxx $*.o - mv $*.xxx $*.o -## Under Solaris, omit -x in the ld line above. - -OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \ - fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \ - open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \ - uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o -libI77.a: $(OBJ) - ar r libI77.a $? - -ranlib libI77.a - -### If your system lacks ranlib, you don't need it; see README. - -install: libI77.a - cp libI77.a /usr/lib/libI77.a - ranlib /usr/lib/libI77.a - -Version.o: Version.c - $(CC) -c Version.c - -# To compile with C++, first "make f2c.h" -f2c.h: f2ch.add - cat /usr/include/f2c.h f2ch.add >f2c.h - - -clean: - rm -f $(OBJ) libI77.a - -clobber: clean - rm -f libI77.a - -backspace.o: fio.h -close.o: fio.h -dfe.o: fio.h -dfe.o: fmt.h -due.o: fio.h -endfile.o: fio.h rawio.h -err.o: fio.h rawio.h -fmt.o: fio.h -fmt.o: fmt.h -ftell_.o: fio.h -iio.o: fio.h -iio.o: fmt.h -ilnw.o: fio.h -ilnw.o: lio.h -inquire.o: fio.h -lread.o: fio.h -lread.o: fmt.h -lread.o: lio.h -lread.o: fp.h -lwrite.o: fio.h -lwrite.o: fmt.h -lwrite.o: lio.h -open.o: fio.h rawio.h -rdfmt.o: fio.h -rdfmt.o: fmt.h -rdfmt.o: fp.h -rewind.o: fio.h -rsfe.o: fio.h -rsfe.o: fmt.h -rsli.o: fio.h -rsli.o: lio.h -rsne.o: fio.h -rsne.o: lio.h -sfe.o: fio.h -sue.o: fio.h -uio.o: fio.h -util.o: fio.h -wref.o: fio.h -wref.o: fmt.h -wref.o: fp.h -wrtfmt.o: fio.h -wrtfmt.o: fmt.h -wsfe.o: fio.h -wsfe.o: fmt.h -wsle.o: fio.h -wsle.o: fmt.h -wsle.o: lio.h -wsne.o: fio.h -wsne.o: lio.h -xwsne.o: fio.h -xwsne.o: lio.h -xwsne.o: fmt.h - -check: - xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \ - due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \ - ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \ - open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \ - typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \ - xwsne.c >zap - cmp zap libI77.xsum && rm zap || diff libI77.xsum zap |