diff --git a/CMakeLists.txt b/CMakeLists.txt index 6dbf1f187f4..742f58e0df2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,6 +65,9 @@ elseif (${TARGET_ARCHITECTURE} MATCHES "^(aarch64|arm64|ARM64)$") elseif( ${TARGET_ARCHITECTURE} STREQUAL "ppc64le" ) set(ARCHNAME ppc64le) set(ARCH POWER) +elseif( ${TARGET_ARCHITECTURE} STREQUAL "riscv64") + set(ARCHNAME riscv64) + set(ARCH RISCV) else() message("Unsupported architecture: ${TARGET_ARCHITECTURE}" ) return() diff --git a/runtime/CMakeLists.txt b/runtime/CMakeLists.txt index 8552e8c333e..ab20d87b559 100644 --- a/runtime/CMakeLists.txt +++ b/runtime/CMakeLists.txt @@ -37,6 +37,11 @@ elseif( ${TARGET_ARCHITECTURE} STREQUAL "aarch64" ) -DTARGET_${OS}_ARM -DTARGET_${OS}_ARM64 ) +elseif( ${TARGET_ARCHITECTURE} STREQUAL "riscv64" ) + add_definitions( + -DTARGET_LLVM_RISCV64 + -DTARGET_LINUX_RISCV + ) elseif( ${TARGET_ARCHITECTURE} STREQUAL "ppc64le" ) add_definitions( -DTARGET_${OS}_POWER diff --git a/runtime/flang/ieee_arithmetic.F95 b/runtime/flang/ieee_arithmetic.F95 index 09629e6aeb7..07fd5af841a 100644 --- a/runtime/flang/ieee_arithmetic.F95 +++ b/runtime/flang/ieee_arithmetic.F95 @@ -36,8 +36,12 @@ module IEEE_ARITHMETIC integer, private, parameter :: FE_DOWNWARD = X'00800000' integer, private, parameter :: FE_UPWARD = X'00400000' integer, private, parameter :: FE_TOWARDZERO = X'00c00000' -#else -#ifdef TARGET_LINUX_POWER +#elif defined(TARGET_LINUX_RISCV) + integer, private, parameter :: FE_TONEAREST = 0 + integer, private, parameter :: FE_DOWNWARD = 2 + integer, private, parameter :: FE_UPWARD = 3 + integer, private, parameter :: FE_TOWARDZERO = 1 +#elif defined(TARGET_LINUX_POWER) integer, private, parameter :: FE_TONEAREST = 0 integer, private, parameter :: FE_TOWARDZERO = 1 integer, private, parameter :: FE_UPWARD = 2 @@ -48,7 +52,6 @@ module IEEE_ARITHMETIC integer, private, parameter :: FE_DOWNWARD = 1024 integer, private, parameter :: FE_UPWARD = 2048 integer, private, parameter :: FE_TOWARDZERO = 3072 -#endif #endif type(ieee_round_type), parameter :: ieee_nearest = ieee_round_type(0) @@ -486,7 +489,7 @@ end function ieee_support_datatyper pure logical function ieee_support_denormalnox() !pgi$ defaultkind -#if defined TARGET_LINUX_ARM || defined TARGET_LINUX_POWER || defined PGFLANG +#if defined(TARGET_LINUX_ARM) || defined(TARGET_LINUX_RISCV) || defined(TARGET_LINUX_POWER) || defined(PGFLANG) ieee_support_denormalnox = .false. #else ieee_support_denormalnox = .true. @@ -497,7 +500,7 @@ pure logical function ieee_support_denormalr(x) !pgi$ defaultkind !dir$ ignore_tkr (kr) x real :: x -#if defined TARGET_LINUX_ARM || defined TARGET_LINUX_POWER || defined PGFLANG +#if defined(TARGET_LINUX_ARM) || defined(TARGET_LINUX_RISCV) || defined(TARGET_LINUX_POWER) || defined(PGFLANG) ieee_support_denormalr = .false. #else ieee_support_denormalr = .true. @@ -589,7 +592,7 @@ end function ieee_support_standardr pure logical function ieee_support_uflowctrlnox() !pgi$ defaultkind -#if defined TARGET_LINUX_ARM || defined TARGET_LINUX_POWER || defined PGFLANG +#if defined(TARGET_LINUX_ARM) || defined(TARGET_LINUX_RISCV) || defined(TARGET_LINUX_POWER) || defined(PGFLANG) ieee_support_uflowctrlnox = .false. #else ieee_support_uflowctrlnox = .true. @@ -600,7 +603,7 @@ pure logical function ieee_support_uflowctrlr(x) !pgi$ defaultkind !dir$ ignore_tkr (kr) x real :: x -#if defined TARGET_LINUX_ARM || defined TARGET_LINUX_POWER || defined PGFLANG +#if defined(TARGET_LINUX_ARM) || defined(TARGET_LINUX_RISCV) || defined(TARGET_LINUX_POWER) || defined(PGFLANG) ieee_support_uflowctrlr = .false. #else ieee_support_uflowctrlr = .true. diff --git a/runtime/flang/ieee_exceptions.F95 b/runtime/flang/ieee_exceptions.F95 index 45f3098c721..da1ce6c0f7f 100644 --- a/runtime/flang/ieee_exceptions.F95 +++ b/runtime/flang/ieee_exceptions.F95 @@ -37,6 +37,13 @@ module IEEE_EXCEPTIONS integer, private, parameter :: FE_INEXACT = 16 integer, private, parameter :: FE_DENORM = 0 ! FE_DENORM is not currently supported on arm +#elif defined(TARGET_LINUX_RISCV) + integer, private, parameter :: FE_INVALID = 16 + integer, private, parameter :: FE_DIVBYZERO = 8 + integer, private, parameter :: FE_OVERFLOW = 4 + integer, private, parameter :: FE_UNDERFLOW = 2 + integer, private, parameter :: FE_INEXACT = 1 + integer, private, parameter :: FE_DENORM = 0 #elif defined(TARGET_LINUX_POWER) ! FE_DENORM is not supported on Power integer, private, parameter :: FE_INVALID = X'20000000' diff --git a/runtime/flangrti/riscv64/dumpregs.c b/runtime/flangrti/riscv64/dumpregs.c new file mode 100644 index 00000000000..c168b1d1477 --- /dev/null +++ b/runtime/flangrti/riscv64/dumpregs.c @@ -0,0 +1,74 @@ +/* + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + */ + +#include +#include +#include +#include +#include +#include "stdioInterf.h" + +typedef struct { + int rn; // Register index in to "regs" pointer + char *s; // Symbolic name of register +} gprs_t; + + +/* + * The way the structure below is organized, the registers are all + * sequential with no gaps - the structure is probably overkill - but + * allows for some flexibility. + */ + +gprs_t gprs[] = { + { 0, "x0" }, { 1, "x1" }, { 2, "x2"}, { 3, "x3" }, { 4, "x4" }, + { 5, "x5" }, { 6, "x6" }, { 7, "x7" }, { 8, "x8" }, { 9, "x9" }, + {10, "x10"}, {11, "x11"}, {12, "x12"}, {13, "x13"}, {14, "x14"}, + {15, "x15"}, {16, "x16"}, {17, "x17"}, {18, "x18"}, {19, "x19"}, + {20, "x20"}, {21, "x21"}, {22, "x22"}, {23, "x23"}, {24, "xr24"}, + {25, "x25"}, {26, "x26"}, {27, "x27"}, {28, "x28"}, {29, "x29"}, + {30, "x30"}, {31, "x31"}, +}; + +void +dumpregs(uint64_t *regs) +{ + int i; + int j; + char *pc = NULL; + + if (regs == NULL) + return; // Not sure if this is possible + +/* + * Output has the following format: + * + * Example: + * r0 0x00003fffaf4a309c 70367390085276 .0J..?.. + * sp 0x00003ffff437d1a0 70368546509216 ..7..?.. + * toc 0x0000000010019300 268538624 ........ + * r3 0x0000000010000e64 268439140 d....... + * ... + */ + + for (i = 0; i < sizeof gprs / sizeof *gprs; ++i) { + fprintf(__io_stderr(), " %-8s 0x%016" PRIx64 " %20" PRId64 "\t", + gprs[i].s, regs[gprs[i].rn], regs[gprs[i].rn]); + pc = (char *)&(regs[gprs[i].rn]); + for (j = 0; j < 8; ++j) { + fputc(isprint(pc[j]) ? pc[j] : '.', __io_stderr()); + } + fputs("\n", __io_stderr()); + } +} + +uint64_t * +getRegs(ucontext_t *u) +{ + mcontext_t *mc = &u->uc_mcontext; + return (uint64_t *)&(mc->__gregs); +} diff --git a/tools/CMakeLists.txt b/tools/CMakeLists.txt index 940e3f767d6..2e5c5f192f6 100644 --- a/tools/CMakeLists.txt +++ b/tools/CMakeLists.txt @@ -14,6 +14,9 @@ set(UTILS_COMMON_DIR ${CMAKE_CURRENT_SOURCE_DIR}/shared/utils/common) if( ${TARGET_ARCHITECTURE} STREQUAL "aarch64" ) add_definitions(-DLLVM_ENABLE_FFI=false) endif() +if( ${TARGET_ARCHITECTURE} STREQUAL "riscv64" ) + add_definitions(-DLLVM_ENABLE_FFI=false) +endif() link_directories("${LLVM_LIBRARY_DIR}/${LLVM_HOST_TARGET}") diff --git a/tools/flang2/flang2exe/iliutil.cpp b/tools/flang2/flang2exe/iliutil.cpp index 44a951c2582..fd978709a89 100644 --- a/tools/flang2/flang2exe/iliutil.cpp +++ b/tools/flang2/flang2exe/iliutil.cpp @@ -94,7 +94,7 @@ static int _pwr2(INT, int); static int _kpwr2(INT, INT, int); static int _ipowi(int, int); static int _xpowi(int, int, ILI_OP); -#if defined(TARGET_X8664) || defined(TARGET_POWER) || !defined(TARGET_LLVM_ARM) +#if defined(TARGET_X8664) || defined(TARGET_POWER) static int _frsqrt(int); #endif static int _mkfunc(const char *); @@ -2696,7 +2696,7 @@ addarth(ILI *ilip) #endif #ifdef IL_FRSQRT case IL_FRSQRT: -#if !defined(TARGET_LLVM_ARM) +#if defined(TARGET_X8664) || defined(TARGET_POWER) if (XBIT(183, 0x10000)) { if (ncons == 1) { xfsqrt(con1v2, &res.numi[1]); @@ -13214,7 +13214,7 @@ _xpowi(int opn, int pwr, ILI_OP opc) return opn; } -#if defined(TARGET_X8664) || defined(TARGET_POWER) || !defined(TARGET_LLVM_ARM) +#if defined(TARGET_X8664) || defined(TARGET_POWER) static int _frsqrt(int x) { diff --git a/tools/flang2/flang2exe/ll_structure.cpp b/tools/flang2/flang2exe/ll_structure.cpp index f08681bc82b..14ef4721e2b 100644 --- a/tools/flang2/flang2exe/ll_structure.cpp +++ b/tools/flang2/flang2exe/ll_structure.cpp @@ -464,6 +464,7 @@ static const struct triple_info known_triples[] = { {"x86_64-", "e-p:64:64-i64:64-f80:128-n8:16:32:64-S128"}, {"armv7-", "e-p:32:32-i64:64-v128:64:128-n32-S64"}, {"aarch64-", "e-m:e-i64:64-i128:128-n32:64-S128"}, + {"riscv64-", "e-m:e-p:64:64-i64:64-i128:128-n64-S128"}, {"powerpc64le", "e-p:64:64-i64:64-n32:64"}, {"", ""}}; diff --git a/tools/flang2/flang2exe/llutil.cpp b/tools/flang2/flang2exe/llutil.cpp index 5e6ebf23915..1daed42b439 100644 --- a/tools/flang2/flang2exe/llutil.cpp +++ b/tools/flang2/flang2exe/llutil.cpp @@ -3782,7 +3782,7 @@ process_ll_abi_func_ftn_mod(LL_Module *mod, SPTR func_sptr, bool update) "Unknown function prototype", func_sptr, ERR_Fatal); abi->missing_prototype = true; -#if defined(TARGET_ARM) +#if defined(TARGET_ARM) || defined(TARGET_RISCV) abi->call_as_varargs = false; #else abi->call_as_varargs = true; diff --git a/tools/flang2/flang2exe/machreg.cpp b/tools/flang2/flang2exe/machreg.cpp index 5b77b99f4a8..264907f8258 100644 --- a/tools/flang2/flang2exe/machreg.cpp +++ b/tools/flang2/flang2exe/machreg.cpp @@ -56,7 +56,7 @@ RGSETB rgsetb; const int scratch_regs[3] = {IR_RAX, IR_RCX, IR_RDX}; -#if defined(TARGET_LLVM_ARM) || defined(TARGET_LLVM_POWER) +#if defined(TARGET_LLVM_ARM) || defined(TARGET_LLVM_POWER) || defined(TARGET_LLVM_RISCV) /* arguments passed in registers */ int mr_arg_ir[MR_MAX_IREG_ARGS + 1]; diff --git a/tools/flang2/flang2exe/main.cpp b/tools/flang2/flang2exe/main.cpp index 6ae769e3a19..23cff9c096b 100644 --- a/tools/flang2/flang2exe/main.cpp +++ b/tools/flang2/flang2exe/main.cpp @@ -106,7 +106,7 @@ static int dodebug = 0; #define TR(str) #endif -#if DEBUG && !defined(EXTRACTOR) && (defined(X86_64) || defined(TARGET_POWER) || defined(TARGET_ARM)) +#if DEBUG && !defined(EXTRACTOR) && (defined(X86_64) || defined(TARGET_POWER) || defined(TARGET_ARM) || defined(TARGET_RISCV)) #define DEBUGQQ 1 #else #define DEBUGQQ 0 diff --git a/tools/flang2/flang2exe/riscv64/flgdf.h b/tools/flang2/flang2exe/riscv64/flgdf.h new file mode 100644 index 00000000000..b42e9271bb1 --- /dev/null +++ b/tools/flang2/flang2exe/riscv64/flgdf.h @@ -0,0 +1,72 @@ +/* + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + */ + +/* flgdf.h - data definitions for FTN compiler flags */ + +FLG flg = { + false, /* asm = -noasm */ + false, /* list = -nolist */ + true, /* object = -object */ + false, /* xref = -show noxref */ + false, /* code = -show nocode */ + false, /* include = -show noinclude */ + 0, /* debug = -nodebug */ + 1, /* opt = -opt 1 */ + true, /* depchk = -depchk on */ + false, /* depwarn = -depchk warn */ + false, /* dclchk = -nodclchk */ + false, /* locchk = -nolocchk */ + false, /* onetrip = -noonetrip */ + false, /* save = -nosave */ + 1, /* inform = -inform informational */ + 0xFFFFFFFF, /* xoff */ + 0x00000000, /* xon */ + false, /* ucase = -noucase */ + NULL, /* idir == empty list */ + NULL, /* linker_directives == empty list */ + NULL, /* llvm_target_triple == empty ptr */ + NULL, /* target_features == empty ptr */ + 0, /* vscale_range_min = -vscale_range_min 0 */ + 0, /* vscale_range_max = -vscale_range_max 0 */ + false, /* dlines = -nodlines */ + 72, /* extend_source = -noextend_source */ + true, /* i4 = -i4 */ + false, /* line = -noline */ + false, /* symbol = -nosymbol */ + 0, /* profile = no profiling */ + false, /* standard = don't flag non-F77 uses */ + {0}, /* dbg[] */ + true, /* align doubles on doubleword boundary */ + 0, /* astype - assembler syntax - 0-elf, 1-coff */ + false, /* recursive = -norecursive */ + 0, /* ieee: 0 == none: num == bit value for + item (fdiv==1,ddiv==2) */ + 0, /* inline: 0 == none: num == max # ilms */ + 0, /* autoinline */ + 0, /* vect: 0 = none: num == vect item */ + 0, /* little endian */ + false, /* not terse for summary, etc. */ + '_', /* default is to change '$' to '_' */ + {0}, /* x flags */ + false, /* don't quad align "unconstrained objects"; + use natural alignment */ + false, /* anno - don't annotate asm file */ + false, /* qa = -noqa */ + false, /* es = -noes */ + false, /* p = preprocessor does not emit # lines in its output */ + 0, /* def ptr */ + NULL, /* search the standard include */ + false, /* don't allow smp directives */ + false, /* omptarget - don't allow OpenMP Offload directives */ + 25, /* errorlimit */ + false, /* trans_inv */ + 0, /* tpcount */ + {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* tpvalue */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, + "", /* cmdline */ + false, /* qp */ +}; diff --git a/tools/flang2/flang2exe/riscv64/ll_abi.cpp b/tools/flang2/flang2exe/riscv64/ll_abi.cpp new file mode 100644 index 00000000000..ab0e7f09134 --- /dev/null +++ b/tools/flang2/flang2exe/riscv64/ll_abi.cpp @@ -0,0 +1,114 @@ +/* + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + */ + +/* ll_abi.c - Lowering RISC-V function calls to LLVM IR. + */ + +#include "gbldefs.h" +#include "global.h" +#include "symtab.h" +#include "llutil.h" +#include "ll_structure.h" +#include "dtypeutl.h" + +#define DT_VOIDNONE DT_NONE + +#define DT_BASETYPE(dt) (dt) + +void +ll_abi_compute_call_conv(LL_ABI_Info *abi, int func_sptr, int jsra_flags) +{ + abi->call_conv = LL_CallConv_C; + abi->call_as_varargs = false; +} + +typedef struct RISCV_ABI_ArgInfo { + enum LL_ABI_ArgKind kind; + LL_Type *type; + bool is_return_val; +} RISCV_ABI_ArgInfo; + +inline static void +update_arg_info(LL_ABI_ArgInfo *arg, RISCV_ABI_ArgInfo *riscv_arg) +{ + arg->kind = riscv_arg->kind; + if (riscv_arg->type != NULL) { + arg->type = riscv_arg->type; + } +} + +// Classify an integer type for return or arg. +static enum LL_ABI_ArgKind +classify_int(DTYPE dtype) +{ + // Integer types smaller than a register must be sign/zero extended. + // Unsigned char and char are both 8-bit unsigned integers zero-extended. + if (size_of(dtype) < 2) + return LL_ARG_ZEROEXT; + // Short is widened according to its sign. + else if (size_of(dtype) < 4) + return DT_ISUNSIGNED(dtype) ? LL_ARG_ZEROEXT : LL_ARG_SIGNEXT; + // 32-bit ints are always sign-extended. + else if (size_of(dtype) < 8) + return LL_ARG_SIGNEXT; + + return LL_ARG_DIRECT; +} + +// Classify common arguments and return values. +// Values are returned in the same manner as a first named argument of the +// same type would be passed. If such an argument would have been passed by +// reference, the caller allocates memory for the return value, and passes +// the address as an implicit first parameter. +static void +classify_common(LL_Module *module, LL_ABI_Info *abi, RISCV_ABI_ArgInfo *arg, + DTYPE dtype) +{ + if (DT_ISINT(dtype) && size_of(dtype) <= 8) { + arg->kind = classify_int(dtype); + return; + } + if (dtype == DT_VOIDNONE || (DT_ISSCALAR(dtype) && size_of(dtype) <= 8)) { + arg->kind = LL_ARG_DIRECT; + return; + } + if (size_of(dtype) <= 16) { + // Small structs can be returned in up to two GPRs. + arg->kind = LL_ARG_COERCE; + arg->type = ll_coercion_type(abi->module, dtype, size_of(dtype), 8); + } else { + // Large types must be returned in memory via an sret pointer argument. + // Scalars and aggregates larger than 2xXLEN must be passed by reference. + if (arg->is_return_val) { + arg->kind = LL_ARG_INDIRECT; + } else { + arg->kind = LL_ARG_INDIRECT_BUFFERED; + } + } +} + +void +ll_abi_classify_return_dtype(LL_ABI_Info *abi, DTYPE dtype) +{ + RISCV_ABI_ArgInfo tmp_arg_info = {LL_ARG_UNKNOWN, NULL, true}; + + dtype = DT_BASETYPE(dtype); + + classify_common(abi->module, abi, &tmp_arg_info, dtype); + update_arg_info(&(abi->arg[0]), &tmp_arg_info); +} + +void +ll_abi_classify_arg_dtype(LL_ABI_Info *abi, LL_ABI_ArgInfo *arg, DTYPE dtype) +{ + RISCV_ABI_ArgInfo tmp_arg_info = {LL_ARG_UNKNOWN, NULL, false}; + + dtype = DT_BASETYPE(dtype); + + classify_common(abi->module, abi, &tmp_arg_info, dtype); + update_arg_info(arg, &tmp_arg_info); +} diff --git a/tools/flang2/flang2exe/riscv64/machreg.h b/tools/flang2/flang2exe/riscv64/machreg.h new file mode 100644 index 00000000000..0c4b51f0099 --- /dev/null +++ b/tools/flang2/flang2exe/riscv64/machreg.h @@ -0,0 +1,358 @@ +/* + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + */ + +#ifndef MACHREG_H_ +#define MACHREG_H_ + +#include "gbldefs.h" + +extern const int scratch_regs[]; + +/* Define registers for x86-32. + */ + +/*------------------------------------------------------------------------ + * Registers must be listed with the callee-saved registers at the + * end, and must be numbered as follows: + * + * non-callee-saved GP regs: 1 --> (IR_FIRST_CALLEE_SAVE - 1) + * callee-saved GP regs: IR_FIRST_CALLEE_SAVE --> IR_LAST_CALLEE_SAVE + * + * and similarly for the XM registers. This numbering is assumed in + * function 'save_callee_save_regs()'. + *----------------------------------------------------------------------*/ + +/*------------- + * GP registers + *-----------*/ + +typedef enum { + NO_REG = -1, + IR_EAX = 1, + IR_ECX, + IR_EDX, + IR_ESI, /* = 4; first callee-saved on x86-32 */ + IR_EDI, + IR_EBX, + IR_EBP, /* = 7; last callee-saved on x86-32, i.e. 4 c.s. GP regs */ + IR_ESP /* = 8 */ +} IR_REGS; + +#define IR_FIRST_CALLEE_SAVE IR_ESI +#define IR_LAST_CALLEE_SAVE IR_EBP + +#define GP_REG_NAMES \ + { \ + "%badreg0", "%eax", "%ecx", "%edx", "%esi", "%edi", "%ebx", "%ebp", "%esp" \ + } + +#define WORD_REG_NAMES \ + { \ + "%badreg1", "%eax", "%ecx", "%edx", "%esi", "%edi", "%ebx", "%ebp", "%esp" \ + } + +#define HALF_REG_NAMES \ + { \ + "%badreg2", "%ax", "%cx", "%dx", "%si", "%di", "%bx", "%bp", "%sp" \ + } + +#define BYTE_REG_NAMES \ + { \ + "%badreg3", "%al", "%cl", "%dl", "%badreg4", "%badreg5", "%bl", \ + "%badreg6", "%badreg7" \ + } + +/* Synonyms for GP register symbols. + */ +#define IR_RAX IR_EAX +#define IR_RCX IR_ECX +#define IR_RDX IR_EDX +#define IR_RSI IR_ESI +#define IR_RDI IR_EDI +#define IR_RBX IR_EBX +#define IR_FRAMEP IR_EBP +#define IR_STACKP IR_ESP + +#define N_GP_REGS 8 +#define IR_FIRST 1 +#define IR_LAST 8 + +/*--------------------------- + * XMM, YMM and ZMM registers + *-------------------------*/ + +typedef enum { + XR_XMM0 = 1, + XR_XMM1, + XR_XMM2, + XR_XMM3, + XR_XMM4, + XR_XMM5, + XR_XMM6, + XR_XMM7 +} XR_REGS; + +/* 32-bit ABI - no callee-saved xmm registers. Note, the last + * non-callee-saved XM register must be ( XR_FIRST_CALLEE_SAVE - 1 ). + */ +#define XR_FIRST_CALLEE_SAVE 9 /* no callee-saved xmm regs */ +#define XR_LAST_CALLEE_SAVE 8 + +#define XMM_REG_NAMES \ + { \ + "%badxmm", "%xmm0", "%xmm1", "%xmm2", "%xmm3", "%xmm4", "%xmm5", "%xmm6", \ + "%xmm7" \ + } + +#define YMM_REG_NAMES \ + { \ + "%badymm", "%ymm0", "%ymm1", "%ymm2", "%ymm3", "%ymm4", "%ymm5", "%ymm6", \ + "%ymm7" \ + } + +#define ZMM_REG_NAMES \ + { \ + "%badzmm", "%zmm0", "%zmm1", "%zmm2", "%zmm3", "%zmm4", "%zmm5", "%zmm6", \ + "%zmm7" \ + } + +#define MAX_N_XMM_REGS 8 +#define XR_FIRST 1 +#define XR_LAST 8 +#define XR_NUM_REGS 8 /* only used in {hammer,llvm}/src/llvect.c */ + +#define MAX_N_REGS (N_GP_REGS + MAX_N_XMM_REGS) + +/*------------------------------------------------------------------ + * Assembly code representation of register names. These arrays are + * defined and initialised in cgassem.c and read in assem.c, + * cgassem.c, cggenai.c, exp_rte.c and xprolog.c. + *----------------------------------------------------------------*/ + +#define IR_NUM_NAMES N_GP_REGS + 1 /* only used in dwarf2.c! */ + +extern char *gp_reg[N_GP_REGS + 1]; /* GP_REG_NAMES */ +extern char *word_reg[N_GP_REGS + 1]; /* WORD_REG_NAMES */ +extern char *half_reg[N_GP_REGS + 1]; /* HALF_REG_NAMES */ +extern char *byte_reg[N_GP_REGS + 1]; /* BYTE_REG_NAMES */ +extern char *xm_reg[MAX_N_XMM_REGS + 1]; /* XMM_REG_NAMES */ +extern char *ym_reg[MAX_N_XMM_REGS + 1]; /* YMM_REG_NAMES */ +extern char *zm_reg[MAX_N_XMM_REGS + 1]; /* ZMM_REG_NAMES */ + +#define RAX gp_reg[IR_EAX] +#define RBX gp_reg[IR_EBX] +#define RCX gp_reg[IR_ECX] +#define RDX gp_reg[IR_EDX] +#define RDI gp_reg[IR_EDI] +#define RSI gp_reg[IR_ESI] +#define RBP gp_reg[IR_EBP] +#define RSP gp_reg[IR_ESP] + +#define EAX word_reg[IR_EAX] +#define EBX word_reg[IR_EBX] +#define ECX word_reg[IR_ECX] +#define EDX word_reg[IR_EDX] +#define EDI word_reg[IR_EDI] +#define ESI word_reg[IR_ESI] +#define EBP word_reg[IR_EBP] +#define ESP word_reg[IR_ESP] + +/* bobt, july 03 ------------------ I did up to here ..... */ + +#define FR_RETVAL XR_XMM0 +#define SP_RETVAL XR_XMM0 +#define DP_RETVAL XR_XMM0 +#define CS_RETVAL XR_XMM0 +#define CD_RETVAL XR_XMM0 + +#define IR_RETVAL IR_RAX +#define AR_RETVAL IR_RAX +#define MEMARG_OFFSET 8 + +#define MR_MAX_IREG_ARGS 0 +#define MR_MAX_XREG_ARGS 8 +/* not used to pass args */ +#define MR_MAX_FREG_ARGS 0 + +#define MR_MAX_IREG_RES 2 +#define MR_MAX_XREG_RES 2 + +/* Use macros ARG_IR, ARG_XR, etc. + */ +extern int mr_arg_ir[MR_MAX_IREG_ARGS + 1]; /* defd in machreg.c */ +extern int mr_arg_xr[MR_MAX_XREG_ARGS + 1]; /* defd in machreg.c */ +extern int mr_res_ir[MR_MAX_IREG_RES + 1]; +extern int mr_res_xr[MR_MAX_XREG_RES + 1]; + +#define ARG_IR(i) (scratch_regs[i]) /* initialized in machreg.c */ +#define ARG_XR(i) (mr_arg_xr[i]) +#define RES_IR(i) (mr_res_ir[i]) +#define RES_XR(i) (mr_res_xr[i]) + +#define AR(i) IR_RETVAL /* used only for pgftn/386 */ +#define IR(i) ARG_IR(i) +#define SP(i) ARG_XR(i) +#define DP(i) ARG_XR(i) +#define ISP(i) (i + 100) /* not used? */ +#define IDP(i) (i + 100) + +/* Macro for defining alternate-return register for fortran subprograms. + */ +#define IR_ARET IR_RETVAL + +/* Macros for unpacking/packing KR registers. + */ +#define KR_LSH(i) (((i) >> 8) & 0xff) +#define KR_MSH(i) ((i)&0xff) +#define KR_PACK(ms, ls) (((ls) << 8) | (ms)) + +/* Macro for defining the KR register in which the value of a 64-bit integer + * function is returned. + */ +#define KR_RETVAL KR_PACK(IR_EDX, IR_EAX) + +/* Define MR_UNIQ, the number of unique register classes for the machine. + */ +#define MR_UNIQ 3 + +#define GR_THRESHOLD 2 + +/* Macros for defining the global registers in each of the unique register + * classes. For each global set, the lower and upper bounds are specified + * in the form MR_L .. MR_U, where i = 1 to MR_UNIQ. + */ +/***** i386 general purpose regs - allow 3 global *****/ +#define MR_L1 1 +#define MR_U1 3 +#define MR_MAX1 (MR_U1 - MR_L1 + 1) + +/***** i387 floating-point regs - allow 3 global *****/ +#define MR_L2 2 +#define MR_U2 4 +#define MR_MAX2 (MR_U2 - MR_L2 + 1) + +/***** i387 xmm floating-point regs - allow 3 global *****/ +#define MR_L3 2 +#define MR_U3 4 +#define MR_MAX3 (MR_U3 - MR_L3 + 1) + +/* Total number of globals: used by the optimizer for register history + * tables. + */ +#define MR_NUMGLB (MR_MAX1 + MR_MAX2 + MR_MAX3) + +/* Number of integer registers which are available for global + * assignment when calls are or are not present. + */ +#define MR_IR_AVAIL(c) 0 + +/* Define gindex bounds for the set of global irs/ars and scratch + * irs/ars. MUST BE CONSISTENT with mr_gindex(). + */ +#define MR_GI_IR_LOW 0 +#define MR_GI_IR_HIGH (MR_U1 - MR_L1) +#define MR_GI_IS_SCR_IR(i) ((i) > (MR_U1 - MR_L1)) + +/* Machine Register Information - + * + * This information is in two pieces: + * 1. a structure exists for each machine's register class which defines + * the attributes of registers. + * These attributes define a register set with the following properties: + * 1). a set is just an increasing set of numbers, + * 2). scratch registers are allocated in increasing order (towards + * the globals), + * 3). globals are allocated in decreasing order (towards the + * scratch registers). + * 4). the scratch set that can be changed by a procedure + * [min .. first_global-1] + * 5). the scratch set that can be changed by an intrinisic + * [min .. intrinsic] + * + * 2. a structure exists for all of the generic register classes which will + * map a register type (macros in registers.h) to the appropriate + * machine register class. + */ + +/***** Machine Register Table *****/ + +typedef struct { + char min; /* minimum register # */ + char max; /* maximum register # */ + char intrinsic; /* last scratch that can be changed by an intrinsic */ + const char first_global; /* first register # that can be global + * Note that the globals are allocated in increasing + * order (first_global down to last_global). + */ + const char end_global; /* absolute last register # that can be global. */ + /* the following two really define the working set + of registers that can be assigned. */ + char next_global; /* next global register # */ + char last_global; /* last register # that can be global. */ + char nused; /* number of global registers assigned */ + const char mapbase; /* offset in register bit vector where + this class of MACH_REGS begins. */ + const char Class; /* class or type of register. code generator needs + to know what kind of registers these represent. + 'i' (integer), 'f' (float stk), 'x' (float xmm) */ +} MACH_REG; + +/***** Register Mapping Table *****/ + +typedef struct { + char max; /* maximum number of registers */ + char nused; /* number of registers assigned */ + char joined; /* non-zero value if registers are formed from + * multiple machine registers. 1==>next machine + * register is used; other values TBD. + */ + int rcand; /* register candidate list */ + MACH_REG *mach_reg; /* pointer to struct of the actual registers */ + INT const_flag; /* flag controlling assignment of consts */ +} REG; /* [rtype] */ + +/***** Register Set Information for a block *****/ + +typedef struct {/* three -word bit-vector */ + int xr; +} RGSET; + +#define RGSETG(i) rgsetb.stg_base[i] + +#define RGSET_XR(i) rgsetb.stg_base[i].xr + +#define SET_RGSET_XR(i, reg) \ + { \ + RGSET_XR(i) |= (1 << (reg)); \ + } + +#define TST_RGSET_XR(i, reg) ((RGSET_XR(i) >> (reg)) & 1) + +typedef struct { + RGSET *stg_base; + int stg_avail; + int stg_size; +} RGSETB; + +/***** External Data Declarations *****/ + +extern REG reg[]; +extern RGSETB rgsetb; + +/***** External Function Declarations *****/ + + int mr_getnext(int rtype); + int mr_getreg(int rtype); + int mr_get_rgset(); + int mr_gindex(int rtype, int regno); + void mr_end(); + void mr_init(); + void mr_reset_frglobals(); + void mr_reset(int rtype); + void mr_reset_numglobals(int); + +#endif diff --git a/tools/flang2/utils/ilitp/CMakeLists.txt b/tools/flang2/utils/ilitp/CMakeLists.txt index 2fcbb22787e..f2ddf5215e4 100644 --- a/tools/flang2/utils/ilitp/CMakeLists.txt +++ b/tools/flang2/utils/ilitp/CMakeLists.txt @@ -31,9 +31,15 @@ add_custom_command( DEPENDS ilitp ${UTILS_ILI_DIR}/ilitp_atomic.n ${ARCH_DEP_ILI_DIR}/ilitp.n - ${ARCH_DEP_ILI_DIR}/ilitp_longdouble.n ) +if(NOT ${TARGET_ARCHITECTURE} STREQUAL "riscv64") + add_custom_command( + OUTPUT ${UTILS_ILI_BIN_DIR}/schinfo.h ${UTILS_ILI_BIN_DIR}/ilinfodf.h ${UTILS_ILI_BIN_DIR}/iliatt.h + APPEND + DEPENDS ${ARCH_DEP_ILI_DIR}/ilitp_longdouble.n) +endif() + add_custom_target(gen_backend_ili SOURCES ${UTILS_ILI_BIN_DIR}/schinfo.h ${UTILS_ILI_BIN_DIR}/ilinfodf.h ${UTILS_ILI_BIN_DIR}/iliatt.h ) diff --git a/tools/flang2/utils/ilitp/riscv64/ilitp.n b/tools/flang2/utils/ilitp/riscv64/ilitp.n new file mode 100644 index 00000000000..dfb0b1428f8 --- /dev/null +++ b/tools/flang2/utils/ilitp/riscv64/ilitp.n @@ -0,0 +1,5502 @@ +.\"/* +.\" * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +.\" * See https://llvm.org/LICENSE.txt for license information. +.\" * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +.\" * +.\" */ +.NS 13 "X86-32 ILI Definitions" +.sh 2 "Key to ILI Template Listing" +.lp +.de OP +.ip \f(CW\\$1\fP 12n +.. +.ul +ILI Operand Types: +.OP irlnk +link to previous ili with result type ir. +.OP splnk +link to previous ili with result type sp. +.OP dplnk +link to previous ili with result type dp. +.OP arlnk +link to previous ili with result type ar. +.OP krlnk +link to previous ili with result type kr. +.OP qplnk +link to previous ili with result type qp. +.OP cslnk +link to previous ili with result type cs. +.OP cdlnk +link to previous ili with result type cd. +.OP cqlnk +link to previous ili with result type cq. +.OP 128lnk +link to previous ili with result type 128. +.OP 256lnk +link to previous ili with result type 256. +.OP 512lnk +link to previous ili with result type 512. +.OP x87lnk +link to previous ili with result type x87. +.OP cx87lnk +link to previous ili with result type cx87. +.OP lnk +link to previous ili with result type lnk. +.OP ir +integer register number (for x86-32, one of the general purpose registers). +.OP sp +floating-point register number. +.OP dp +double-precision register. +.OP kr +pair of 32 bit integer registers. +.OP cs +single(4+4 bytes) precision complex register. +.OP cd +double(8+8 bytes) precision complex register. +.OP cq +16x2 bytes complex register. +.OP qp +16x2 bytes register. +.OP 128 +128 bits register. +.OP 256 +256 bits register. +.OP 512 +512 bits register. +.OP x87 +x87 register. +.OP cx87 +cx87 register. +.OP ar +Address register (for x86-32, one of the general purpose registers). +.OP stc +16 bit constant. May be interpreted as either signed or unsigned depending +on the machine instruction operand which uses it. +.OP nme +pointer to names table entry for a load or store. +.OP sym +symbol table pointer. + +.de TY +.ip \f(CW\\$1\fP 12n +.. +.lp +.ul +ILI Types (1st attribute of each ILI): +.TY arth +arithmetic operation. +.TY branch +branch operation. +.TY cons +constant. +.TY load +.TY store +.TY define +register define. +.TY proc +function call. +.TY move +register move. +.TY other +.sp +.de CM +.ip \f(CW\\$1\fP 12n +.. +.de RT +.ip \f(CW\\$1\fP 12n +.. +.lp +.ul +Commutivity attribute (2nd attribute of each ILI): +.CM comm +Commutative operation. +.CM null +Not commutative. +.sp +.lp +.ul +ILI result type (3rd attribute of each ILI): +.RT lnk +no result, but ili is pointed-to by link. +.RT ir +result goes into an integer register. +.RT sp +result goes into a floating-point register. +.RT dp +double-precision floating-point. +.RT ar +address register result. +.RT trm +this ili does not produce a value and cannot be pointed to by any +link operand of another ili. +.de IA +.ip \f(CW\\$1\fP 12n +.. +.lp +.ul +Other ILI Attributes: +.IA dom +specifies that this ili is a dominator ili. +.IA cse +specifies that this ili is a candidate for constant subexpression elimination. +An ili is not allowed to have both the cse and the dom attributes. +.IA ssenme +indicates that this is an sse operation with operand 1 an arlnk field and +operand 3 a nme field. +.sp +.de CA +.ip \f(CW\\$1\fP 12n +.. +.lp +.sp 2 +.br +.sp 2 +.sh 2 "ILI Definitions" +.ft CW +.sz 8 +.nr IN 0 1 +.\" +.\" define macro used to define ilo: +.de IL +.nr IN +1 +.in 0 +.ne 5 +.nf +\\n(IN. \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 +.in 5 +.fi +.. +.de FL +.sp +.in 0 +.ne 5 +.nf +XX. \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 - (Fortran only) +.in 5 +.fi +.. +.de CL +.sp +.in 0 +.ne 5 +.nf +XX. \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 - (C only) +.in 5 +.fi +.. +.de OL +.sp +.in 0 +.ne 5 +.nf +XX. \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 - (OpenCL only) +.in 5 +.fi +.. +.\" +.\" define macro used to define ilo attributes: +.de AT +.br +Attributes: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 +.br +.. +.de CG +.br +Code Generator Attributes: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 +.sp +.br +.. +.\" +.\" define macro used to define machine instruction for an ilo: +.ta 33 36 40 44 48 52 56 60 64 68 72 76 80 +.\" begin ilo definitions: +.\" + +.IL ICON sym +32-bit integer constant. +The value is pulled from the CONVAL2 field of sym. +.AT cons null ir cse +.CG move "mov" 'l' + +.IL ACON sym +Load address constant into address register. +\'sym' must be a symtab ptr to an address constant. +.AT cons null ar cse +.CG notAILI + +.IL ACON_PIC_EXTRN sym +Address constant used for PIC generation. It represents the load +of the address of an external variable from the GOT table. +\'sym' is the symbol table pointer for the external variable, NOT +an address constant symbol. +.AT cons null ar cse +.CG CGonly "mov" 'l' asm_special + +.IL ACON_STATIC sym sym +Represents the address of a static or external variable, with optional +32-bit signed integer offset. The first sym points to a static or external +variable, or a label, and the second to a symbol table 32-bit integer constant. +.AT cons null ar cse +.CG CGonly "lea" 'l' + +.IL ACON_AUTO sym sym +The address of a stack variable, the first sym is a stack variable and the +second is a 32-bit integer constant. +.AT cons null ar cse +.CG CGonly "lea" 'l' + +.IL KCON sym +64-bit integer constant. 'sym' is a symbol table constant of type +DT_INT or DT_INT8. +.AT cons null kr cse +.CG notAILI 'q' + +.IL SCMPLXCON sym +Single-precision complex constant. +.AT cons null cs cse +.CG "movsd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL DCMPLXCON sym +Double-precision complex constant. +.AT cons null cd cse +.CG "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL ACEXT sym nme +Label address. +\'sym' is address constant for label symbol. +\'nme' is zero. +.AT cons null ar cse +.CG "mov" + +.IL FCON sym +Single-precision floating-point constant. +.AT cons null sp cse +.CG "movss" move + +.IL DCON sym +Double-precision floating-point constant. +.AT cons null dp cse +.CG "movsd" move + +.IL LD arlnk nme stc +\'arlnk' points to an address expression. +.br +\'nme' points to the names table entry of the variable being referenced. +.br +\'stc' size modifier of the memory operation - one of the MSZ_ macros +defined in ili.h. +For the code generator, possible values are: + MSZ_SBYTE signed byte + MSZ_UBYTE unsigned byte + MSZ_SHWORD signed half-word + MSZ_UHWORD unsigned half-word + MSZ_SWORD signed word (32-bit) + MSZ_UWORD unsigned word +.AT load null ir +.CG "mov" move + +.IL LDSP arlnk nme stc +Load single-precision floating value. 'stc' is not used. +.AT load null sp +.CG "movss" move + +.IL LDDP arlnk nme stc +Load double precision value. 'stc' is not used. +.AT load null dp +.CG "movsd" move + +.IL LDSCMPLX arlnk nme stc +Load single precision complex value. 'stc' is not used. +.AT load null cs +.CG "movsd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL LDDCMPLX arlnk nme stc +Load double precision complex value. 'stc' is not used. +.AT load null cd +.CG "movups" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL LDQ arlnk nme stc +Load m128 value. 'stc' is not used. +.AT load null dp +.CG "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL LDQU arlnk nme stc +Load unaligned m128 value. 'stc' is not used. +.AT load null dp +.CG "movupd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL LD256 arlnk nme stc +Load m256 value. 'stc' is not used. +Will generate the aligned case for LD256. +.AT load null dp +.CG "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL LD256A arlnk nme stc +Load aligned m256 value. 'stc' is not used. +Will generate the aligned case for LD256. +.AT load null dp +.CG notAILI + +.IL LD256U arlnk nme stc +Load unaligned m256 value. 'stc' is not used. +.AT load null dp +.CG "movupd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2 + +.IL LDA arlnk nme +Load address register from memory location whose address +is represented by op1. +For x86-32 compilers, LDA's are replaced by LD's by cgoptim1. +.AT load null ar +.CG notAILI + +.IL LDKR arlnk nme stc +Load 64 bit integer value into register pair. 'stc' is not used. +.AT load null kr +.CG notAILI 'q' + +.IL INEG irlnk +Signed integer32 negate. +.AT arth null ir cse +.CG memdest ccarith "neg" 'l' + +.IL UINEG irlnk +Unsigned integer32 negate. +.AT arth null ir cse +.CG notCG replaceby INEG + +.IL KNEG krlnk +Signed integer64 negate. (note - don't allow the memdest optimization) +.AT arth null kr cse +.CG notAILI 'q' + +.IL UKNEG krlnk +Unsigned integer64 negate. +.AT arth null kr cse +.CG notCG replaceby KNEG + +.IL FNEG splnk +Single-precision floating-point negate. +.AT arth null sp cse +.CG notAILI + +.IL SCMPLXNEG cslnk +Single-precision complex negate. +.AT arth null cs cse +.CG notAILI + +.IL DCMPLXNEG cdlnk +Double-precision complex negate. +.AT arth null cd cse +.CG notAILI + +.IL FXOR splnk splnk +May be used to implement FNEG operation. This operation is non-commutative so +we can ensure that a memory operand is not used. +.AT arth null sp cse +.CG notCG "xorps" sse_avx + +.IL DNEG dplnk +Double-precision negate. +.AT arth null dp cse +.CG notAILI + +.IL SCMPLXXOR cslnk cslnk +This only appears in the LILIs and AILIs, not in shared ILIs. It is +generated in cgoptim1.c:lili_peephole_opts_2() by transforming +SCMPLXNEG( op1 ) into an SCMPLXXOR LILI in order to negate 'op1' by +XORing its sign bits with 1. This ILI is specified as non-commutative +(i.e. 'null', not 'comm') for reasons explained in that function. +.AT arth null cs cse +.CG CGonly "xorps" sse_avx + +.IL DCMPLXXOR cdlnk cdlnk +This only appears in the LILIs and AILIs, not in shared ILIs. It is +generated in cgoptim1.c:lili_peephole_opts_2() by transforming +DCMPLXNEG( op1 ) into a DCMPLXXOR LILI in order to negate 'op1' by +XORing its sign bits with 1. This ILI is specified as non-commutative +(i.e. 'null', not 'comm') for reasons explained in that function. +.AT arth null cd cse +.CG CGonly "xorpd" sse_avx + +.IL SCMPLXCONJG cslnk +Single-precision complex conjugate. +.AT arth null cs cse +.CG "xorps" + +.IL DCMPLXCONJG cdlnk +Double-precision complex conjugate. +.AT arth null cd cse +.CG "xorpd" + +.IL DXOR dplnk dplnk +May be used to implement DNEG operation. +.AT arth null dp cse +.CG notCG "xorpd" sse_avx + +.IL IABS irlnk +Integer absolute value. Expanded into shift-xor-sub sequence. +.AT arth null ir cse +.CG notCG + +.IL KABS krlnk +Integer64 absolute value. Shift-xor-sub AILI sequence is generated. +.AT arth null kr cse +.CG notAILI 'q' + +.IL FABS splnk +Real (single-precision) absolute value. +.AT arth null sp cse +.CG notAILI + +.IL FAND splnk splnk +Used to implement FABS operation. This operation is non-commutative so +we can ensure that a memory operand is not used. +.AT arth null sp cse +.CG "andps" sse_avx + +.IL DABS dplnk +Double precision absolute value. +.AT arth null dp cse +.CG notAILI + +.IL DAND dplnk dplnk +Used to implement DABS operation. +.AT arth null dp cse +.CG CGonly "andpd" sse_avx + +.IL NOT irlnk +32 bit bitwise not. +.AT arth null ir cse +.CG memdest "not" 'l' + +.IL UNOT irlnk +Unsigned bitwise negation of 32 bit bitwise not. +.AT arth null ir cse +.CG notCG replaceby NOT + +.IL KNOT krlnk +64 bit bitwise not. +.AT arth null kr cse +.CG memdest notAILI 'q' + +.IL UKNOT krlnk +64 bit bitwise not. +.AT arth null kr cse +.CG notCG replaceby KNOT + +.IL FSQRT splnk +Single-precision floating-point square root. +.AT arth null sp cse +.CG "sqrtss" + +.IL DSQRT dplnk +Double-precision square root. +.AT arth null dp cse +.CG "sqrtsd" + +.IL RCPSS splnk +Single-precision approximation to reciprocal. +.AT arth null sp cse +.CG "rcpss" + +.IL RSQRTSS splnk +Single-precision approximation to reciprocal square root. +.AT arth null sp cse +.CG "rsqrtss" + +.IL CMPNEQSS splnk splnk +Used for single-precision square root approximation. +.AT arth null sp cse +.CG "cmpneqss" sse_avx + +.IL FNSIN splnk +Utility ili: only referenced by the 'alt' field of an FSIN ili; +always points to an FSINCOS ili. +.AT arth null sp cse +.CG notAILI + +.IL DNSIN dplnk +Utility ili: only referenced by the 'alt' field of an DSIN ili; +always points to an DSINCOS ili. +.AT arth null dp cse +.CG notAILI + +.IL FSIN splnk +Single precision floating point sine. Implemented as a library call (by CG). +.AT arth null sp cse +.CG notAILI + +.IL DSIN dplnk +Double precision sine. Implemented as a library call (by CG). +.AT arth null dp cse +.CG notAILI + +.IL FNCOS splnk +Utility ili: only referenced by the 'alt' field of an FCOS ili; +always points to an FSINCOS ili. +.AT arth null sp cse +.CG notAILI + +.IL DNCOS dplnk +Utility ili: only referenced by the 'alt' field of an DCOS ili; +always points to an DSINCOS ili. +.AT arth null dp cse +.CG notAILI + +.IL FCOS splnk +Single precision floating point cosine. Implemented as library call (by CG). +.AT arth null sp cse +.CG notAILI + +.IL DCOS dplnk +Double precision cosine. Implemented as library call (by CG). +.AT arth null dp cse +.CG notAILI + +.IL FSINCOS splnk +Used to implement SINCOS optimization (single precision). Implemented as +a library call (by CG). +.AT arth null sp cse +.CG notAILI + +.IL DSINCOS dplnk +Used to implement SINCOS optimization (double precision). Implemented as +a library call (by CG). +.AT arth null dp cse +.CG notAILI + +.IL FTAN splnk +Single-precision floating-point tangent. +.AT arth null sp cse +.CG notCG + +.IL DTAN dplnk +Double-precision tangent. +.AT arth null dp cse +.CG notCG + +.IL FLOG splnk +Single-precision floating-point natural logarithm. +.AT arth null sp cse +.CG notCG + +.IL DLOG dplnk +Double-precision natural logarithm. +.AT arth null dp cse +.CG notCG + +.IL FLOG10 splnk +Single-precision floating-point common logarithm. +.AT arth null sp cse +.CG notCG + +.IL DLOG10 dplnk +Double-precision common logarithm. +.AT arth null dp cse +.CG notCG + +.IL FEXP splnk +Single-precision floating-point exponential. +.AT arth null sp cse +.CG notCG + +.IL DEXP dplnk +Double-precision exponential. +.AT arth null dp cse +.CG notCG + +.IL FACOS splnk +Single-precision floating-point arccosine. +.AT arth null sp cse +.CG notCG + +.IL DACOS dplnk +Double-precision arccosine. +.AT arth null dp cse +.CG notCG + +.IL FASIN splnk +Single-precision floating-point arcsine. +.AT arth null sp cse +.CG notCG + +.IL DASIN dplnk +Double-precision arcsine. +.AT arth null dp cse +.CG notCG + +.IL FATAN splnk +Single-precision floating-point arctangent. +.AT arth null sp cse +.CG notCG + +.IL DATAN dplnk +Double-precision arctangent. +.AT arth null dp cse +.CG notCG + +.IL FATAN2 splnk splnk +Single-precision floating-point two-argument arctangent. +.AT arth null sp cse +.CG notCG + +.IL DATAN2 dplnk dplnk +Double-precision two-argument arctangent. +.AT arth null dp cse +.CG notCG + +.IL FSINH splnk +Single-precision floating-point hyperbolic sin +.AT arth null sp cse +.CG notCG + +.IL DSINH dplnk +Double-precision hyperbolic sin +.AT arth null dp cse +.CG notCG + +.IL FCOSH splnk +Single-precision floating-point hyperbolic cos +.AT arth null sp cse +.CG notCG + +.IL DCOSH dplnk +Double-precision hyperbolic cos +.AT arth null dp cse +.CG notCG + +.IL FTANH splnk +Single-precision floating-point hyperbolic tan +.AT arth null sp cse +.CG notCG + +.IL DTANH dplnk +Double-precision hyperbolic tan +.AT arth null dp cse +.CG notCG + +.IL FNEWT splnk splnk splnk +Single-precision floating-point multiply used for single divides. +Not used by the x86-32 compilers. +.AT arth null sp cse +.CG notCG + +.IL DNEWT dplnk dplnk dplnk +Double-precision floating-point multiply used for double divides. +Not used by the x86-32 compilers. +.AT arth null dp cse +.CG notCG + +.IL NINT splnk +Real NINT. +.AT arth null ir cse +.CG notCG + +.IL IDNINT dplnk +Double NINT. +.AT arth null ir cse +.CG notCG + +.IL ISNAN splnk +Real ISNAN. +.AT arth null ir cse +.CG notCG + +.IL IDISNAN dplnk +Double ISNAN. +.AT arth null ir cse +.CG notCG + +.IL IQISNAN qplnk +Quad ISNAN. +.AT arth null ir cse +.CG notCG + +.IL ISIGN irlnk irlnk +Integer sign intrinsic. +.AT arth null ir cse +.CG notCG + +.IL SIGN splnk splnk +Real sign. +.AT arth null sp cse +.CG notCG + +.IL DSIGN dplnk dplnk +Double sign. +.AT arth null dp cse +.CG notCG + +.IL IDIM irlnk irlnk +Integer dim intrinsic. +.AT arth null ir cse +.CG notCG + +.IL FDIM splnk splnk +Real dim. +.AT arth null sp cse +.CG notCG + +.IL DDIM dplnk dplnk +Double dim. +.AT arth null dp cse +.CG notCG + +.IL FFLOOR splnk +Real FLOOR. +.AT arth null sp cse +.CG "roundss" sse_avx + +.IL DFLOOR dplnk +Double FLOOR. +.AT arth null dp cse +.CG "roundsd" sse_avx + +.IL FCEIL splnk +Real CEILING. +.AT arth null sp cse +.CG "roundss" sse_avx + +.IL DCEIL dplnk +Double CEILING. +.AT arth null dp cse +.CG "roundsd" sse_avx + +.IL AINT splnk +Single precision trunction. +.AT arth null sp cse +.CG notAILI + +.IL DINT dplnk +Double precision trunction. +.AT arth null dp cse +.CG notAILI + +.IL SCMPLXEXP cslnk +Single-precision complex exponential. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXEXP cdlnk +Double-precision complex exponential. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXCOS cslnk +Single-precision complex cosine. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXCOS cdlnk +Double-precision complex cosine. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXSIN cslnk +Single-precision complex sine. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXSIN cdlnk +Double-precision complex sine. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXTAN cslnk +Single-precision complex tangent. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXTAN cdlnk +Double-precision complex tangent. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXACOS cslnk +Single-precision complex arccosine. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXACOS cdlnk +Double-precision complex arccosine. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXASIN cslnk +Single-precision complex arcsine. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXASIN cdlnk +Double-precision complex arcsine. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXATAN cslnk +Single-precision complex arctangent. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXATAN cdlnk +Double-precision complex arctangent. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXCOSH cslnk +Single-precision complex hyperbolic cos. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXCOSH cdlnk +Double-precision complex hyperbolic cos. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXSINH cslnk +Single-precision complex hyperbolic sin. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXSINH cdlnk +Double-precision complex hyperbolic sin. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXTANH cslnk +Single-precision complex hyperbolic tan. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXTANH cdlnk +Double-precision complex hyperbolic tan. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXLOG cslnk +Single-precision complex natural logarithm. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXLOG cdlnk +Double-precision complex natural logarithm. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXSQRT cslnk +Single-precision complex square root. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXSQRT cdlnk +Double-precision complex square root. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXPOW cslnk cslnk +Single-precision complex raised to a single-precision complex power. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXPOW cdlnk cdlnk +Double-precision complex raised to a double-precision complex power. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXPOWI cslnk irlnk +Single-precision complex raised to an integer power. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXPOWI cdlnk irlnk +Double-precision complex raised to an integer power. +.AT arth null cd cse +.CG notCG + +.IL SCMPLXPOWK cslnk krlnk +Single-precision complex raised to an integer power. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXPOWK cdlnk krlnk +Double-precision complex raised to an integer power. +.AT arth null cd cse +.CG notCG + +.IL ITOUI irlnk +Integer to unsigned integer conversion. +Treated as a nop by cglinear. +.AT arth null ir cse +.CG notCG + +.IL UITOI irlnk +Unsigned integer to integer conversion. +Treated as a nop by cglinear. +.AT arth null ir cse +.CG notCG + +.IL IKMV irlnk +Move an signed integer value to a register pair with sign extension. +Used for I to K and I to UK conversions. +.AT move null kr cse +.CG notAILI 'q' + +.IL UIKMV irlnk +Move an unsigned integer register to a register pair. +.AT move null kr cse +.CG notAILI 'q' + +.IL KIMV krlnk +Move a value in a register pair to an integer register with truncation. +Used also for K to UI, UK to I, and UK to UI conversions. +.AT move null ir cse +.CG notAILI 'l' + +.IL IAMV irlnk +Move an integer reg into an address reg. +Treated as a nop by cglinear. +.AT move null ar cse +.CG notCG + +.IL AIMV arlnk +Move an address register to a integer register. +Treated as a nop by cglinear. +.AT move null ir cse +.CG notCG + +.IL KAMV krlnk +Move an 64 bit integer reg into an address reg. +.AT move null ar cse +.CG notCG replaceby KIMV + +.IL AKMV arlnk +Move an address register to a register pair (no sign extension). +.AT move null kr cse +.CG notCG replaceby UIKMV + +.IL MOVSB irlnk +Load signed byte into 32 bit register. +.AT move null ir +.CG CGonly asm_special "movsb" 'l' + +.IL MOVZB irlnk +Load unsigned byte into 32 bit register. +.AT move null ir +.CG CGonly asm_special "movzb" 'l' + +.IL MOVSW irlnk +Load signed halfword into 32 bit register. +.AT move null ir +.CG CGonly asm_special "movsw" 'l' + +.IL MOVZW irlnk +Load unsigned halfword into 32 bit register. +.AT move null ir +.CG CGonly asm_special "movzw" 'l' + +.IL FLOAT irlnk +Integer to single-precision floating-point conversion. +.AT arth null sp cse +.CG "cvtsi2ss" 'l' + +.IL FLOATU irlnk +Unsigned integer to single-precision floating-point conversion. +Implemented by library function. (?) +.AT arth null sp cse +.CG notCG + +.IL FLOATK krlnk +Integer64 to single-precision real conversion. +.AT arth null sp cse +.CG notCG + +.IL FLOATUK krlnk +Unsigned integer64 to single-precision real conversion. +.AT arth null sp cse +.CG notCG + +.IL DFLOAT irlnk +Integer to double-precision conversion. +.AT arth null dp cse +.CG "cvtsi2sd" 'l' + +.IL DFLOATU irlnk +Unsigned integer to double-precision conversion. +.AT arth null dp cse +.CG notCG + +.IL DFLOATK krlnk +Integer64 to double-precision conversion. +.AT arth null dp cse +.CG notCG + +.IL DFLOATUK krlnk +Unsigned integer64 to double-precision conversion. +.AT arth null dp cse +.CG notCG + +.IL FIX splnk +Single precision floating-point to integer conversion. +.AT arth null ir cse +.CG "cvttss2si" 'l' + +.IL UFIX splnk +Single precision floating-point to unsigned integer conversion. +Implemented by a library function. +.AT arth null ir +.CG notCG + +.IL FIXK splnk +Single precision floating-point to integer64 conversion. +Implemented by a library function. +.AT arth null kr cse +.CG notCG + +.IL FIXUK splnk +Single precision to unsigned integer64 conversion. +Implemented by a library function. +.AT arth null kr cse +.CG notCG + +.IL DFIX dplnk +Double-precision to integer conversion. +.AT arth null ir cse +.CG "cvttsd2si" 'l' + +.IL DFIXU dplnk +Double precision to unsigned integer conversion. +Implemented by a library function. +.AT arth null ir cse +.CG notCG + +.IL DFIXK dplnk +Double-precision floating-point to integer64 conversion. +Implemented by a library function. +.AT arth null kr cse +.CG notCG + +.IL DFIXUK dplnk +Double-precision floating-point to unsigned integer64 conversion. +Implemented by a call to a library function. +.AT arth null kr cse +.CG notCG + +.IL SNGL dplnk +Double-precision to single conversion. +.AT arth null sp cse +.CG "cvtsd2ss" + +.IL DBLE splnk +Single to double-precision conversion. +.AT arth null dp cse +.CG "cvtss2sd" + +.IL PSNGL arlnk xmm nme +Convert 2 double-precision floating-point values from memory location +denoted by arlnk into 2 single-precision floating-point values into +the low 64-bits of the xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "cvtpd2ps" ssedp +.SI vector lat(10) + +.IL PDBLE arlnk xmm nme +Convert 2 single-precision floating-point values from memory location +denoted by arlnk into 2 double-precision floating-point values into +the xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "cvtps2pd" ssedp +.SI double lat(5) + +.IL PSNGLX xmm xmm +Convert 2 double-precision floating-point values in xmm1 into +2 single-precision floating-point values into the +low-order 64-bits of the xmm register denoted by xmm2. +.AT other null trm +.CG terminal "cvtpd2ps" ssedp +.SI vector lat(8) + +.IL PDBLEX xmm xmm +Convert 2 single-precision floating-point values from the low +64-bits of xmm1 into 2 double-precision floating-point values +into the xmm register denoted by xmm2. +.AT other null trm +.CG terminal "cvtps2pd" ssedp +.SI double lat(3) + +.IL IR2SP irlnk +Move integer to xmm register without floating. +.AT arth null sp cse +.CG 'l' asm_special + +.IL KR2SP krlnk +To be eliminated? +.AT arth null sp +.CG notCG + +.IL KR2DP krlnk +Transfer a value from a integer64 register to a dp register +(no conversion performed). +.AT arth null dp +.CG notAILI + +.IL KR2CS krlnk +Transfer a value from a integer64 register to a dp register +(no conversion performed). +.AT arth null cs +.CG notAILI + +.IL SP2IR splnk +Move single-precision floating-point value to integer register without +conversion. +.AT arth null ir cse +.CG 'l' asm_special + +.IL SP2KR splnk +Not used. +.AT arth null kr +.CG notCG + +.IL DP2KR dplnk +Transfer a value from a double floating-point register to integer64 register. +(no conversion performed). +.AT arth null kr +.CG notAILI 'q' + +.IL CS2KR cslnk +Transfer a value from a double floating-point register to integer64 register. +(no conversion performed). +.AT arth null kr +.CG notAILI 'q' + +.IL ROTL irlnk irlnk +.AT arth null ir cse +.CG ccarith "rol" 'l' + +.IL ROTR irlnk irlnk +.AT arth null ir cse +.CG ccarith "ror" 'l' + +.IL IADD irlnk irlnk +Signed integer addition. +.AT arth comm ir cse +.CG memdest ccarith "add" 'l' + +.IL UIADD irlnk irlnk +Unsigned integer addition. +.AT arth comm ir cse +.CG memdest ccarith "add" 'l' + +.IL KADD krlnk krlnk +Signed integer64 addition. Implemented by IADD/ADC combination. +.AT arth comm kr cse +.CG memdest notAILI 'q' + +.IL UKADD krlnk krlnk +Unsigned integer64 addition. +.AT arth comm kr cse +.CG notCG replaceby KADD + +.IL ADC +Signed integer addition with carry. +.AT arth comm ir cse +.CG CGonly "adc" 'l' ccmod + +.IL AADD arlnk arlnk stc +Add two address register values. +The stc operand is not used by the x86-32 code generator. +.AT arth null ar cse +.CG notCG replaceby IADD + +.IL FADD splnk splnk +Single-precision floating-point addition. +.AT arth comm sp cse +.CG "addss" sse_avx + +.IL DADD dplnk dplnk +Double-precision floating-point addition. +.AT arth comm dp cse +.CG "addsd" sse_avx + +.IL SCMPLXADD cslnk cslnk +Single-precision complex addition. +.AT arth comm cs cse +.CG "addps" sse_avx +.SI double fadd lat(5:7) + +.IL DCMPLXADD cdlnk cdlnk +Double-precision complex addition. +.AT arth comm cd cse +.CG "addpd" sse_avx +.SI double fadd lat(5:7) + +.IL ISUB irlnk irlnk +Signed 32-bit integer subtraction. +.AT arth null ir cse +.CG memdest ccarith "sub" 'l' + +.IL UISUB irlnk irlnk +Unsigned integer subtract. op1 - op2. +.AT arth null ir cse +.CG memdest ccarith "sub" 'l' + +.IL KSUB krlnk krlnk +Signed integer64 subtraction. Implemented by ISUB/SBB combination. +.AT arth null kr cse +.CG memdest notAILI 'q' + +.IL UKSUB krlnk krlnk +Unsigned integer64 subtraction. +.AT arth null kr cse +.CG notCG replaceby KSUB + +.IL SBB +Signed 32-bit integer subtraction with borrow. +.AT arth null ir cse +.CG CGonly "sbb" 'l' ccmod + +.IL ASUB arlnk arlnk stc +Subtract two address register values. The stc operand is not used. +.AT arth null ar cse +.CG notCG replaceby ISUB + +.IL FSUB splnk splnk +Single-precision floating-point subtraction. +.AT arth null sp cse +.CG "subss" sse_avx + +.IL FSUBR splnk splnk +Single-precision floating-point subtraction - operands reversed +(used by llvect.c as a convenience). +.AT arth null sp cse +.CG notCG + +.IL DSUB dplnk dplnk +Double-precision floating-point subtraction. +.AT arth null dp cse +.CG "subsd" sse_avx + +.IL SCMPLXSUB cslnk cslnk +Single-precision complex subtraction. +.AT arth null cs cse +.CG "subps" sse_avx +.SI double fadd lat(7:5) + +.IL DCMPLXSUB cdlnk cdlnk +Double-precision complex subtraction. +.AT arth null cd cse +.CG "subpd" sse_avx +.SI double fadd lat(7:5) + +.IL IMUL irlnk irlnk +Integer Multiply. It'a a bug to give this opcode the ccarith or +cclogical attribute. +.AT arth comm ir cse +.CG "imul" 'l' ccmod + +.IL UIMUL irlnk irlnk +Unsigned integer multiply. Same as signed. +.AT arth comm ir cse +.CG notCG replaceby IMUL + +.IL IMULH irlnk irlnk +Integer multiply, high 32-bits of product as result +.AT arth comm ir cse +.CG "imul" 'l' ccmod + +.IL KMULH krlnk krlnk +Integer64 Multiply, high 64-bits of product returned. +.AT other comm kr cse +.CG "imul" 'q' ccmod +.SI direct lat(8) + +.IL UIMULH irlnk irlnk +Integer multiply, high 32-bits of product as result +.AT arth comm ir cse +.CG "mul" 'l' ccmod + +.IL KMUL krlnk krlnk +Integer64 Multiply. Implemented by library function. +.AT arth comm kr cse +.CG asm_nop + +.IL UKMUL krlnk krlnk +Unsigned integer64 Multiply. Implemented by library function. +.AT arth comm kr cse +.CG notCG replaceby KMUL + +.IL UKMULH krlnk krlnk +Integer64 Multiply, high 64-bits of product returned. +.AT other comm kr cse +.CG "mul" 'q' ccmod +.SI direct lat(8) + +.IL FMUL splnk splnk +Single-precision floating-point multiply. +.AT arth comm sp cse +.CG "mulss" sse_avx + +.IL DMUL dplnk dplnk +Double-precision multiply. +.AT arth comm dp cse +.CG "mulsd" sse_avx + +.IL SCMPLXMUL cslnk cslnk +Single-complex multiply. +.AT arth comm cs cse +.CG sse_avx asm_special + +.IL DCMPLXMUL cdlnk cdlnk +Double-complex multiply. +.AT arth comm cd cse +.CG sse_avx asm_special + +.IL IDIV irlnk irlnk +Signed integer divide. +.AT arth null ir cse +.CG notCG + +.IL UIDIV irlnk irlnk +Unsigned integer divide. +.AT arth null ir cse +.CG notCG + +.IL KDIV krlnk krlnk +Signed integer64 divide. +.AT arth null kr cse +.CG notCG + +.IL UKDIV krlnk krlnk +Unsigned integer64 divide. +.AT arth null kr cse +.CG notCG + +.IL IDIVZ irlnk irlnk +Signed integer divide where divide by zero does not fault. +.AT arth null ir cse +.CG notCG + +.IL UIDIVZ irlnk irlnk +Unsigned integer divide where divide by zero does not fault. +.AT arth null ir cse +.CG notCG + +.IL KDIVZ krlnk krlnk +Signed integer64 divide where divide by zero does not fault. +.AT arth null kr cse +.CG notCG + +.IL UKDIVZ krlnk krlnk +Unsigned integer64 divide where divide by zero does not fault. +.AT arth null kr cse +.CG notCG + +.IL IDIVZR irlnk irlnk +Signed integer divide where the remainder is zero +.AT arth null ir cse +.CG notCG + +.IL KDIVZR krlnk krlnk +Signed integer64 divide where the remainder is zero +.AT arth null kr cse +.CG notCG + +.IL QUOREM irlnk irlnk +Represents an integer divide and/or mod operation. Use of this ili allows +a single divide instruction to both a divide and mod result. +.AT arth null ir cse +.CG notAILI 'l' + +.IL KQUOREM krlnk krlnk +Represents a long divide and/or mod operation. Use of this ili allows +a single divide instruction to both a divide and mod result. +.AT arth null kr cse +.CG notCG + +.IL NIDIV irlnk +Signed integer divide that points to QUOREM. Result is in register %eax. +.AT arth null ir cse +.CG "idiv" 'l' ccmod + +.IL NUIDIV irlnk +Unsigned integer divide that points to QUOREM. Result is in register %eax. +.AT arth null ir cse +.CG "div" 'l' ccmod + +.IL NKDIV krlnk +Signed integer64 divide that points to QUOREM. Result is in register %rax. +.AT arth null kr cse +.CG notCG + +.IL NUKDIV krlnk +Unsigned integer64 divide that points to QUOREM. Result is in register %rax. +.AT arth null kr cse +.CG notCG + +.IL FDIV splnk splnk +Single-precision divide. +.AT arth null sp cse +.CG "divss" sse_avx + +.IL FDIVR splnk splnk +Single-precision divide - operands reversed (used by llvect.c +as a convenience). +.AT arth null sp cse +.CG notCG + +.IL DDIV dplnk dplnk +Double divide. +.AT arth null dp cse +.CG "divsd" sse_avx + +.IL SCMPLXDIV cslnk cslnk +Single precision complex divide. +.AT arth null cs cse +.CG notCG + +.IL DCMPLXDIV cdlnk cdlnk +Double precision complex divide. +.AT arth null cd cse +.CG notCG + +.IL MOD irlnk irlnk +Integer remainder. +.AT arth null ir cse +.CG notCG + +.IL UIMOD irlnk irlnk +Unsigned integer mod. +.AT arth null ir cse +.CG notCG + +.IL KMOD krlnk krlnk +Integer64 remainder. +.AT arth null kr +.CG notCG + +.IL KUMOD krlnk krlnk +Integer64 remainder. +.AT arth null kr +.CG notCG + +.IL MODZ irlnk irlnk +Integer remainder where divide by zero does not fault. +.AT arth null ir cse +.CG notCG + +.IL UIMODZ irlnk irlnk +Unsigned integer mod where divide by zero does not fault. +.AT arth null ir cse +.CG notCG + +.IL KMODZ krlnk krlnk +Integer64 remainder where divide by zero does not fault. +.AT arth null kr +.CG notCG + +.IL KUMODZ krlnk krlnk +Integer64 remainder where divide by zero does not fault. +.AT arth null kr +.CG notCG + +.IL NMOD irlnk +Integer remainder that points to a QUOREM ili. Result is in register %edx. +.AT arth null ir cse +.CG "idiv" 'l' ccmod + +.IL NUIMOD irlnk +Unsigned integer mod that points to QUOREM ili. Result is in register %edx. +.AT arth null ir cse +.CG "div" 'l' ccmod + +.IL NKMOD krlnk +Integer remainder that points to a QUOREM ili. Result is in register %rdx. +.AT arth null kr cse +.CG notCG + +.IL NUKMOD krlnk +Unsigned integer mod that points to QUOREM ili. Result is in register %rdx. +.AT arth null kr cse +.CG notCG + +.IL FMOD splnk splnk +Single-precision mod. +.AT arth null sp cse +.CG notCG + +.IL DMOD dplnk dplnk +Double-precision mod. +.AT arth null dp cse +.CG notCG + +.IL IMAX irlnk irlnk +Integer maximum value. Expanded in-line by Code Generator. +.AT arth comm ir cse +.CG asm_special "cmpl" 'l' ccmod + +.IL UIMAX irlnk irlnk +Unsigned integer maximum value. Expanded in-line by Code Generator. +.AT arth comm ir cse +.CG notCG + +.IL IMIN irlnk irlnk +Integer minimum value. Expanded in-line by Code Generator. +.AT arth comm ir cse +.CG asm_special "cmpl" 'l' ccmod + +.IL UIMIN irlnk irlnk +Unsigned integer minimum value. Expanded in-line by Code Generator. +.AT arth comm ir cse +.CG notCG + +.IL KMAX krlnk krlnk +Integer64 maximum value. Implemented by library function call. +.AT arth comm kr cse +.CG notCG + +.IL UKMAX krlnk krlnk +Unsigned integer64 maximum value. Implemented by library function call. +.AT arth comm kr cse +.CG notCG + +.IL KMIN krlnk krlnk +Integer64 minimum value. Implemented by library function call. +.AT arth comm kr cse +.CG notCG + +.IL UKMIN krlnk krlnk +Unsigned integer64 minimum value. Implemented by library function call. +.AT arth comm kr cse +.CG notCG + +.IL FMAX splnk splnk +Single precision maximum. +.AT arth comm sp cse +.CG "maxss" sse_avx + +.IL FMIN splnk splnk +Single precision minimum. +.AT arth comm sp cse +.CG "minss" sse_avx + +.IL DMAX dplnk dplnk +Double precision maximum. +.AT arth comm dp cse +.CG "maxsd" sse_avx + +.IL DMIN dplnk dplnk +Double precison minimum. +.AT arth comm dp cse +.CG "minsd" sse_avx + +.IL JN irlnk splnk +float bessel_jn +.AT arth null sp cse +.CG notCG + +.IL DJN irlnk dplnk +double bessel_jn +.AT arth null dp cse +.CG notCG + +.IL YN irlnk splnk +float bessel_yn +.AT arth null sp cse +.CG notCG + +.IL DYN irlnk dplnk +double bessel_yn +.AT arth null dp cse +.CG notCG + +.\"BT.IL FMACC +.\"BTThis opcode is used in the AILI to represent one of the 8 +.\"BTscalar, single precision, "fmacc" instructions. +.\"BTSince the AILI allow at most 2 input operands, FMACC is always immediately +.\"BTpreceded by a USE aili which specifies the extra operand. +.\"BTThe 'src1' operand of FMACC is either an xmm reg operand, or memory operand. +.\"BT.AT arth null sp +.\"BT.CG CGonly asm_special +.\"BT +.\"BT.IL DMACC +.\"BTThis opcode is used in the AILI to represent one of the 8 +.\"BTscalar, double precision, "fmacc" instructions. +.\"BTSince the AILI allow at most 2 input operands, FMACC is always immediately +.\"BTpreceded by a USE aili which specifies the extra operand. +.\"BT.AT arth null dp +.\"BT.CG CGonly asm_special +.\"BT + +.IL DFMA dplnk dplnk dplnk +This opcode is only used in AILIs, not shared or linear ILIs. It +represents a scalar double-precision FMA3 or FMA4 instruction which +computes: + dest = (src1 * src2) src3 +.br +Either 'src2' or 'src3', but not both, can be a memory operand, and +the other operands are xmm register operands. The values of +(+/-) and (+/-) are specified by an 'FMA_...' flag set in the +cc field of the AILI. Since AILIs allow at most 2 source operands, +this AILI is always immediately preceded by a USE AILI which specifies +the 'src1' operand. +.AT arth null dp +.CG CGonly asm_special + +.IL FFMA splnk splnk splnk +This is the same as DFMA except that it represents a scalar single +precision FMA3 or FMA4 instruction. +.AT arth null sp +.CG CGonly asm_special + +.IL IPOWI irlnk irlnk +Integer raised to an integer power. +.AT arth null ir cse +.CG notCG + +.IL FPOWI splnk irlnk +Real raised to an integer power. +.AT arth null sp cse +.CG notCG + +.IL FPOWK splnk krlnk +Real raised to an integer power. +.AT arth null sp cse +.CG notCG + +.IL FPOWF splnk splnk +Real raised to a real power. +.AT arth null sp cse +.CG notCG + +.IL DPOWI dplnk irlnk +Double raised to a integer power. +.AT arth null dp cse +.CG notCG + +.IL DPOWK dplnk krlnk +Double raised to a integer power. +.AT arth null dp cse +.CG notCG + +.IL DPOWD dplnk dplnk +Double raised to a double power. +.AT arth null dp cse +.CG notCG + +.IL ICMP irlnk irlnk stc +Integer compare with result of true or false. +For C the value of true is 1, and for Fortran, -1. +\'stc' denotes condition code, as for the ICJMP ili. +.AT arth null ir cse +.CG asm_special "cmpl" 'l' ccmod + +.IL UICMP irlnk irlnk stc +Unsigned integer compare. +.AT arth null ir cse +.CG notAILI 'l' + +.IL KCMP krlnk krlnk stc +Integer64 compare with result of true or false. +Implemented by library function call. +.AT arth null ir cse +.CG notCG + +.IL UKCMP krlnk krlnk stc +Unsigned integer64 compare with result of true or false. +.AT arth null ir cse +.CG notCG + +.IL ACMP arlnk arlnk stc +Address compare with result of true or false. +The conditions (stc) are the same as for ICMP. +.AT arth null ir cse +.CG notCG replaceby UICMP + +.IL FCMP splnk splnk stc +Single float compare with result of true or false. +stc is a floating point condition code: one of the 12 values defined in ili.h. +.AT arth null ir cse +.CG asm_special "ucomiss" ccmod + +.IL DCMP dplnk dplnk stc +Double precision compare with result of true or false. +.AT arth null ir cse +.CG asm_special "ucomisd" ccmod + +.IL SCMPLXCMP dplnk dplnk stc +Single precision complex compare with result of true or false. +.AT arth comm ir cse +.CG asm_special "ucomisd" ccmod + +.IL DCMPLXCMP dplnk dplnk stc +Double precision complex compare with result of true or false. +.AT arth comm ir cse +.CG asm_special "ucomisd" ccmod + +.IL ICMPZ irlnk stc +Integer compare with zero. +.AT arth null ir cse +.CG notAILI 'l' + +.IL UICMPZ irlnk stc +Unsigned integer compare with zero. +.AT arth null ir cse +.CG notAILI 'l' + +.IL KCMPZ krlnk stc +Integer64 compare with zero; returns integer value. +Implemented by library function call. +.AT arth null ir cse +.CG notCG + +.IL UKCMPZ krlnk stc +Integer64 compare with zero. +.AT arth null ir cse +.CG notCG + +.IL ACMPZ arlnk stc +Address compare with zero. +.AT arth null ir cse +.CG notCG replaceby UICMPZ + +.IL FCMPZ splnk stc +Single float compare with zero; result is TRUE or FALSE. +.AT arth null ir cse +.CG notCG + +.IL DCMPZ dplnk stc +Double precision compare with zero. +.AT arth null ir cse +.CG notCG + +.IL TEST irlnk irlnk +Compare register value with 0. +.AT arth comm ir cse +.CG CGonly "testl" cclogical 'l' asm_special +.SI direct lat(4:1) + +.IL KTEST krlnk krlnk +Compare register value with 0. For 64-bit targets only. +.AT arth comm ir cse +.CG notCG + +.IL ISELECT irlnk irlnk irlnk +Select either the 2nd or 3rd operand value based on the comparison +operation pointed to by the 1st operand. +.AT other null ir cse +.CG notAILI 'l' + +.IL KSELECT irlnk krlnk krlnk +.AT other null kr cse +.CG notCG + +.IL ASELECT irlnk arlnk arlnk +.AT other null ar cse +.CG notCG replaceby ISELECT + +.IL FSELECT irlnk splnk splnk +.AT other null sp cse +.CG notAILI + +.IL DSELECT irlnk dplnk dplnk +.AT other null dp cse +.CG notAILI + +.IL CSSELECT irlnk cslnk cslnk +.AT other null cs cse +.CG notAILI + +.IL CDSELECT irlnk cdlnk cdlnk +.AT other null cd cse +.CG notAILI + +.IL AND irlnk irlnk +Bitwise 32-bit 'and' operation. +.AT arth comm ir cse +.CG memdest cclogical "and" 'l' + +.IL KAND krlnk krlnk +Bitwise 64-bit 'and' operation. +.AT arth comm kr +.CG memdest notAILI 'q' + +.IL OR irlnk irlnk +Bitwise 32-bit 'or' operation. +.AT arth comm ir cse +.CG memdest cclogical "or" 'l' + +.IL KOR krlnk krlnk +Bitwise 64-bit 'or' operation. +.AT arth comm kr +.CG memdest notAILI 'q' + +.IL XOR irlnk irlnk +Bitwise exclusive-or operation. +.AT arth comm ir cse +.CG memdest cclogical "xor" 'l' + +.IL LEQV irlnk irlnk +Bitwise exclusive-or followed by not operation. +.AT arth comm ir cse +.CG memdest cclogical "leqv" 'l' + +.IL KXOR krlnk krlnk +Bitwise 64-bit exclusive-or operation. +.AT arth comm kr +.CG memdest notAILI 'q' + +.IL EQV irlnk irlnk +.AT arth comm ir cse +.CG notCG + +.IL JISHFT irlnk irlnk +Shift op1 logically by op2. Left if op2 is > 0; else right +(no sign extension). +This ili only shows up for Fortran, specifically for the JISHFT +intrinsic. +If 2nd operand is compile time constant, this ili will have been +replaced by either a left or right shift ili by the Expander. +Otherwise, it is implemented as a call to a run-time function. +.AT arth null ir cse +.CG notCG + +.IL USHIFT irlnk irlnk +Shift op1 logically by op2. Left if op2 is > 0; else right. +This ili should have been replaced before code generator. +.AT arth null ir cse +.CG notCG + +.IL SHIFTA irlnk arlnk +Shift op1 logically by op2. Left if op2 is > 0; else right. +.AT arth null ir cse +.CG notCG + +.IL USHIFTA irlnk arlnk +Unsigned shift op1 logically by op2. Left if op2 is > 0; else right. +.AT arth null ir cse +.CG notCG + +.IL LSHIFT irlnk irlnk +Shift op1 left logically by op2. +.AT arth null ir cse +.CG memdest ccarith shiftop asm_special "shl" 'l' + +.IL ULSHIFT irlnk irlnk +Shift op1 left logically by op2. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL LSHIFTI irlnk stc +Shift left immediate. This opcode used only in Code Generator. +.AT arth null ir cse +.CG memdest ccarith shiftop "shl" CGonly 'l' + +.IL KLSHIFTI krlnk stc +Shift left immediate of 64-bit value. +.AT arth null kr cse +.CG notAILI 'q' + +.IL RSHIFT irlnk irlnk +Shift op1 logically right by op2 (sign extended). +.AT arth null ir cse +.CG notCG replaceby ARSHIFT + +.IL URSHIFT irlnk irlnk +Shift op1 logically right by op2 (0 fill). +.AT arth null ir cse +.CG memdest ccarith shiftop asm_special "shr" 'l' + +.IL ARSHIFT irlnk irlnk +Shift op1 arithmetically (sign extended) right by op2. +Used for right shifts (>> operator) of signed values. +.AT arth null ir cse +.CG memdest ccarith shiftop asm_special "sar" 'l' + +.IL DSHIFTL irlnk irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL DSHIFTR irlnk irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL SHIFTL irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL SHIFTR irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL MERGE_BITS irlnk irlnk irlnk +.AT arth null ir cse +.CG notCG + +.IL BGE irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL KBGE irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL BGT irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL KBGT irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL BLE irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL KBLE irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL BLT irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL KBLT irlnk irlnk +Bitwise greater than or equal to. +.AT arth null ir cse +.CG notCG replaceby LSHIFT + +.IL KLSHIFT krlnk irlnk +Left shift of 64-bit value. +.AT arth null kr cse +.CG notAILI 'q' + +.IL KURSHIFT krlnk irlnk +Zero-fill right shift of 64-bit value. +.AT arth null kr cse +.CG notAILI 'q' + +.IL KARSHIFT krlnk irlnk +Sign-extended right shift of 64-bit value. +.AT arth null kr cse +.CG notAILI 'q' + +.IL ILEADZI irlnk stc +8-/16- bit integer LEADZ intrinsic. +The value, 0 or 1, of the second operand indicates +8-bit or 16-bit, respectively. +.AT arth null ir cse + +.IL ILEADZ irlnk +32-bit integer LEADZ intrinsic. +.AT arth null ir cse +.CG "lzcnt" 'l' + +.IL KLEADZ krlnk +64-bit integer LEADZ intrinsic. +.AT arth null kr cse +.CG "lzcnt" 'q' + +.IL ITRAILZI irlnk stc +8-/16- bit integer TRAILZ intrinsic. +The value, 0 or 1, of the second operand indicates +8-bit or 16-bit, respectively. +.AT arth null ir cse + +.IL ITRAILZ irlnk +32-bit integer TRAILZ intrinsic. +.AT arth null ir cse +.CG "tzcnt" 'l' + +.IL KTRAILZ krlnk +64-bit integer TRAILZ intrinsic. +.AT arth null kr cse +.CG "tzcnt" 'q' + +.IL IMASKRI irlnk stc +8-/16- bit integer MASKR intrinsic. +The value, 0 or 1, of the second operand indicates +8-bit or 16-bit, respectively. +.AT arth null ir cse + +.IL IMASKR irlnk +32-bit integer MASKR intrinsic. +.AT arth null ir cse +.CG notCG + +.IL KMASKR krlnk +64-bit integer MASKR intrinsic. +.AT arth null kr cse +.CG notCG + +.IL IMASKLI irlnk stc +8-/16- bit integer MASKL intrinsic. +The value, 0 or 1, of the second operand indicates +8-bit or 16-bit, respectively. +.AT arth null ir cse + +.IL IMASKL irlnk +32-bit integer MASKL intrinsic. +.AT arth null ir cse +.CG notCG + +.IL KMASKL krlnk +64-bit integer MASKL intrinsic. +.AT arth null kr cse +.CG notCG + +.IL IPOPCNTI irlnk stc +8-/16- bit integer POPCNT intrinsic. +The value of second operand indicates 8-bit if 0 and 16-bit +if 1. +.AT arth null ir cse + +.IL IPOPCNT irlnk +32-bit integer POPCNT intrinsic. +.AT arth null ir cse +.CG "popcnt" 'l' + +.IL KPOPCNT krlnk +64-bit integer POPCNT intrinsic. +.AT arth null kr cse +.CG "popcnt" 'q' + +.IL IPOPPARI irlnk stc +8-/16- bit integer POPPAR intrinsic. +The value of second operand indicates 8-bit if 0 and 16-bit +if 1. +.AT arth null ir cse + +.IL IPOPPAR irlnk +32-bit integer POPPAR intrinsic. +.AT arth null ir cse + +.IL KPOPPAR krlnk +64-bit integer POPPAR intrinsic. +.AT arth null kr cse + +.IL EXTRACT irlnk stc stc +Note that this ILI is defined for machines with bit field extract +HW support (e.g. 88000). +The two stc operand definitions are architecture DEPENDENT. +.AT arth null ir cse +.CG notCG + +.IL JMP sym +Unconditional jump to indicated label. +.AT branch null trm dom +.CG terminal "jmp" + +.IL JMPA irlnk +Branch indirect. Fortran only. +.AT branch null trm dom +.CG terminal "jmp" asm_special + +.IL JMPM irlnk irlnk sym sym +Indexed jump from a memory table of jump addresses. +.sp +irlnk1 - integer index expression. +.br +irlnk2 - table_size +.br +sym - label for memory table containing addresses +.br +sym - default label +.AT branch null trm dom +.CG terminal asm_special 'l' + +.IL JMPMK krlnk irlnk sym sym +Indexed jump using a 64-bit integer as index value. +.AT branch null trm dom +.CG notCG 'q' + +.IL JMPT irlnk irlnk +NOT USED. +Indexed jump into a table of jump instructions. +.nf +irlnk1 - integer index expression. The expression has + already been normalized to 1 (the value 0 is + reserved for the "default" jump). If the expression + is not in the range 1:(n-1) where n is the jump table + size, the default jump is taken. +irlnk2 - table_size (includes the default label). +.AT branch null trm dom +.CG notCG + +.IL QSWITCH sym lnk stc +.AT proc null lnk dom +.CG notCG + +.IL ICJMP irlnk irlnk stc sym +Integer compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.sp +Allowed values of stc: +.sp + 1 = CC_EQ (jump if equal) + 2 = CC_NE (jump if not equal) + 3 = CC_LT (jump if less than) + 4 = CC_GE (jump if greater than or equal to) + 5 = CC_LE (jump if less than or equal to) + 6 = CC_GT (jump if greater than) +.sp +.AT branch null trm dom +.CG terminal notAILI 'l' conditional_branch + +.IL UICJMP irlnk irlnk stc sym +Unsigned integer compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +Conditions same as for ICJMP. +.AT branch null trm dom +.CG terminal notAILI 'l' conditional_branch + +.IL KCJMP krlnk krlnk stc sym +Integer64 compare and jump to the label 'sym' if the condition, +denoted by stc, is true. +Implemented by library function call. +.AT branch null trm dom +.CG notCG + +.IL UKCJMP krlnk krlnk stc sym +unsigned integer64 compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.AT branch null trm dom +.CG notCG + +.IL ACJMP arlnk arlnk stc sym +Address compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.AT branch null trm dom +.CG notCG replaceby UICJMP conditional_branch + +.IL FCJMP splnk splnk stc sym +Single precision compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.AT branch null trm dom +.CG terminal conditional_branch notAILI + +.IL DCJMP dplnk dplnk stc sym +Double precision compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.AT branch null trm dom +.CG terminal conditional_branch notAILI + +.IL ICJMPZ irlnk stc sym +Integer compare with zero and branch to label 'sym' - +the allowed values (and meanings) for stc are the same as for the ICJMP ILI. +.AT branch null trm dom +.CG terminal notAILI 'l' conditional_branch + +.IL UICJMPZ irlnk stc sym +Unsigned integer compare with zero and branch to label 'sym' - +the allowed values (and meanings) for stc are the same as for the ICJMP ILI. +.AT branch null trm dom +.CG terminal notAILI 'l' conditional_branch + +.IL LCJMPZ irlnk stc sym +Logical compare with zero and branch to label 'sym' - +the allowed values (and meanings) for stc are the same as for the ICJMP ILI. +.AT branch null trm dom +.CG notCG replaceby UICJMPZ conditional_branch + +.IL KCJMPZ krlnk stc sym +Integer64 compare with zero and branch to label 'sym'. +For EQ or NE conditions, code is generated; otherwise a library call is used. +.AT branch null trm dom +.CG terminal notAILI conditional_branch + +.IL UKCJMPZ krlnk stc sym +Integer64 compare with zero and branch to label 'sym'. +For EQ or NE conditions, code is generated; otherwise a library call is used. +.AT branch null trm dom +.CG terminal notAILI conditional_branch + +.IL ACJMPZ arlnk stc sym +Address compare with zero and branch to label 'sym' - +the allowed values (and meanings) for stc are the same as for the ICJMP ILI. +.AT branch null trm dom +.CG notCG replaceby UICJMPZ conditional_branch + +.IL FCJMPZ splnk stc sym +Single compare with zero and branch to label 'sym'. +.AT branch null trm dom +.CG notCG conditional_branch + +.IL DCJMPZ dplnk stc sym +Double compare with zero and branch to label 'sym'. +.AT branch null trm dom +.CG notCG conditional_branch + +.IL JCC +Conditional jump based on immediately preceding compare operation. +Used only in the AILI. +.AT branch null trm dom +.CG CGonly asm_special conditional_branch + +.IL CSEIR irlnk +Integer register cse (common subexpression). The ILI located by the cse +ILI is one whose value is to be re-used (the ILI need not be "evaluated"). +This ILI is used when multiple references of an ILM occur in the same +ILM block. The CSE ili are treated as a special case by the linearizer, +and never appear in a linear ili block. +.AT arth null ir +.CG notCG + +.IL CSESP splnk +Single precision register cse. +.AT arth null sp +.CG notCG + +.IL CSEDP dplnk +Double precision register cse. +.AT arth null dp +.CG notCG + +.IL CSECS cslnk +Single precision complex register cse. +.AT arth null cs +.CG notCG + +.IL CSECD cdlnk +Double precision complex register cse. +.AT arth null cd +.CG notCG + +.IL CSEAR arlnk +Address register cse. +.AT arth null ar +.CG notCG + +.IL CSEKR krlnk +Integer64 register cse. +.AT arth null kr +.CG notCG + +.IL CSE lnk stc +Complex cse (common subexpression). The ILI located by the cse +ILI is one whose value is to be re-used (the ILI need not be "evaluated"). +This ILI is used when multiple references of an ILM occur in the same +ILM block. +This ili is seen by the code generator but never appears in the +linear ili. +.AT arth null ir +.CG notCG + +.IL APURE arlnk +Call a pure function with no arguments and returns an AR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ar cse +.CG notCG + +.IL APUREA arlnk arlnk +Call a pure function with one AR argument and returns an AR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ar cse +.CG notCG + +.IL APUREI arlnk irlnk +Call a pure function with one IR argument and returns an AR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ar cse +.CG notCG + +.IL IPURE arlnk +Call a pure function with no arguments and returns an IR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ir cse +.CG notCG + +.IL IPUREA arlnk arlnk +Call a pure function with one AR argument and returns an IR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ir cse +.CG notCG + +.IL IPUREI arlnk irlnk +Call a pure function with one IR argument and returns an IR value. +Will always have an ALT which is the actual call. +arlnk is an ACON ili of the function being called. +.AT arth null ir cse +.CG notCG + +.IL REP +Repeat prefix opcode for string operations (such as the following SMOVE). +Emitted immediately before an SMOVE operation. +.AT other null trm dom +.CG CGonly "rep" + +.IL GSMOVE arlnk arlnk nme nme stc +General structure copy. +A structure store (SMOVE ILM) is expanded into the GSMOVE ILI; a phase, such as +the ACC CG, needs to have the structure assignment presented as a first-class +ILI operation. +After the last phase requiring GSMOVE, GSMOVE will then be expanded into +lower level ILI which will be dependent on target, alignment, small vs large, +etc. + \'op1' is the source address. + \'op2' is the destination address. + \'nme1' is the names table entry for source struct. + \'nme2' is the names table entry for the destination struct. + \'stc' is the dtype of the struct. +.AT other null trm dom +.CG notCG + +.IL SMOVE arlnk arlnk arlnk nme +Structure copy. + \'op1' is the source address. + \'op2' is the destination address. + \'op3' is number of 4-byte units to copy. + \'nme' is names table entry for destination struct. +.AT other null trm dom +.CG terminal "movs" + +.IL SMOVEJ arlnk arlnk nme nme stc +Simple structure copy. (MOVS is x86 parlance.) +This is used to replace the SMOVEI/SMOVES pair, which was used when +the ILI operand count was only 4. +\'op1' is the source address +\'op2' is the destination address +\'nme1' is the names table entry for source struct. +\'nme2' is the names table entry for the destination struct. +\'op5' is actual number of bytes to copy. +This gets turned into SMOVE and load/store operations by rm_smove +.AT other null trm dom +.CG notCG + +.IL XMOVE arlnk arlnk nme +Structure copy. + \'op1' is the source address. + \'op2' is the destination address. + \'nme' is names table entry for destination struct. +.AT other null trm dom +.CG terminal "movapd" sse_avx + +.IL ST irlnk arlnk nme stc +Store integer value. +In ILI, the value to be stored must fit without implicit truncation, i.e. immediately +reloading using LD with the same size modifier must reproduce the value that was stored. +In LILI or AILI, ST may perform implicit truncation. +\'op1' is a pointer to an ili representing the value being stored. +.br +\'op2' is a pointer to the address expression of the variable being defined. +.br +\'nme' is a pointer to a names table entry of the variable being defined. +.br +\'stc' is the size modifier of the memory operation as described for +the LD ili above. +.AT store null trm +.CG terminal "mov" move + +.IL STSP splnk arlnk nme stc +Store single precision quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movss" move + +.IL STDP dplnk arlnk nme stc +Store double precision quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movsd" move + +.IL STSCMPLX cslnk arlnk nme stc +Store single precision complex quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movsd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL STDCMPLX cdlnk arlnk nme stc +Store double precision complex quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movups" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL STQ dplnk arlnk nme stc +Store m128 quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL STQU dplnk arlnk nme stc +Store unaligned m128 quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movupd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL ST256 dplnk arlnk nme stc +Store m256 quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL ST256U dplnk arlnk nme stc +Store unaligned m256 quantity. 'stc' is not used. +.AT store null trm +.CG terminal "movupd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL STA arlnk arlnk nme +Store address quantity inside of op1 into op2. +Replaced by ST opcode in cgoptim1. +.AT store null trm +.CG terminal notAILI + +.IL STRG1 arlnk stc +Store address quantity inside of op1 argument register described by stc. +Used in g++ style +thunks when adjusting the *this* pointer, (the first argument) just +before jumping through to the function Replaced by ST opcode in cgoptim1. +.AT store null trm +.CG terminal notAILI + +.IL STKR krlnk arlnk nme stc +Store 64 bit integer value (in register pair). 'stc' is not used. +.AT store null trm +.CG terminal notAILI + +.IL VZST arlnk +Special ili created by the vectorizer indicating that the variable +whose address is op1 is stored; necessary in cases where +the vectorizer replaces assignments with calls. The optimizer will process +the ili to create store information and then delete the ili. Code generator +will not see this ili. +.AT other null trm +.CG notCG + +.IL JSR sym lnk +\'sym' is external function or subroutine being called (standard linkage). +\'op2' points to a list (terminated by NULL) of ARG ili for the +arguments. +.AT proc null lnk dom +.CG terminal "call" asm_special ccmod + +.IL JSRA arlnk lnk stc stc +JSR to routine whose address is pointed to by op1. +op2 points to the list of ARG ILIs which represents the arguments. +stc1 attribute flag (stdcall in x86) +stc2 dtype +.AT proc null lnk dom +.CG terminal notAILI ccmod + +.IL QJSR sym lnk +Quick (intrinsic) call. +\'sym' is the external procedure being called. +\'op2' locates the list of arguments (define arg ILI - DAAR, DADR, DADP). +.AT proc null lnk dom +.CG terminal notAILI ccmod + +.IL GJSR sym lnk sym +Same as JSR, but the argument list is expressed using the general argument +ILI, i.e., before applying the ABI. +\'sym2' is the label to jump to if an exception is thrown, +0 if the call cannot throw, +or -1 if there is no cleanup. +.AT proc null lnk dom +.CG terminal notCG + +.IL GJSRA arlnk lnk stc stc sym +Same as JSRA, but the argument list is expressed using the general argument +ILI, i.e., before applying the ABI. +.AT proc null lnk dom +.CG terminal notCG + +.IL NULL stc +Used to mark the end of an argument list for a JSR, QJSR or JSRA ili. +.AT other null lnk +.CG notAILI + +.IL GARG lnk lnk stc nme +A general argument link, used before applying the ABI +.sp +\'lnk' (first) points to the value of the argument. +\'lnk' (second) points to the next ARG ILI. +First \'stc' is the dtype. +Second \'stc' is an NME value, if set, for address arguments. +.AT define null lnk +.CG + +.IL GARGRET lnk lnk stc nme +A general argument link representing the return value of the function +.sp +\'lnk' (first) points to the value of the argument. +\'lnk' (second) points to the next ARG ILI. +\'stc' is the dtype +\'nme' is the nme +.AT define null lnk +.CG notCG + +.IL VA_ARG arlnk stc +va_arg(va_list x, typeof_arg) computes the address of the argument +'arlnk' address of the va_list +'stc' the dtype of the argument being reference +.AT arth null ar +.CG notCG + +.IL ARGIR irlnk lnk +Defines an integer memory argument. +\'irlnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg "mov" 'l' + +.IL ARGSP splnk lnk +Defines a single-precision memory argument. +\'splnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg "movss" + +.IL ARGDP dplnk lnk +Defines a double precision memory argument. +\'dplnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg "movsd" + +.IL ARGAR arlnk lnk stc +A memory argument of type pointer or struct/union. +.sp +\'arlnk' points to the value of the argument. +.br +\'lnk' points to the next ARG ILI. +.br +\'stc' is the dtype if this is a struct arg, else it is 0. +If 'stc' == 1, then this argument is a pointer to the return area for a +C function returning struct, and requires special treatment. +.AT define null lnk +.CG memarg "mov" 'l' + +.IL ARGKR krlnk lnk +Defines a 64 bit integer memory argument. +\'krlnk' points to the value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg notAILI + +.IL DAIR irlnk ir lnk +Define integer argument in general purpose register for a JSR. +.AT define null lnk +.CG "mov" 'l' move + +.IL DASP splnk sp lnk +Define a single precision argument in xmm register for a JSR. +.AT define null lnk +.CG "movss" move + +.IL DADP dplnk dp lnk +Define a double precision argument in xmm register for a JSR. +.AT define null lnk +.CG "movsd" move + +.IL DACS cslnk cs lnk +Define a C struct argument of two floats, passed in the indicated xmm register. +.AT define null lnk +.CG "movsd" move sse_avx +.SI ld double fadd fmul fst lat(4) +.SI st double fst lat(4) +.SI double fadd fmul lat(2) + +.IL DACD cdlnk cd lnk +Define a C struct argument of two double, passed in the indicated xmm register. +.AT define null lnk +.CG "movupd" move sse_avx +.SI ld double fadd fmul fst lat(4) +.SI st double fst lat(4) +.SI double fadd fmul lat(2) + +.IL PSARG xmm stc lnk +Move symbolic register 'xmm' into actual register 'stc' (typically +XR_XMM0 or XR_XMM1) in preparation for call to vector intrinsic function. +.AT define null lnk +.CG "movaps" move sse_avx +.SI ld double lat(4) +.SI st double lat(3) +.SI double lat(2) + +.IL PDARG xmm stc lnk +Move symbolic register 'xmm' into actual register 'stc' (typically +XR_XMM0 or XR_XMM1) in preparation for call to vector intrinsic function. +.AT define null lnk +.CG "movapd" move ssedp sse_avx +.SI ld double fadd fmul fst lat(2) +.SI st double fst lat(3) +.SI double fadd fmul lat(2) + +.IL KISHFT krlnk krlnk +Shift op1 by op2. Left if op2 is > 0; else right (no sign extension). +This ili only shows up for Fortran, specifically for the KISHFT intrinsic. +If 2nd operand is compile time constant, this ili will have been +replaced by either a left or right shift ili by the Expander. +Otherwise, it is implemented as a call to a run-time function. +.AT arth null kr cse +.CG notCG + +.IL DAAR arlnk ar lnk +Define argument in address register for a JSR. +Lnk1 points to the expression to be moved into the specified (ar2) +address register. Lnk3 locates the next argument for the JSR. +.AT define null lnk +.CG notCG replaceby DAIR + +.IL DAKR krlnk kr lnk +Define argument in register pair for a JSR. +.AT define null lnk +.CG notCG + +.IL DFRIR lnk ir +Define function result in a integer register. +.AT define null ir cse +.CG terminal asm_nop 'l' + +.IL DFRSP lnk sp +Define single precision function result returned in xmm register 'sp'. +.AT define null sp cse +.CG terminal asm_nop + +.IL DFRDP lnk dp +Define double precision function result returned in xmm register 'dp'. +.AT define null dp cse +.CG terminal asm_nop + +.IL DFRCS lnk cs +Define single precision complex function result in an xmm register. +.AT define null cs cse +.CG terminal asm_nop + +.IL DFRCD lnk cd +Define double precision complex function result in an xmm register. +.AT define null cd cse +.CG terminal asm_nop + +.IL DFRSPX87 lnk +Define single precision function result (on floating-point stack). +.AT define null sp cse +.CG terminal "fstps" + +.IL DFRDPX87 lnk +Define double precision function result (on floating-point stack). +.AT define null dp cse +.CG terminal "fstpl" + +.IL DFR128 lnk dp +Define 128-bit function result in an xmm register. +.AT define null dp cse +.CG terminal asm_nop + +.IL DFR256 lnk dp +Define 256-bit function result in an ymm register. +.AT define null dp cse +.CG terminal asm_nop + +.IL DFRAR lnk ar +Define function result in an address register. +\'op1' points to one of the JSR ILI. +.AT define null ar cse +.CG notCG replaceby DFRIR + +.IL DFRKR lnk kr +Define integer64 function result in a register pair. +.AT define null kr cse +.CG terminal notAILI 'q' + +.IL IRDF ir +Define one of the general purpose registers. +These ILI (IRDF, DPDF, ARDF) used for global +register allocation, and for the pre-defined regs. +.AT define null ir cse +.CG terminal asm_nop 'l' + +.IL SPDF sp +Define single precision register (xmm register). +.AT define null sp cse +.CG terminal asm_nop + +.IL DPDF dp +Define double precision register (xmm register). +.AT define null dp cse +.CG terminal asm_nop + +.IL ARDF ar +Define address register. (ar is actual register number). +.AT define null ar cse +.CG notCG replaceby IRDF + +.IL KRDF kr +Define integer64 register. +.AT define null kr +.CG notCG + +.IL MVIR irlnk ir +Move integer value into specific integer register, ir. +.AT move null trm +.CG terminal notAILI 'l' + +.IL MVSP splnk sp +Indicates a single-precision function return value, which is to be placed +on the x87 floating point stack. The 2nd argument, 'sp', is ignored. +.AT move null trm +.CG terminal "flds" + +.IL MVDP dplnk dp +Indicates a double-precision function return value, which is to be placed +on the x87 floating point stack. The 2nd argument, 'dp', is ignored. +.AT move null trm +.CG terminal "fldd" + +.IL SPSP2SCMPLX splnk splnk +Form a single complex value out of two single precision real values. +.AT other null cs cse +.CG sse_avx asm_special + +.IL SPSP2SCMPLXI0 splnk +Form a single complex value out of two single precision real values, imaginary is 0. +.AT other null cs cse +.CG sse_avx asm_special + +.IL DPDP2DCMPLX dplnk dplnk +Form a double complex value out of two double precision real values. +.AT other null cd cse +.CG sse_avx asm_special + +.IL DPDP2DCMPLXI0 dplnk +Form a double complex value out of two double precision real values, imaginary is 0. +.AT other null cd cse +.CG sse_avx asm_special + +.IL SCMPLX2IMAG cslnk +Return single precision imaginary part of a single complex value. +.AT other null sp cse +.CG sse_avx asm_special + +.IL DCMPLX2IMAG cdlnk +Return double precision imaginary part of a double complex value. +.AT other null dp cse +.CG sse_avx asm_special + +.IL SCMPLX2REAL cslnk +Return single precision real part of a single complex value. +.AT other null sp cse +.CG sse_avx asm_special + +.IL DCMPLX2REAL cdlnk +Return double precision real part of a double complex value. +.AT other null dp cse +.CG sse_avx asm_special + +.IL MVQ dplnk dp +This ili represents a m128 function return value. +For X86_64, the value is moved into the specified xmm register. +.AT move null trm +.CG terminal "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL MV256 dplnk dp +This ili represents a m256 function return value. +For X86_64, the value is moved into the specified ymm register. +.AT move null trm +.CG terminal "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL MOVSP +Move a single-precision xmm register value. +.AT move null sp +.CG CGonly "movss" move + +.IL MOVDP +Move a double-precision xmm register value. +.AT move null dp +.CG CGonly "movsd" move + +.IL MOVCS +Move a single-precision complex xmm register value. +.AT move null cs +.CG CGonly "movsd" move + +.IL MOVCD +Move a double-precision complex xmm register value. +.AT move null cd +.CG CGonly "movupd" move + +.IL MVSPX87 splnk +Indicates a single-precision function return value, which is to be placed +on the x87 floating point stack. +.AT move null trm +.CG terminal "flds" + +.IL MVDPX87 dplnk +Indicates a double-precision function return value, which is to be placed +on the x87 floating point stack. +.AT move null trm +.CG terminal "fldl" + +.IL MOVQP +Move a __m128 xmm register value. +.AT move null dp +.CG CGonly "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL MOV256 +Move a __m256 xmm register value. +.AT move null dp +.CG CGonly "movapd" move sse_avx +.SI ld double fadd fmul fst lat(3) +.SI st direct fst lat(2) +.SI direct fadd fmul lat(2) + +.IL MVAR arlnk ar +Move address value into specific address register, ar. +.AT move null trm +.CG terminal notCG replaceby MVIR + +.IL MVKR krlnk kr +Move integer64 value into specific integer register pair, kr. +.AT move null trm +.CG terminal notAILI + +.IL FREEIR irlnk +Ensures that the result reg is freed. +The FREExx ili are eliminated by the linearizer phase of the code generator. +.AT other null trm +.CG terminal notAILI + +.IL FREESP splnk +.AT other null trm +.CG terminal notAILI + +.IL FREEDP dplnk +.AT other null trm +.CG terminal notAILI + +.IL FREECS cslnk +.AT other null trm +.CG terminal notAILI + +.IL FREECD cdlnk +.AT other null trm +.CG terminal notAILI + +.IL FREESPX87 splnk +If necessary, pop X87 stack after a function call which returns a +floating-point value which is not used. +.AT other null trm +.CG terminal "fstp\t%st(0)" + +.IL FREEDPX87 dplnk +.AT other null trm +.CG terminal "fstp\t%st(0)" + +.IL FREEAR arlnk +.AT other null trm +.CG terminal notCG replaceby FREEIR + +.IL FREEKR krlnk +.AT other null trm +.CG terminal notAILI + +.IL FREE lnk stc +.AT other null trm +.CG terminal notAILI + +.IL ENTRY sym +Main function entry or fortran ENTRY. +.AT other null trm dom +.CG terminal asm_nop + +.IL EXIT sym +Exit the procedure. +.AT other null trm dom +.CG terminal asm_special + +.IL ARGSAVE sym +For varargs/stdargs functions, this ili appears immediately after ENTRY +ili. Not used by X86_32 compiler +.AT other null trm dom +.CG notCG + +.IL NOP +Null operation - used when a linear ili or aili is deleted. +.AT other null trm +.CG asm_nop + +.IL ASM sym +Implements C inline assembly code, asm(), feature. Also used as +a convenience by the code generator. 'sym' is a symbol table +pointer to a string constant. +.AT other null trm dom +.CG terminal asm_special ccmod + +.IL GASM sym lnk lnk lnk +Compatible ASM language representation to support asm(). +sym - the asm string +lnk1 - linked list of generic GASMLNKOs of output expressions +lnk2 - linked list of specific GASMLNKI/SP/DP/As of input expressions +lnk3 - linked list of generic GASMLNKCs of clobber strings +NOTE: For now we add ccmod. In the future we may only want to indicate ccmod +if the user specifies "cc" in the clobber list. +.AT other null trm dom +.CG terminal asm_special ccmod + +.IL GASMCNM sym sym +Used to represent a symbolic name for a gasm constraint +sym - identifier of constraint name. Stored as an int since we only care + about the name, not its type. +sym - constraint number +.AT other null trm +.CG terminal asm_nop + +.IL GASMLNKG sym nme lnk lnk +generic gasmlnk; +sym - descriptor string +nme - nme being stored +lnk1 - input or output expression +lnk2 - next GASMLNKG +.AT other null lnk +.CG asm_nop + +.IL GASMLNKTYP stc lnk +generic gasmlnk - stores type +stc - base type of expression +lnk1 - input or output expression +.AT other null lnk +.CG asm_nop + +.IL GASMLNKC sym lnk +sym - descriptor string +lnk - next GASMLNKC +.AT other null lnk +.CG asm_nop + +.IL GASMLNKO sym nme lnk stc +sym - descriptor string +nme - nme being stored +lnk - next GASMLNKO +stc - data type of expression +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKI sym nme irlnk lnk +sym - descriptor string +nme - nme being stored +irlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKB sym nme irlnk lnk +Same as GASMLNKI, but represents byte reg +sym - descriptor string +nme - nme being stored +irlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKH sym nme irlnk lnk +Same as GASMLNKI, but represents Half-word reg +sym - descriptor string +nme - nme being stored +irlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKKR sym nme irlnk lnk +Same as GASMLNKI, but represents quad word reg (not currently used on 32-bit x86) +sym - descriptor string +nme - nme being stored +irlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKSP sym nme splnk lnk +sym - descriptor string +nme - nme being stored +splnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKDP sym nme dplnk lnk +sym - descriptor string +nme - nme being stored +dplnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKQP sym nme dplnk lnk +sym - descriptor string +nme - nme being stored +dplnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKA sym nme arlnk lnk +sym - descriptor string +nme - nme being stored +arlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLNKS sym nme arlnk lnk +the operand is a struct +sym - descriptor string +nme - nme being stored +arlnk - the input expression +lnk - next specific GASMLNK +.AT other null lnk +.CG "" asm_nop + +.IL GASMLDI stc stc nme +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null ir +.CG asm_nop + +.IL GASMLDH stc stc nme +half word register +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null ir +.CG asm_nop + +.IL GASMLDB stc stc nme +byte register +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null ir +.CG asm_nop + +.IL GASMLDKR stc stc nme +quad register +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null ir +.CG asm_nop + +.IL GASMLDSP stc stc nme +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null sp +.CG asm_nop + +.IL GASMLDDP stc stc nme +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null dp +.CG asm_nop + +.IL GASMLDQP stc stc nme +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null dp +.CG asm_nop + +.IL GASMLD256 stc stc nme +__m256 +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null dp +.CG asm_nop + +.IL GASMLDA stc stc nme +stc - output argument number, 0..n +stc - optional field filled in by CG, this is the constraint used. +nme - nme of object we're loading +.AT other null ar +.CG asm_nop + +.IL FPSAVE arlnk +Store the frame pointer in the location whose address is specified +by op1. +.AT other null trm dom +.CG terminal notAILI + +.IL VFENTER arlnk +Enter a "function" which will compute the value of an expression +used as a variable format field. op1 locates a temporary area +used to set up the environment of the expression: +\ op1+0 -- contains the fp to use for the expression +\ op1+4 -- where to save the current fp +The code for VFENTER performs the following: +\1. save current fp in addr(op1)+4 +\2. load fp from addr(op1)+0 +.AT other null trm dom +.CG terminal asm_special ccmod + +.IL VFEXIT arlnk irlnk +Exit the variable format field function. lnk1 locates the temporary +area (see VFENTER). lnk2 is the function return value. The code for +VFEXIT performs the following: +\1. value of lnk2 --> integer function return register +\2. restore fp from addr(lnk1)+4 +\3. return. +.AT other null trm dom +.CG terminal asm_special ccmod + +.IL PREFETCHNTA arlnk stc nme +Prefetch cache line. Non-Temporal Access - prefetch in such a way to +minimize cache pollution. Second operand, 'stc' is not used. +.AT other null trm ssenme +.CG terminal "prefetchnta" + +.IL PREFETCHT0 arlnk stc nme +Prefetch cache line into all cache levels. +.AT other null trm ssenme +.CG terminal "prefetcht0" + +.IL PREFETCHW arlnk stc nme +Prefetch cache line into L1 data cache. Used in anticipation to subsequent +store into the cache line. +.AT other null trm ssenme +.CG terminal "prefetchw" + +.IL PREFETCH arlnk stc nme +Prefetch cache line into L1 data cache. +.AT other null trm ssenme +.CG terminal "prefetch" + +.IL LABEL sym +This ILI represents a label 'sym' that is within a basic block. +.AT other null trm dom +.CG terminal asm_special + +.IL PSLD arlnk xmm nme +Load 16 bytes from aligned memory into xmm register denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movaps" move sse_avx + +.IL PDLD arlnk xmm nme +Load 16 bytes from aligned memory into xmm register denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movapd" move ssedp sse_avx + +.IL PILD arlnk xmm nme +Load 16 bytes, 4 or 8 byte integer, from aligned memory into xmm register +denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movdqa" move ssedp sse_avx + +.IL PSLDU arlnk xmm nme +Load 16 bytes from unaligned memory into xmm register denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movups" move sse_avx + +.IL PDLDU arlnk xmm nme +Load 16 bytes from unaligned memory into xmm register denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movupd" move ssedp sse_avx + +.IL PILDU arlnk xmm nme +Load 16 bytes, 4 or 8 byte integer, from unaligned memory into xmm register +denoted by xmm. +.AT pload null trm ssenme +.CG terminal "movdqu" move ssedp sse_avx + +.IL PSLD_SCALAR arlnk xmm nme +Move 4-byte scalar value whose address is indicated by arlnk, +into least significant word of the 16-byte xmm register indicated by 'xmm'. +.AT other null trm ssenme +.CG terminal "movss" + +.IL PDLD_LOWH arlnk xmm nme +Load 8 bytes from memory into low half of xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "movlpd" ssedp + +.IL PDLD_HIGHH arlnk xmm nme +Load 8 bytes from memory into high half of xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "movhpd" ssedp + +.IL PI1INSERT arlnk xmm nme stc +SSE4.1 and AVX instruction to load an integer*1 value from 'arlnk' and +insert it into 'xmm' at the byte offset given by 'stc'. +.AT other null trm ssenme +.CG terminal "pinsrb" sse_avx asm_special + +.IL PI2INSERT arlnk xmm nme stc +SSE2 and AVX instruction to load an integer*2 value from 'arlnk' and +insert it into 'xmm' at the word offset given by 'stc' (where a 'word' +is 2 bytes). +.AT other null trm ssenme +.CG terminal "pinsrw" sse_avx asm_special + +.IL PI4INSERT arlnk xmm nme stc +SSE4.1 and AVX instruction to load an integer*4 value from 'arlnk' and +insert it into 'xmm' at the dword offset given by 'stc' (where a +'dword' is 4 bytes). +.AT other null trm ssenme +.CG terminal "pinsrd" sse_avx asm_special + +.IL PI8INSERT arlnk xmm nme stc +SSE4.1 and AVX instruction to load an integer*8 value from 'arlnk' and +insert it into 'xmm' at the qword offset given by 'stc' (where a +'qword' is 8 bytes). This instruction cannot be used on x86-32. +.AT other null trm ssenme +.CG notCG + +.IL PSLD_LOWH arlnk xmm nme +Load 2 single precision values to low half of xmm register. +This opcode and the next are used in combination, in place of "movups" +due to a Hammer performance penalty for using "movups". +.AT other null trm ssenme +.CG terminal "movlps" + +.IL PSLD_HIGHH arlnk xmm nme +Load 2 single precision values to high half of xmm register. +.AT other null trm ssenme +.CG terminal "movhps" + +.IL PSST arlnk xmm nme +Store 16 bytes from xmm register denoted by xmm into aligned memory. +.AT pstore null trm ssenme +.CG terminal "movaps" move ssest sse_avx + +.IL PDST arlnk xmm nme +Store 16 bytes from xmm register denoted by xmm into aligned memory. +.AT pstore null trm ssenme +.CG terminal "movapd" move ssedp ssest sse_avx + +.IL PIST arlnk xmm nme +Store 16 bytes, 4 or 8 byte integer, from xmm register denoted by xmm +into aligned memory. +.AT pstore null trm ssenme +.CG terminal "movdqa" move ssedp ssest sse_avx + +.IL PSSTU arlnk xmm nme +Store 16 bytes from xmm register denoted by xmm into unaligned memory. +.AT pstore null trm ssenme +.CG terminal "movups" move ssest sse_avx + +.IL PDSTU arlnk xmm nme +Store 16 bytes from xmm register denoted by xmm into unaligned memory. +.AT pstore null trm ssenme +.CG terminal "movupd" move ssedp ssest sse_avx + +.IL PISTU arlnk xmm nme +Store 16 bytes, 4 or 8 byte integer, from xmm register denoted by xmm +into unaligned memory. +.AT pstore null trm ssenme +.CG terminal "movdqu" move ssedp ssest sse_avx + +.IL PSSTS arlnk xmm nme +Streaming store. +Store 16 bytes from xmm register denoted by xmm into aligned memory +bypassing cache. +.AT pstore null trm ssenme +.CG terminal "movntps" move ssest sse_avx + +.IL PSSTS_SCALAR arlnk xmm nme +Scalar streaming store single precision quantity. +.AT other null trm ssenme +.CG terminal "movntss" move ssest + +.IL SSTS_SCALAR splnk arlnk nme stc +Scalar streaming store single precision quantity. +.AT store null trm +.CG terminal "movntss" move + +.IL PDSTS arlnk xmm nme +Streaming store. +Store 16 bytes from xmm register denoted by xmm into aligned memory +bypassing cache. +.AT pstore null trm ssenme +.CG terminal "movntpd" move ssedp ssest sse_avx + +.IL PDSTS_SCALAR arlnk xmm nme +Scalar streaming store double precision quantity. +.AT other null trm ssenme +.CG terminal "movntsd" move ssedp ssest + +.IL DSTS_SCALAR dplnk arlnk nme +Scalar streaming store double precision quantity. +.AT store null trm +.CG terminal "movntsd" move + +.IL PISTS arlnk xmm nme +Streaming store. Store 16 bytes, 4 or byte integer, from xmm register +denoted by xmm into aligned memory, bypassing cache. +.AT pstore null trm ssenme +.CG terminal "movntdq" move ssedp ssest sse_avx + +.IL PSST_SCALAR arlnk xmm nme +Store value from xmm register into 4-byte variable. +.AT other null trm ssenme +.CG terminal "movss" move ssest + +.IL PDST_LOWH arlnk xmm nme +Store low half of xmm register into 8-byte memory location. +.AT other null trm ssenme +.CG terminal "movsd" move ssedp ssest + +.IL PDST_HIGHH arlnk xmm nme +Store high half of xmm register into 8-byte memory location. +.AT other null trm ssenme +.CG terminal "movhpd" ssedp ssest + +.IL PSST_LOWH arlnk xmm nme +Store 2 single precision values from low half of xmm register. +This opcode and the next are used in combination, in place of "movups" +due to a Hammer performance penalty for using "movups". +.AT other null trm ssenme +.CG terminal "movlps" ssest + +.IL PSST_HIGHH arlnk xmm nme +Store 2 single precision values from high half of xmm register. +.AT other null trm ssenme +.CG terminal "movhps" ssest + +.IL SFENCE +X86 sfence instruction used in conjunction with streaming stores. +.AT other null trm dom +.CG terminal "sfence" + +.IL PSMOVX xmm xmm +Move low order 4 byte value of xmm1 into low order 4 bytes of xmm2, without +disturbing the other 12 bytes of xmm2. +.AT other null trm +.CG terminal "movss" +.SI ld double lat(4) +.SI st double lat(3) +.SI double lat(2) + +.IL PSMOV xmm xmm +Move contents of one xmm register into a 2nd xmm register. +.AT other null trm +.CG terminal "movaps" move sse_avx + +.IL PDMOV xmm xmm +Move contents of one xmm register into a 2nd xmm register. +.AT other null trm +.CG terminal "movapd" move ssedp sse_avx + +.IL PIMOV xmm xmm +Move contents of xmm register containing 4 or 8-byte integers. +.AT other null trm +.CG terminal "movdqa" move sse_avx + +.IL PSDFR stc xmm +Move 16-byte register 'stc' containing result of vector intrinsic function, +into symbolic register 'xmm'. 'stc' is typically XR_XMM0. +.AT other null trm +.CG terminal "movaps" move sse_avx + +.IL PDDFR stc xmm +Move 16-byte register 'stc' containing result of vector intrinsic function, +into symbolic register 'xmm'. 'stc' is typically XR_XMM0. +.AT other null trm +.CG terminal "movapd" move ssedp sse_avx + +.IL PDMV_LOWH dplnk xmm +Move d.p. value into low half of xmm register. +This operation is used for the streaming store optimization. +.AT other null trm +.CG terminal "movlpd" move ssedp + +.IL PI8MV_LOW krlnk xmm +Move 8-byte integer value into low half of xmm register. +.AT other null trm +.CG terminal notAILI + +.IL PDMV_HIGHH dplnk xmm +Move d.p. value into high half of xmm register. +This operation is used for the streaming store optimization. +If input operand is a register, the "unpcklpd" instruction is used +instead. +.AT other null trm +.CG terminal "movhpd" ssedp + +.IL PDMV_DUP dplnk xmm +Move 1 double precision value into both high & low half of xmm register. +.AT other null trm +.CG terminal "movddup" ssedp sse_avx +.SI double fmul lat(4) + +.IL PSMV_LOW splnk xmm +Load value of single precision expression into register. +.AT other null trm +.CG terminal "movss" move + +.IL PI4MV_LOW irlnk xmm +Move 4-byte integer into low half of xmm register. Used to initialize an +invariant variable in the preheader of a loop. +.AT other null trm +.CG terminal "movd" + +.IL MOVHLPS xmm xmm +Move high half of sp values from one xmm register into a low half of 2nd +xmm register. +.AT other null trm +.CG terminal "movhlps" + +.IL MOVLHPS xmm xmm +Move low half of sp values from one xmm register into a high half of 2nd +xmm register. +.AT other null trm +.CG terminal "movlhps" + +.IL UNPCKLPS xmm xmm +.AT other null trm +.CG terminal "unpcklps" + +.IL UNPCKHPS xmm xmm +.AT other null trm +.CG terminal "unpckhps" + +.IL UNPCKLPD xmm xmm +Copy low halves of each operand into the destination operand. +.AT other null trm +.CG terminal "unpcklpd" ssedp + +.IL UNPCKHPD xmm xmm +Copy high halves of each operand into the destination operand. +.AT other null trm +.CG terminal "unpckhpd" ssedp + +.IL UNPCKLDQ xmm xmm +Take the 2 low doublewords (of 4 bytes each) of each operand and +interleave them into the destination (i.e. second) operand. Only used +in AILIs on x86-32, where it is generated from an IL_PI8MV_LOW ILI. +Not used on x86-64. +.AT other null trm +.CG CGonly "punpckldq" ssedp + +.IL UNPCKLQDQ xmm xmm +Copy low halves of each operand into the destination operand. +Input register contain 8-byte integers. +.AT other null trm +.CG terminal "punpcklqdq" ssedp + +.IL HADDPS xmm xmm +Horizontal add packed single. +.AT other null trm +.CG terminal "haddps" sse_avx + +.IL HSUBPS xmm xmm +Horizontal subtract packed single. +.AT other null trm +.CG terminal "hsubps" sse_avx + +.IL HADDPD xmm xmm +Horizontal add packed double. +.AT other null trm +.CG terminal "haddpd" ssedp sse_avx + +.IL HSUBPD xmm xmm +Horizontal subtract packed double. +.AT other null trm +.CG terminal "hsubpd" ssedp sse_avx + +.IL PSSHUF xmm xmm stc +Shuffle contents of xmm registers. Used to move value in +least significant word into the 3 other words of a register: +xmm1 and xmm2 denote the (same) xmm register, and stc3 is the +immediate constant 0. +.AT other null trm +.CG terminal "shufps" asm_special + +.IL PDSHUF xmm xmm stc +Shuffle contents of xmm registers. Used to switch 2 d.p. values +in register. +.AT other null trm +.CG terminal "shufpd" asm_special ssedp + + +.IL PI4SHUF xmm xmm stc +Shuffle contents of xmm register containing 4-byte integers. +.AT other null trm +.CG terminal "pshufd" asm_special + +.IL PTEST xmm xmm +This sets the ZF flag if the bitwise AND of all the bits in the xmm +register operands is 0, otherwise it clears the ZF flag, and it sets +the CF flag if the bitwise ANDN of all the bits in the operands is 0, +otherwise it clears the CF flag. Due to the latter operation its +operands are not commutative. It clears the AF, OF, PF and SF flags. +.AT other null ir +.CG "ptest" ccmod sse_avx asm_special + + +.IL PI4ADD arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "paddd" sse_avx + +.IL PI4SUBR arlnk xmm nme +Integer reverse-subtract. +.AT other null trm ssenme +.CG terminal "psubd" sse_avx + +.IL PI4AND arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "pand" sse_avx + +.IL PI4ANDN arlnk xmm nme +.AT other null trm ssenme +.CG terminal "pandn" sse_avx + +.IL PI4OR arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "por" sse_avx + +.IL PI4XOR arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "pxor" sse_avx + +.IL PI4MAX arlnk xmm nme +SSE4.1 packed signed dword integer maximum. +.AT other comm trm ssenme +.CG terminal "pmaxsd" sse_avx + +.IL PI4MIN arlnk xmm nme +SSE4.1 packed signed dword integer minimum. +.AT other comm trm ssenme +.CG terminal "pminsd" sse_avx + + +.IL PI8ADD arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "paddq" sse_avx + +.IL PI8SUBR arlnk xmm nme +Integer reverse-subtract. +.AT other null trm ssenme +.CG terminal "psubq" sse_avx + +.IL PI8AND arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "pand" sse_avx + +.IL PI8ANDN arlnk xmm nme +.AT other null trm ssenme +.CG terminal "pandn" sse_avx + +.IL PI8OR arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "por" sse_avx + +.IL PI8XOR arlnk xmm nme +.AT other comm trm ssenme +.CG terminal "pxor" sse_avx + + +.IL PI4ADDX xmm xmm +.AT other comm trm +.CG terminal "paddd" sse_avx + +.IL PI4SUBRX xmm xmm +Integer reverse-subtract. +.AT other null trm +.CG terminal "psubd" sse_avx + +.IL PI4ANDX xmm xmm +.AT other comm trm +.CG terminal "pand" sse_avx + +.IL PI4ANDNX xmm xmm +.AT other null trm +.CG terminal "pandn" sse_avx + +.IL PI4ORX xmm xmm +.AT other comm trm +.CG terminal "por" sse_avx + +.IL PI4XORX xmm xmm +.AT other comm trm +.CG terminal "pxor" sse_avx + + +.IL PI8ADDX xmm xmm +.AT other comm trm +.CG terminal "paddq" sse_avx + +.IL PI8SUBRX xmm xmm +Integer reverse-subtract. +.AT other null trm +.CG terminal "psubq" sse_avx + +.IL PI8ANDX xmm xmm +.AT other comm trm +.CG terminal "pand" sse_avx + +.IL PI8ANDNX xmm xmm +.AT other null trm +.CG terminal "pandn" sse_avx + +.IL PI8ORX xmm xmm +.AT other comm trm +.CG terminal "por" sse_avx + +.IL PI8XORX xmm xmm +.AT other comm trm +.CG terminal "pxor" sse_avx + + +.IL PI4CMPX xmm xmm stc +Vector dword integer compare; stc is the compare code; +one of the instructions pcmpXXd is generated for this ili. +.AT other null trm +.CG terminal asm_special + +.IL PI8CMPX xmm xmm stc +Vector qword integer compare; stc is the compare code; +one of the instructions pcmpXXq is generated for this ili. +.AT other null trm +.CG terminal asm_special + +.IL PI4MAXX xmm xmm +SSE4.1 packed signed dword integer maximum. +.AT other comm trm +.CG terminal "pmaxsd" sse_avx + +.IL PI4MINX xmm xmm +SSE4.1 packed signed dword integer minimum. +.AT other comm trm +.CG terminal "pminsd" sse_avx + +.IL PUI4MAXX xmm xmm +SSE4.1 packed unsigned dword integer maximum. +.AT other comm trm +.CG terminal "pmaxud" + +.IL PUI4MINX xmm xmm +SSE4.1 packed unsigned dword integer minimum. +.AT other comm trm +.CG terminal "pminud" + +.IL PUI4MAX arlnk xmm nme +SSE4.1 packed unsigned dword integer maximum. +.AT other comm trm ssenme +.CG terminal "pmaxud" + +.IL PUI4MIN arlnk xmm nme +SSE4.1 packed unsigned dword integer minimum. +.AT other comm trm ssenme +.CG terminal "pminud" + +.IL PSADD arlnk xmm nme +Perform 4 single-precision floating-point adds of the 4 values +in the 16-byte aligned memory location denoted by arlnk, and +the 4 values in the xmm register denoted by xmm. +The results are placed in xmm register 'xmm'. +.AT other comm trm ssenme +.CG terminal "addps" sse_avx + +.IL PSSUBR arlnk xmm nme +Reverse subtract: computes 'xmm' - 'arlnk', result placed in the +xmm register denoted by 'xmm'. +.AT other null trm ssenme +.CG terminal "subps" sse_avx + +.IL PSMUL arlnk xmm nme +Multiply contents of memory and 16-byte xmm register. +.AT other comm trm ssenme +.CG terminal "mulps" sse_avx + +.IL PSDIVR arlnk xmm nme +Reverse divide: op2/op1 -> op2. +.AT other null trm ssenme +.CG terminal "divps" sse_avx + +.IL PSAND arlnk xmm nme +Bitwise AND operation on s.p. values - used to implement absolute value. +.AT other comm trm ssenme +.CG terminal "andps" sse_avx + +.IL PSXOR arlnk xmm nme +Bitwise XOR operation on s.p. values. +.AT other comm trm ssenme +.CG terminal "xorps" sse_avx + +.IL PSMAX arlnk xmm nme +Single-precision packed maximum. +.AT other comm trm ssenme +.CG terminal "maxps" sse_avx + +.IL PSMIN arlnk xmm nme +Single-precison packed minimum. +.AT other comm trm ssenme +.CG terminal "minps" sse_avx + +.IL PSSQRT arlnk xmm nme +Compute square root of 4 s.p. values in memory and put result into +xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "sqrtps" sse_avx + +.IL RCPPS arlnk xmm nme +Compute single-precision approximations to reciprocal. +.AT other null trm ssenme +.CG terminal "rcpps" sse_avx + +.IL RSQRTPS arlnk xmm nme +Compute single-precision approximations to reciprocal square root. +.AT other null trm ssenme +.CG terminal "rsqrtps" sse_avx + +.IL CMPNEQPS arlnk xmm nme +Used for single-precision sqrt approximation. +.AT other null trm ssenme +.CG terminal "cmpneqps" sse_avx + +.IL PSADDX xmm xmm +Perform 4 single-precision floating point additions of the 4 +values in xmm register xmm1 and the 4 values in register xmm2. +The results are placed in register xmm2. +.AT other comm trm +.CG terminal "addps" sse_avx + +.IL PSSUBRX xmm xmm +Reverse-subtract contents of two 16-byte xmm registers. +.AT other null trm +.CG terminal "subps" sse_avx + +.IL PSMULX xmm xmm +Multiply contents of two 16-byte xmm registers. +.AT other comm trm +.CG terminal "mulps" sse_avx + +.IL PSDIVRX xmm xmm +Reverse-divide contents of two 16-byte xmm registers. +.AT other null trm +.CG terminal "divps" sse_avx + +.IL PSANDX xmm xmm +Bitwise AND operation on s.p. values - used to implement absolute value. +.AT other comm trm +.CG terminal "andps" sse_avx + +.IL PSANDNX xmm xmm +Bitwise ANDNOT operation on s.p. values. +.AT other null trm +.CG terminal "andnps" sse_avx + +.IL PSORX xmm xmm +Bitwise OR operation on s.p. values. +.AT other comm trm +.CG terminal "orps" sse_avx + +.IL PSXORX xmm xmm +Compute bitwise exclusive-OR of two xmm registers and place result +in second register. +.AT other comm trm +.CG terminal "xorps" sse_avx + +.IL PSMAXX xmm xmm +Single precision packed maximum. +.AT other comm trm +.CG terminal "maxps" sse_avx + +.IL PSMINX xmm xmm +Single precision packed minimum. +.AT other comm trm +.CG terminal "minps" sse_avx + +.IL PSSQRTX xmm xmm +Compute square root of 4 s.p. values in 1st xmm register and put result into +2nd xmm register. +.AT other null trm +.CG terminal "sqrtps" sse_avx + +.IL RCPPSX xmm xmm +Compute single-precision approximations to reciprocal. +.AT other null trm +.CG terminal "rcpps" sse_avx + +.IL RSQRTPSX xmm xmm +Compute single-precision approximations to reciprocal square root. +.AT other null trm +.CG terminal "rsqrtps" sse_avx + +.IL CMPNEQPSX xmm xmm +Used for single-precision square root approximation. +.AT other null trm +.CG terminal "cmpneqps" sse_avx + +.IL PSCMPX xmm xmm stc +Vector compare of single precision values. 'stc' is comparison code. +One of the instructions cmpXXps is generated for this ili. +.AT other null trm +.CG terminal asm_special + +.IL PDADD arlnk xmm nme +Perform 2 double-precision floating-point adds of the 2 values +in the 16-byte aligned memory location denoted by arlnk, and +the 2 values in the xmm register denoted by xmm. +The results are placed in xmm register 'xmm'. +.AT other comm trm ssenme +.CG terminal "addpd" ssedp sse_avx + +.IL PDSUBR arlnk xmm nme +Reverse subtract: computes 'xmm' - 'arlnk', result placed in the +xmm register denoted by 'xmm'. +.AT other null trm ssenme +.CG terminal "subpd" ssedp sse_avx + +.IL PDMUL arlnk xmm nme +Multiply contents of memory and 16-byte xmm register. +.AT other comm trm ssenme +.CG terminal "mulpd" ssedp sse_avx + +.IL PDDIVR arlnk xmm nme +Reverse divide: op2/op1 -> op2. +.AT other null trm ssenme +.CG terminal "divpd" ssedp sse_avx + +.IL PDAND arlnk xmm nme +Bitwise AND operation on d.p. values - used to implement absolute value. +.AT other comm trm ssenme +.CG terminal "andpd" ssedp sse_avx + +.IL PDXOR arlnk xmm nme +Bitwise XOR operation on d.p. values. +.AT other comm trm ssenme +.CG terminal "xorpd" ssedp sse_avx + +.IL PDMAX arlnk xmm nme +Double precision packed maximum. +.AT other comm trm ssenme +.CG terminal "maxpd" ssedp sse_avx + +.IL PDMIN arlnk xmm nme +Double precision packed minimum. +.AT other comm trm ssenme +.CG terminal "minpd" ssedp sse_avx + +.IL PDSQRT arlnk xmm nme +Compute square root of 2 d.p. values in memory and put result into +xmm register denoted by xmm. +.AT other null trm ssenme +.CG terminal "sqrtpd" ssedp sse_avx + +.IL PDADDX xmm xmm +Perform 2 double-precision floating point additions of the 2 +values in xmm register xmm1 and the 2 values in register xmm2. +The results are placed in register xmm2. +.AT other comm trm +.CG terminal "addpd" ssedp sse_avx + +.IL PDSUBRX xmm xmm +Reverse-subtract contents of two 16-byte xmm registers. +.AT other null trm +.CG terminal "subpd" ssedp sse_avx + +.IL PSADDSUBX xmm xmm +Perform single-precision floating point additions of the 2 +values in xmm register xmm1 and the 2 values in register xmm2. +The results are placed in register xmm2. +.AT other null trm +.CG terminal "addsubps" sse_avx +.SI double fadd lat(5:7) + +.IL PDADDSUBX xmm xmm +Perform double-precision floating point additions of the 2 +values in xmm register xmm1 and the 2 values in register xmm2. +The results are placed in register xmm2. +.AT other null trm +.CG terminal "addsubpd" ssedp sse_avx +.SI double fadd lat(5:7) + +.IL MOVSHDUPX xmm +Move packed single precision and duplicate high. Used to get imaginary part of single complex. +Source can be memory. +.AT other null trm +.CG terminal "movshdup" ssedp sse_avx + +.IL MOVSLDUPX xmm +Move packed single precision and duplicate low. Can be used to get real part of single complex. +Source can be memory. +.AT other null trm +.CG terminal "movsldup" ssedp sse_avx + +.IL PDMULX xmm xmm +Multiply contents of two 16-byte xmm registers. +.AT other comm trm +.CG terminal "mulpd" ssedp sse_avx + +.IL PDDIVRX xmm xmm +Reverse-divide contents of two 16-byte xmm registers. +.AT other null trm +.CG terminal "divpd" ssedp sse_avx + +.IL PDANDX xmm xmm +Bitwise AND operation on d.p. values - used to implement absolute value. +.AT other comm trm +.CG terminal "andpd" ssedp sse_avx + +.IL PDANDNX xmm xmm +Bitwise ANDNOT operation on d.p. values. +.AT other null trm +.CG terminal "andnpd" ssedp sse_avx + +.IL PDORX xmm xmm +Bitwise OR operation on d.p. values. +.AT other comm trm +.CG terminal "orpd" ssedp sse_avx + +.IL PDXORX xmm xmm +Compute bitwise exclusive-OR of two xmm registers and place result +in second register. +.AT other comm trm +.CG terminal "xorpd" ssedp sse_avx + +.IL PDMAXX xmm xmm +Double precision packed maximum. +.AT other comm trm +.CG terminal "maxpd" ssedp sse_avx + +.IL PDMINX xmm xmm +Double precision packed minimum. +.AT other comm trm +.CG terminal "minpd" ssedp sse_avx + +.IL PDSQRTX xmm xmm +Compute square root of 2 d.p. values in 1st xmm register and put result into +2nd xmm register. +.AT other null trm +.CG terminal "sqrtpd" ssedp sse_avx + +.IL PDCMPX xmm xmm stc +Vector compare of double precision values. 'stc' is comparison code. +One of the instructions cmpXXpd is generated for this ili. +.AT other null trm +.CG terminal asm_special ssedp + +.IL PSLLSH irlnk xmm +Shift packed 4-byte integers left. +.AT other null trm +.CG terminal "pslld" + +.IL PSRLSH irlnk xmm +Shift packed 4-byte integers logical right (zero fill). +.AT other null trm +.CG terminal "psrld" + +.IL PSRASH irlnk xmm +Shift packed 4-byte integers arithmetically right (sign extend). +.AT other null trm +.CG terminal "psrad" + +.IL PDLLSH irlnk xmm +Shift packed 8-byte integers left. +.AT other null trm +.CG terminal "psllq" ssedp + +.IL PDRLSH irlnk xmm +Shift packed 8-byte integers logical right (zero fill). +.AT other null trm +.CG terminal "psrlq" ssedp + +.IL PDRASH irlnk xmm +Shift packed 8-byte integers arithmetically right (sign extend). +NO SUCH INSTRUCTION. +.AT other null trm +.CG notCG terminal "psraq" ssedp + +.IL PBBLENDX xmm xmm xmm +SSE4.1 Variable Blend Packed Bytes +.AT other null trm +.CG terminal "pblendvb" asm_special + +.IL PSBLENDX xmm xmm xmm +SSE4.1 Variable Blend Packed Single Precision Floating-Point Values +.AT other null trm +.CG terminal "blendvps" asm_special + +.IL PDBLENDX xmm xmm xmm +SSE4.1 Variable Blend Packed Double Precision Floating-Point Values +.AT other null trm +.CG terminal "blendvpd" asm_special ssedp + +.IL PBBLEND arlnk xmm nme xmm +SSE4.1 Variable Blend Packed Bytes +.AT other null trm ssenme +.CG terminal "pblendvb" asm_special + +.IL PSBLEND arlnk xmm nme xmm +SSE4.1 Variable Blend Packed Single Precision Floating-Point Values +.AT other null trm ssenme +.CG terminal "blendvps" asm_special + +.IL PDBLEND arlnk xmm nme xmm +SSE4.1 Variable Blend Packed Double Precision Floating-Point Values +.AT other null trm ssenme +.CG terminal "blendvpd" asm_special ssedp + +.\" +.\" Start of AVX-only ILIs. +.\" + +.IL VFEXTRACT128X xmm xmm stc +An AVX-only ILI. Extract 128 bits of packed floating-point values +from xmm1 (a ymm register) at an offset determined by stc (0 = bits +0:127 of xmm1, 1 = bits 128:255 of xmm1), and store the result in xmm2 +(an xmm register). +.AT other null trm +.CG terminal "vextractf128" avx_only asm_special + +.IL VFINSERT128X xmm xmm xmm stc +Insert 128-bits of packed floatingpoint values from xmm1 and +the remaining values from xmm2(ymm register) into xmm3(ymm register) +.AT other null trm +.CG terminal "vinsertf128" avx_only asm_special + +.\" +.\" End of AVX-only ILIs. +.\" + +.\"BT.IL PSMACC arlnk xmm nme xmm +.\"BTRepresents one of the 8 packed single-precision FMACC instructions. +.\"BTThe type of instruction is specified by immediately preceding MACCTYPE +.\"BTili (due to limited number of ili operands). +.\"BT.AT other null trm ssenme +.\"BT.CG terminal asm_special +.\"BT +.\"BT.IL PSMACCX xmm xmm xmm stc +.\"BTRepresents one of the 8 packed single-precision FMACC instructions. +.\"BTThe last operand, 'stc' specifies which of the 8 instructions to +.\"BTuse. It's value is created using the FMACC_ macros defined in ili.h. +.\"BT.AT other null trm +.\"BT.CG terminal asm_special +.\"BT +.\"BT.IL PDMACC arlnk xmm nme xmm +.\"BTRepresents one of the 8 packed double-precision FMACC instructions. +.\"BTThe type of instruction is specified by immediately preceding MACCTYPE +.\"BTili (due to limited number of ili operands). +.\"BT.AT other null trm ssenme +.\"BT.CG terminal asm_special ssedp +.\"BT +.\"BT.IL PDMACCX xmm xmm xmm stc +.\"BTRepresents one of the 8 packed double-precision FMACC instructions. +.\"BTThe last operand, 'stc' specifies which of the 8 instructions to +.\"BTuse. It's value is created using the FMACC_ macros defined in ili.h. +.\"BT.AT other null trm +.\"BT.CG terminal asm_special ssedp +.\"BT +.\"BT.IL MACCTYPE stc +.\"BTUsed to specify type of immediately following PSMACC or PDMACC instruction. +.\"BTstc is created using the FMACC_ macros defined in ili.h. +.\"BT.AT other null trm +.\"BT.CG terminal notAILI +.\"BT + +.IL PDFMA arlnk xmm nme xmm +A packed double-precision FMA3 or FMA4 instruction which computes: + dest = (src1 * src2) src3 +where: + arlink = src2 or src3 + xmm1 = src1 + xmm2 = ((arlnk == src2) ? src3 : src2) +.br +Since ILIs have a maximum of 4 operands this ILI is always immediately +preceded by an FMATYPE ILI which provides other information about the +FMA instruction, namely (i) flags to specify the values of +(+/-) and (+/-), and to indicate whether 'arlnk' corresponds +to 'src2' or 'src3', and (ii) the 'dest' operand. +.AT other null trm ssenme +.CG terminal asm_special ssedp + +.IL PDFMAX xmm xmm xmm xmm +A packed double-precision FMA3 or FMA4 instruction which computes: + dest = (src1 * src2) src3 +where: + xmm1 = src1 + xmm2 = src2 + xmm3 = src3 + xmm4 = dest +.br +Note, for FMA3 'dest' must be the same as one of the source operands. +.br +Since ILIs have a maximum of 4 operands this ILI is always immediately +preceded by an FMATYPE ILI which specifies the values of (+/-) +and (+/-). +.AT other null trm +.CG terminal asm_special ssedp + +.IL PSFMA arlnk xmm nme xmm +This is the same as PDFMA except that it specifies a packed single +precision FMA3 or FMA4 instruction. +.AT other null trm ssenme +.CG terminal asm_special + +.IL PSFMAX xmm xmm xmm xmm +This is the same as PDFMAX except that it specifies a packed single +precision FMA3 or FMA4 instruction. +.AT other null trm +.CG terminal asm_special + +.IL FMATYPE stc xmm +This provides extra information about the immediately following PDFMA, +PDFMAX, PSFMA or PSFMAX ILI. Its operands are: +.br +stc = a set of flags which specify the values of (+/-) and + (+/-), and for PDFMA and PSFMA, whether arlnk is src2 or + src3. The flags are defined by 'FMA_...' macros in "ili.h". +.br +xmm = the 'dest' operand for PDFMA or PSFMA, or 0 for PDFMAX and PSFMAX. + For FMA3 'dest' must be the same as one of the source operands, + i.e. one of the xmm operands in the PDFMA or PSFMA ILI. +.AT other null trm +.CG terminal notAILI + +.IL CLTD +Used with signed integer divide/mod instruction. +.AT other null ir +.CG CGonly "cltd" ccmod asm_special + +.IL CQTO +Not used by X86_32 compiler +.AT other null kr +.CG notCG notAILI + +.IL CMOV +Conditionally copy op2 into op1 based on condition codes. +.AT load null ir +.CG CGonly asm_special "cmov" + +.IL CMOVSP +Single precision conditional move. Expanded by the CG. +.AT load null sp +.CG CGonly asm_special "movss" + +.IL CMOVDP +Double precision conditional move. Expanded by the CG. +.AT load null dp +.CG CGonly asm_special "movsd" + +.IL CMOVSCMPLX +Single precision complex conditional move. Expanded by the CG. +.AT load null cs +.CG CGonly asm_special "movsd" + +.IL CMOVDCMPLX +Double precision complex conditional move. Expanded by the CG. +.AT load null cd +.CG CGonly asm_special "movupd" + +.IL CMOVLPD +Same as CMOVDP, but used when "movlpd" is preferred. +.AT load null dp +.CG CGonly asm_special "movlpd" + +.IL CSETB +Conditional set of a byte +.AT store null ir +.CG CGonly asm_special "set" +.SI ld direct lat(4) +.SI direct lat(1) + +.IL INC +Increment integer register or memory operand. +.AT arth null ir cse +.CG CGonly ccarith "inc" + +.IL DEC +Decrement integer register or memory operand. +.AT arth null ir cse +.CG CGonly ccarith "dec" + +.IL LEA irlnk stc +32-bit load effective address instruction. This only appears in the +linear and attributed ILIs, not the shared ILIs. The LILI is created +by 'cglinear.c:optimize_imul()', in which case 'irlnk' is used as both +the base and index register, and 'stc' is the shift count, which may +be 1, 2, 4 or 8. The AILI may be generated from a LEA LILI or it may +be created by a peephole optimisation. +.AT arth null ir cse +.CG CGonly "lea" 'l' + +.IL KLEA krlnk stc +Used by the 64-bit compiler only. +.AT arth null kr cse +.CG notCG + +.IL MOV +Synonym for LD and ST, and register to register moves. +.AT move null ir cse +.CG CGonly "mov" move + +.IL MOVABS +Not used by X86_32 compiler +.AT move null ir cse +.CG notCG notAILI + +.IL BIH stc stc +Created by the code generator to represent, in the linear ili and the AILI, +the beginning of a basic block. The first operand is the bih number, and +the second is the label symbol table pointer, if any. +.AT other null trm dom +.CG CGonly terminal asm_nop + +.IL DEF +Placed into the AILI to indicate the definition of a register which is +otherwise not explicitly defined (by appearing in the 'dest' field of +some aili). The register allocators need this information in certain +cases. +.AT other null trm +.CG CGonly asm_nop + +.IL USE +Placed into the AILI to indicate the use of a register which is otherwise +not explicitly used. The register allocators need to know this in order +to avoid a conflicting register allocation, etc. +.AT other null trm +.CG CGonly asm_nop + +.IL STACK_ADJ +Placed into the AILI to indicate that the stack pointer has been +modified by the value specified in the src1 field of the aili. +No code is generated for this ili. +.AT other null trm +.CG CGonly asm_special + +.IL ALLOC krlnk +Allocate memory for a C or C++ variable length array. +'krlnk' is the size. Result is the address of the allocated memory. +.AT arth null ar +.CG notCG + +.IL DEALLOC arlnk +Deallocate memory that was allocated by ALLOC. +'arlnk' is the memory address. +.AT other null trm +.CG notCG + +.IL ALLOCA krlnk +Allocate memory with alloca +'krlnk' is the size. Result is the address of the allocated memory. +.AT arth null ar +.CG notCG + +.IL CFA arlnk nme +Materialize the outer call frame address as a builtin. This is +placed into a load address register from a memory location whose address +is represented by op1. +.AT other null ar cse +.CG 'l' asm_special + +.IL EHRET arlnk nme +Materialize the return address of the caller as a builtin. This is +placed into a load address register from a memory location whose address +is represented by op1. +.AT other null ar cse +.CG 'l' asm_special + +.IL EHREGS +Materialize the return address of the caller as a builtin. This is +placed into a load address register from a memory location whose address +is represented by op1. +.AT other null trm +.CG terminal asm_special + +.IL EHREGST sym sym +Store implicit registers into the syms: catch_clause and caught_object +.AT other null trm +.CG asm_special terminal + +.IL EHREGLD sym sym +Materialize the syms: catch_clause and caught_object into the two symbols +from implicit registers +.AT other null trm +.CG asm_special terminal + +.IL EHRESUME sym sym +Resume propagation of an existing in-flight exception whose unwinding was +interrupted to run some cleanup code. +.AT other null trm +.CG asm_special terminal + +.IL ACCEL lnk +Start a block of code to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ENDACCEL lnk +End a block of code to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ACCKERNELS lnk +Start a block of kernels to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ACCENDKERNELS lnk +End a block of kernels to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ACCPAR lnk +Start a block of parallel code to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ACCENDPAR lnk +End a block of parallel code to be targeted for accelerator +.AT other null trm +.CG notCG + +.IL ACCSCALARREG lnk +Start a block of code to run as a scalar kernel on the accelerator +.AT other null trm +.CG notCG + +.IL ACCENDSCALARREG +End a block of code to run as a scalar kernel on the accelerator +.AT other null trm +.CG notCG + +.IL ACCSERIAL lnk +Start a block of code to run as a serial kernel on the accelerator +.AT other null trm +.CG notCG + +.IL ACCENDSERIAL +End a block of code to run as a serial kernel on the accelerator +.AT other null trm +.CG notCG + +.IL ACCELLP lnk +The following loop is to be targeted for the accelerator +.AT other null trm +.CG notCG + +.IL ACCSLOOP lnk stc +The following loop in a serial region is to be targeted for the accelerator +The second operand is one when this loop is tightly nested in the compute construct, and zero otherwise; +.AT other null trm +.CG notCG + +.IL ACCKLOOP lnk stc +The following loop in a kernels region is to be targeted for the accelerator +The second operand is one when this loop is tightly nested in the compute construct, and zero otherwise; +.AT other null trm +.CG notCG + +.IL ACCPLOOP lnk stc +The following loop in a parallel region is to be targeted for the accelerator +The second operand is one when this loop is tightly nested in the compute construct, and zero otherwise; +.AT other null trm +.CG notCG + +.IL ACCATTACH lnk lnk lnk sym +Attach the pointer/allocatable member in an aggregate structure data variable +.AT other null lnk +.CG notCG + +.IL ACCDETACH lnk lnk lnk sym +Detach the pointer/allocatable member in an aggregate structure data variable +.AT other null lnk +.CG notCG + +.IL ACCCOPY lnk lnk lnk sym stc +Variable or array will be copied from host to device and back +.AT other null lnk +.CG notCG + +.IL ACCCOPYIN lnk lnk lnk sym stc +Variable or array will be copied from host to device +.AT other null lnk +.CG notCG + +.IL ACCCOPYOUT lnk lnk lnk sym stc +Variable or array will be copied from device to host +.AT other null lnk +.CG notCG + +.IL ACCLOCAL lnk lnk lnk sym stc +Variable or array will be allocated on the device but not copied +to or from the host +.AT other null lnk +.CG notCG + +.IL ACCCREATE lnk lnk lnk sym stc +Variable or array will be allocated on the device but not copied +to or from the host +.AT other null lnk +.CG notCG + + +.IL ACCDELETE lnk lnk lnk sym stc +Variable or array will be deleted from the device but not copied +to or from the host +.AT other null lnk +.CG notCG + +.IL ACCPDELETE lnk lnk lnk sym stc +Variable or array will be deleted from the device but not copied, unless in a data region +to or from the host +.AT other null lnk +.CG notCG + +.IL ACCPRESENT lnk lnk lnk sym stc +Variable or array must be present on the device +.AT other null lnk +.CG notCG + +.IL ACCPCOPY lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will be copied +.AT other null lnk +.CG notCG + +.IL ACCPCOPYIN lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will be copied in +.AT other null lnk +.CG notCG + +.IL ACCPCOPYOUT lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will be copied out +.AT other null lnk +.CG notCG + +.IL ACCPCREATE lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will be allocated, +but not copied +.AT other null lnk +.CG notCG + +.IL ACCPNOT lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will NOT be allocated +nor copied. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth argument is the symbol that points to the device copy, if there is such +a symbol. +Fifth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCNO_CREATE lnk lnk lnk sym stc +Variable or array may be present on the device, but if not will NOT be allocated +nor copied. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth argument is the symbol that points to the device copy, if there is such +a symbol. +Fifth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATEHOST lnk lnk lnk stc +Variable or array will be copied from device back to host. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATESELF lnk lnk lnk stc +Variable or array will be copied from device back to the current thread. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATEDEV lnk lnk lnk stc +Variable or array will be copied from host to device. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATEHOSTIFP lnk lnk lnk stc +Variable or array will be copied from device back to host, if present. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATESELFIFP lnk lnk lnk stc +Variable or array will be copied from device back to the current thread, if present. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATEDEVIFP lnk lnk lnk stc +Variable or array will be copied from host to device, if present. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCUPDATE lnk +Head of a list of update clauses +.AT other null trm +.CG notCG + +.IL PCASTCOMPARE lnk +Head of a list of PCAST compare clauses. +.AT other null trm +.CG notCG + +.IL ACCCOMPARE lnk lnk lnk stc +Variable or array will be copied from device back to host. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL PGICOMPARE lnk lnk lnk stc +Variable or array will be copied from device back to host. +First link is to next clause. +Second link is to the array bounds. +Third link is to ACCSYMLNK. +Fourth arg is the policy index +.AT other null lnk +.CG notCG + +.IL ACCPRIVATE lnk lnk lnk +Variable or array is private to an iteration of the loop or to a worker +.AT other null lnk +.CG notCG + +.IL ACCFIRSTPRIV lnk lnk lnk +Variable or array is private to the workers, but initialize with values from the host +.AT other null lnk +.CG notCG + +.IL ACCCACHE lnk lnk lnk +The compiler should move the array to the highest level of the +software-managed cache +.AT other null lnk +.CG notCG + +.IL ACCDEVICEPTR lnk lnk lnk sym stc +Variable or array will be copied from device to host +.AT other null lnk +.CG notCG + +.IL ACCAUTO lnk stc +The execution mode will be selected by the compiler (gang/worker/vector/seq) +First link is to next clause. +Last argument is the device_type argument. +.AT other null lnk +.CG notCG + + +.IL ACCVECTOR lnk lnk stc +The iterations of the loop will be executed in vector mode on the accelerator +.AT other null lnk +.CG notCG + +.IL ACCPARALLEL lnk lnk stc +The iterations of the loop will be executed in parallel on the accelerator +.AT other null lnk +.CG notCG + +.IL ACCGANG lnk lnk stc stc +The iterations of the loop will be executed in across gangs on the accelerator. +First argument is the link to the next clause. +Second argument is the number of gangs. +Third argument is the device_type argument. +Fourth argument is the dimension, where the default is dimension zero (cuda X dimension). +.AT other null lnk +.CG notCG + +.IL ACCGANGCHUNK lnk lnk stc +The gang static-scheduling chunk size. +First argument is the link to the next clause. +Second argument is the chunk size. +Last argument is the device_type argument. +.AT other null lnk +.CG notCG + +.IL ACCWORKER lnk lnk stc +The iterations of the loop will be executed in across workers on the accelerator +.AT other null lnk +.CG notCG + +.IL ACCSEQ lnk lnk stc +The iterations of the loop will be executed sequentially on the accelerator +.AT other null lnk +.CG notCG + +.IL ACCHOST lnk lnk stc +The iterations of the loop will be executed on the host +.AT other null lnk +.CG notCG + +.IL ACCSHORTLOOP lnk stc +Trip count is less than the maximum size of a vector operation +(for vector schedule) or less than the maximum number of +simultaneously active parallel iterations (for parallel schedule) +.AT other null lnk +.CG notCG + + +.IL ACCTILE lnk lnk stc stc +Tile this loop. +First link is to the next clause. +Second link is to a list of ACCSIZE ILI. +Third argument is the tile depth. +Last argument is the device_type argument. +.AT other null lnk +.CG notCG + +.IL ACCSIZE lnk lnk +A size expression. +The first link is to the next size expression, if any, or to NULL. +The second link is the expression, if any, or to NULL. +.AT other null lnk +.CG notCG + +.IL ACCINDEPENDENT lnk +The iterations of the loop are data-independent +.AT other null lnk +.CG notCG + +.IL ACCNUMGANGS lnk lnk stc stc +How many gangs to instantiate +First link is the link to the next clause. +Second argument is the number of gangs. +Third argument is the device_type argument. +Fourth argument is the dimension, where the default is dimension zero (cuda X dimension). +.AT other null lnk +.CG notCG + +.IL ACCNUMWORKERS lnk lnk stc +How many workers to instantiate +.AT other null lnk +.CG notCG + +.IL ACCVLENGTH lnk lnk stc +How long a vector to instantiate +.AT other null lnk +.CG notCG + +.IL ACCIF lnk lnk +Region will execute conditionally on host or accelerator. +.AT other null lnk +.CG notCG + +.IL ACCDEVID lnk lnk stc +Device ID of the device to use for this directive or construct. +.AT other null lnk +.CG notCG + +.IL ACCUNROLL lnk lnk stc stc +Control loop unrolling; the 3rd element tells whether it's the parallel, vector, or sequential loop to be unrolled +.AT other null lnk +.CG notCG + +.IL ACCKERNEL lnk +.AT other null lnk +.CG notCG + +.IL ACCTRIPLE lnk lnk lnk lnk +Specify bounds of sub-arrays in accelerator clauses. +.AT other null lnk +.CG notCG + +.IL ACCDATAREG lnk +Generate data movement to/from accelerator +.AT other null trm +.CG notCG + +.IL ACCENTERDATA lnk +Generate data movement at enter data directive +.AT other null trm +.CG notCG + +.IL ACCEXITDATA lnk +Generate data movement at exit data directive +.AT other null trm +.CG notCG + +.IL ACCFINALEXITDATA lnk +Generate data movement at exit data directive with finalize clause. +Link to list of arguments. +.AT other null trm +.CG notCG + +.IL ACCENDDATAREG +Generate matching data movement to/from accelerator +.AT other null trm +.CG notCG + +.IL ACCPHI lnk stc stc +PHI operator used in accelerator optimizing code generator. +Link points to ACCPHILINK, and the 2nd operand is a symbol numbering. +3rd operand is nonzero for loop header phi +.AT other null trm +.CG notCG notAILI accel + +.IL ACCLHPHI lnk stc +PHI operator for loop headers used in accelerator optimizing code generator. +Link points to ACCPHILINK, and the 2nd operand is a symbol numbering. +.AT other null trm +.CG notCG notAILI accel + +.IL ACCPHILINK lnk lnk +PHI operator for loop headers used in accelerator optimizing code generator. +First link is to next PHILINK, 2nd link is the chain to the reaching def. +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCINIT +Dummy initial value for factored use-def chains. +First link is to next PHILINK, 2nd link is the chain to the reaching def. +.AT other null trm +.CG notCG notAILI accel + + +.IL ACCVAR stc +Used in accelerator optimizing code generator, a builtin variable ref. +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCLDSYM stc stc +Used in accelerator optimizing code generator, a load of a temp variable +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCSTSYM lnk stc stc +Used in accelerator optimizing code generator, a load of a temp variable +.AT other null trm +.CG notCG notAILI accel + +.IL ACCIVAL stc stc +Used in accelerator optimizing code generator, a literal constant; +uses two operands to hold an ISZ_T value. +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCJSR stc lnk +Used in accelerator optimizing code generator, special routine call +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCRETURN stc lnk +Used in accelerator optimizing code generator, return value from a function call +Short constant holds the return datatype. +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCLOR lnk lnk +Used in accelerator optimizing code generator, logical OR +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCCAST lnk stc +Used in accelerator optimizing code generator, type casting +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCJMP lnk sym +Used in accelerator optimizing code generator, conditional jump +The 'sym' is a normally an ACBLK index. During linearization, the 'stc' will +be a symbol index if positive and an ACBLK index negated if negative, until +'acc_replace_labels'. +.AT branch null lnk +.CG notCG notAILI accel + +.IL ACCARG lnk lnk +Used in accelerator optimizing code generator, argument list +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCBOUND lnk lnk stc stc +Used in accelerator optimizing code generator, array bounds check. +Fields are subscript expression, ACCBOUND2, line number, array symbol +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCBOUND2 lnk lnk stc +Used in accelerator optimizing code generator, array bounds check. +Fields are lower bound, upper bound, subscript number. +.AT other null lnk +.CG notCG notAILI accel + +.IL ACCWAIT lnk stc +Used in accelerator code, wait on the host for each kernel to finish +.AT other null lnk +.CG notCG notAILI + +.IL ACCNOWAIT lnk +Used in accelerator code, don't wait on the host for each kernel to finish +.AT other null lnk +.CG notCG notAILI + +.IL ACCASYNC lnk lnk stc +Used in accelerator code, perform this activity asynchronously +.AT other null lnk +.CG notCG notAILI + +.IL ACCWAITDIR lnk +Used in accelerator code, wait on the host for async activities to finish +.AT other null trm +.CG notCG notAILI + +.IL ACCWAITARG lnk lnk stc +Used in accelerator code, wait on the host for async activities to finish +.AT other null lnk +.CG notCG notAILI + +.IL ACCLOOP lnk stc sym +Used in accelerator code, to generate an explicit 'vector' loop. +The first argument is the trip count, the second is an accelerator symbol number of the loop variable. +The third argument is the label of the exit branch. +.AT branch null trm +.CG notCG notAILI accel + +.IL ACCENDLOOP sym +Used in accelerator code, to end an explicit 'vector' loop. +The argument is the label of the top of the loop. +.AT branch null trm +.CG notCG notAILI accel + +.IL KERNEL lnk +Start a nest of loops to be turned into CUDA kernels +.AT other null trm +.CG notCG + +.IL ENDKERNEL lnk +End a nest of loops to be turned into CUDA kernels +.AT other null trm +.CG notCG + +.IL KERNELBLOCK lnk lnk stc +Block size for one kernel loop. +The constant is the loop nest level. +.AT other null trm +.CG notCG + +.IL KERNELGRID lnk lnk stc +Grid size for one kernel loop. +The constant is the loop nest level. +.AT other null trm +.CG notCG + +.IL KERNELNEST lnk stc +nest depth of kernel loops +.AT other null trm +.CG notCG + +.IL KERNELSTREAM lnk stc +stream argument to CUF kernel +.AT other null trm +.CG notCG + +.IL KERNELDEVICE lnk stc +device argument to CUF kernel +.AT other null trm +.CG notCG + + +.IL ACCIMPDATAREG lnk stc +Generate data movement to/from accelerator. +This is for the implicit data region; the constant is normally zero, +but is '1' when there is a need for a pgi_cu_init call regardless of +whether there is any data to move or allocate +.AT other null trm +.CG notCG + +.IL ACCENDIMPDATAREG stc +Generate matching data movement to/from accelerator +This is for the implicit data region +The short constant tells how many implicit data regions were generated +.AT other null trm +.CG notCG + +.IL ACCMIRROR lnk lnk lnk sym +Variable or array will be mirrored on the device as on the host +.AT other null lnk +.CG notCG + +.IL ACCREFLECT lnk lnk lnk sym +Variable or array has been reflected on the device as on the host +.AT other null lnk +.CG notCG + +.IL ACCREDUCTION lnk lnk lnk stc +Variable is a reduction variable. 'stc' is the operator. +.AT other null lnk +.CG notCG + +.IL ACCCACHEDIR lnk stc +Accelerator CACHE directive. +The 'stc' argument is normally zero, but is set to '1' if this is a 'readonly' cache directive. +.AT other null lnk +.CG notCG + +.IL ACCCACHEARG lnk lnk lnk +Accelerator CACHE argument. +.AT other null lnk +.CG notCG + +.IL ACCHOSTDATA lnk +Begin host data region. +.AT other null trm +.CG notCG + +.IL ACCENDHOSTDATA +End host data region. +.AT other null trm +.CG notCG + +.IL ACCUSEDEVICE lnk lnk lnk sym +Use the device address of a variable or array. +.AT other null lnk +.CG notCG + +.IL ACCUSEDEVICEIFP lnk lnk lnk sym +Use the device address of a variable or array, if present +.AT other null lnk +.CG notCG + +.IL ACCSYMLNK sym lnk lnk nme +This is used from a link from many other accelerator ILI to +recover the original symbol as well as a link to the address tree, +if appropriate. +Symbol is a symbol pointer. +The first link is a link to reference the symbol. +The second link is a link to reference the parent of the symbol, if the symbol was a member. +The constant value is the NME of the parent, if the symbol was a member. +.AT other null lnk +.CG notCG + +.IL ACCCOLLAPSE lnk stc stc stc +Number of loops associated with the loop construct. +First link to next argument. +Second argument is the collapse depth. +Third argument is set if this is a nontightly nested loop (force) +Last argument is the device_type argument. +.AT other null lnk +.CG notCG + +.IL ACCDEFNONE lnk +Tells the accelerator CG that a default-none clause is in effect. +The link is to other clauses. +.AT other null lnk +.CG notCG + +.IL ACCDEFPRESENT lnk +Tells the accelerator CG that a default-present clause is in effect. +The link is to other clauses. +.AT other null lnk +.CG notCG + +.IL ACCDEVICERES lnk lnk lnk sym +Variable or array will be resident on the device. +.AT other null lnk +.CG notCG + +.IL ACCLINK lnk lnk lnk sym +A link to the variable or array will be resident on the device. +.AT other null lnk +.CG notCG + +.IL ACCLOOPPRIVATE sym +The symbol must be made implicitly private in the containing loop. +.AT other null trm +.CG notCG + +.IL ACCJMPTABLE lnk lnk stc +Used in the Accelerator CG. +A jump table. +The first link is to a linked list of ACCJMPENTRY ACLILI. +The second link is to the expression used to index the table. +The 'stc' is an ACBLK index of the default jump target. +.AT other null trm +.CG notCG + +.IL ACCJMPENTRY lnk lnk stc +Used in the Accelerator CG. +A jump table entry. +The first link is to the next entry in a linked list of ACCJMPENTRY ACLILI. +The second link is to an ACCIVAL that contains the value to match for this jump table entry. +The 'stc' is an ACBLK index of this jump target. +.AT other null lnk +.CG notCG + + +.IL ARGQP dplnk lnk +Defines a quad precision memory argument used in m128 support +\'dplnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg "movupd" + +.IL ARG256 dplnk lnk +Defines a 256-bit argument used in m256 support +\'dplnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG memarg "movupd" sse_avx + +.IL GENARG lnk lnk stc stc +Define an argument for a function call. +The ARG ILIs for all of a function's arguments are linked together. +\'lnk1' points to the argument. +\'lnk2' points to the next ARG ILI. +\'stc1' is the datatype of the argument, if available +\'stc2' is the NME +.AT define null lnk +.CG notCG + +.IL GENARG2 lnk lnk stc stc +Define 2nd argument of an argument pair for a function call. +This will be linked immediately to the matching GENARG +The ARG ILIs for all of a function's arguments are linked together. +\'lnk1' points to the argument. +\'lnk2' points to the next ARG ILI. +\'stc1' is the datatype of the argument, if available +\'stc2' is the NME +.AT define null lnk +.CG notCG + +.IL RETURN lnk stc nme +Define return value from a function. +\'lnk' points to the return value. +\'stc' is the datatype of the argument. +\'nme' is the nme of the argument +.AT move null trm +.CG notCG + +.IL VCON sym +.AT cons null lnk cse vect +.CG notCG +.IL VLD arlnk nme stc +For all vector ILI except VCON the last operand is the vector dtype +.AT load null lnk vect +.CG notCG +.IL VLDU arlnk nme stc +.AT load null lnk vect +.CG notCG +.IL VNEG lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VADD lnk lnk stc +.AT arth comm lnk cse vect +.CG notCG +.IL VSUB lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VMUL lnk lnk stc +.AT arth comm lnk cse vect +.CG notCG +.IL VDIV lnk lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VDIVZ lnk lnk lnk stc +Vector divide where divide by zero does not fault. +.AT arth null lnk cse vect +.CG notCG +.IL VMOD lnk lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VMODZ lnk lnk lnk stc +Vector remainder where divide by zero does not fault. +.AT arth null lnk cse vect +.CG notCG +.IL VCVTV lnk stc stc +.AT arth null lnk cse vect +.IL VCVTS lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VCVTR lnk stc stc +Reinterpret the bits of a vector as if they were a different vector type. +This should always be a no-op at runtime. +.AT arth null lnk cse vect +.IL VNOT lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VAND lnk lnk stc +.AT arth comm lnk cse vect +.CG notCG +.IL VOR lnk lnk stc +.AT arth comm lnk cse vect +.CG notCG +.IL VXOR lnk lnk stc +.AT arth comm lnk cse vect +.CG notCG +.IL VCMPNEQ lnk lnk stc +Used for single-precision square root approximation. +.AT arth comm lnk cse vect +.CG notCG +.IL VLSHIFTV lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VRSHIFTV lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VLSHIFTS lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VRSHIFTS lnk lnk stc +.AT arth null lnk cse vect +.CG notCG +.IL VURSHIFTS lnk lnk stc +Vector unsigned (logical) right shift by a scalar +.AT arth null lnk cse vect +.CG notCG +.IL VMIN lnk lnk stc +Vector minimum +.AT arth null lnk cse vect +.CG notCG +.IL VMAX lnk lnk stc +Vector maximum +.AT arth null lnk cse vect +.CG notCG +.IL VABS lnk stc +Vector absolute value +.AT arth null lnk cse vect +.CG notCG +.IL VSQRT lnk lnk stc +Vector square root +.AT arth null lnk cse vect +.CG notCG +.IL VCOS lnk lnk stc +Vector cosine - final link is potential mask as it is +for all the math intrinsic calls (will be IL_NULL if no mask) +.AT arth null lnk cse vect +.CG notCG +.IL VSIN lnk lnk stc +Vector sine +.AT arth null lnk cse vect +.CG notCG +.IL VSINCOS lnk lnk stc +Vector sine-cosine +.AT arth null lnk cse vect +.CG notCG +.IL VASIN lnk lnk stc +Vector arc sine +.AT arth null lnk cse vect +.CG notCG +.IL VACOS lnk lnk stc +Vector arc cosine +.AT arth null lnk cse vect +.CG notCG +.IL VATAN lnk lnk stc +Vector arctangent +.AT arth null lnk cse vect +.CG notCG +.IL VATAN2 lnk lnk lnk stc +Vector arctangent2 +.AT arth null lnk cse vect +.CG notCG +.IL VTAN lnk lnk stc +Vector tangent +.AT arth null lnk cse vect +.CG notCG +.IL VSINH lnk lnk stc +Vector hyperbolic sine +.AT arth null lnk cse vect +.CG notCG +.IL VCOSH lnk lnk stc +Vector hyperbolic cosine +.AT arth null lnk cse vect +.CG notCG +.IL VTANH lnk lnk stc +Vector hyperbolic tangent +.AT arth null lnk cse vect +.CG notCG +.IL VEXP lnk lnk stc +Vector natural exponential +.AT arth null lnk cse vect +.CG notCG +.IL VLOG lnk lnk stc +Vector natural logarithm +.AT arth null lnk cse vect +.CG notCG +.IL VLOG10 lnk lnk stc +Vector logarithm base 10 +.AT arth null lnk cse vect +.CG notCG +.IL VPOW lnk lnk lnk stc +Vector pow float +.AT arth null lnk cse vect +.CG notCG +.IL VPOWI lnk lnk lnk stc +Vector pow float to integer +.AT arth null lnk cse vect +.CG notCG +.IL VPOWK lnk lnk lnk stc +Vector pow float to integer*8 +.AT arth null lnk cse vect +.CG notCG +.IL VPOWIS lnk lnk lnk stc +Vector pow float to scalar integer +.AT arth null lnk cse vect +.CG notCG +.IL VPOWKS lnk lnk lnk stc +Vector pow float to scalar integer*8 +.AT arth null lnk cse vect +.CG notCG +.IL VFPOWK lnk lnk lnk stc +Vector pow float to integer*8 +.AT arth null lnk cse vect +.CG notCG +.IL VFPOWKS lnk lnk lnk stc +Vector pow float to scalar integer*8 +.AT arth null lnk cse vect +.CG notCG +.IL VDPOWI lnk lnk lnk stc +Vector pow double to integer +.AT arth null lnk cse vect +.CG notCG +.IL VDPOWIS lnk lnk lnk stc +Vector pow double to scalar integer +.AT arth null lnk cse vect +.CG notCG +.IL VRSQRT lnk lnk stc +Vector reciprocal square root +.AT arth null lnk cse vect +.CG notCG +.IL VFLOOR lnk lnk stc +Vector floor +.AT arth null lnk cse vect +.CG notCG +.IL VCEIL lnk lnk stc +Vector ceiling +.AT arth null lnk cse vect +.CG notCG +.IL VAINT lnk lnk stc +Vector truncation +.AT arth null lnk cse vect +.CG notCG +.IL VRCP lnk lnk stc +Vector reciprocal +.AT arth null lnk cse vect +.CG notCG +.IL VST lnk arlnk nme stc +.AT store null trm vect +.CG terminal notCG +.IL VSTU lnk arlnk nme stc +.AT store null trm vect +.CG terminal notCG +.IL VFMA1 lnk lnk lnk stc +Vector FMA for LLVM intrinsic - lnk1*lnk2+lnk3, with stc the dtype +.AT arth null lnk cse vect +.CG notCG +.IL VFMA2 lnk lnk lnk stc +Vector FMA for LLVM intrinsic - lnk1*lnk2-lnk3, with stc the dtype +.AT arth null lnk cse vect +.CG notCG +.IL VFMA3 lnk lnk lnk stc +Vector FMA for LLVM intrinsic - -lnk1*lnk2+lnk3, with stc the dtype +.AT arth null lnk cse vect +.CG notCG +.IL VFMA4 lnk lnk lnk stc +Vector FMA for LLVM intrinsic - -lnk1*lnk2-lnk3, with stc the dtype +.AT arth null lnk cse vect +.CG notCG +.IL VPERMUTE lnk lnk lnk stc +Shuffle contents of vector registers. lnk1 and lnk2 can be the same vector +or lnk2 can be null. lnk1 dtype is used as dtype for both lnk1 and lnk2, +unless lnk2 is null. stc is the result dtype, lnk3 is a vector constant +representing a mask where each field represents which L-to-R element of +concatenated vector is to be placed in corresponding result +field. lnk3 size must match the size of the result vector, but can be +different than lnk1 and lnk2's size. +.AT other null lnk vect +.CG notCG +.IL VBLEND lnk lnk lnk stc +Vector blend/select of lnk2 & lnk3. lnk1 is the mask, stc is the dtype +.AT other null lnk cse vect +.CG notCG +.IL VCMP stc lnk lnk stc +Vector compare of lnk1 & lnk2. stc1 is the condition code, stc2 is the dtype +.AT arth null lnk cse vect +.CG notCG + +.IL BCONCUR sym lnk +Start auto parallel region of an outlined function sym. +.AT other null trm +.CG notCG + +.IL ECONCUR sym +End auto parallel region of an outliend function sym. +.AT other null trm +.CG notCG + +.IL HFADD hplnk hplnk +Half-precision floating-point addition. +.AT arth comm hp cse +.CG notCG + +.IL HFNEG hplnk +Half-precision negation. +.AT arth null hp cse +.CG notCG + +.IL HFSUB hplnk hplnk +Half-precision floating-point subtraction. +.AT arth null hp cse +.CG notCG + +.IL HFMUL hplnk hplnk +Half-precision floating-point multiply. +.AT arth comm hp cse +.CG notCG + +.IL HFDIV hplnk hplnk +Half-precision divide. +.AT arth null hp cse +.CG notCG + +.IL HFCMP hplnk hplnk stc +Half float compare with result of true or false. +.AT arth null ir cse +.CG notCG + +.IL HFCMPZ hplnk stc +Half float compare with zero; result is TRUE or FALSE. +.AT arth null ir cse +.CG notCG + +.IL DFRHP lnk hp +Define half precision function result. +.AT define null hp cse +.CG terminal asm_nop + +.IL HFCON sym +Half-precision floating-point constant. +.AT cons null hp cse +.CG notCG + +.IL LDHP arlnk nme stc +Load half-precision floating value. 'stc' is not used. +.AT load null hp +.CG notCG + +.IL HP2SP hplnk +Half precison to single precision conversion. +.AT arth null sp +.CG notCG + +.IL SP2HP splnk +Single precison to half precision conversion. +.AT arth null hp +.CG notCG + +.IL DP2HP dplnk +Double precison to half precision conversion. +.AT arth null hp +.CG notCG + +.IL STHP hplnk arlnk nme stc +Store half precision quantity. 'stc' must be MSZ_F2. +.AT store null trm +.CG notCG + +.IL ARGHP hplnk lnk +Defines a half-precision memory argument. +\'hplnk' points to the register value of the argument. +\'lnk' points to the next ARG ILI. +.AT define null lnk +.CG notCG + +.IL CSEHP hplnk +Half precision register cse. +.AT arth null hp +.CG notCG + +.IL HFCJMP hplnk hplnk stc sym +Half precision compare and jump to the label 'sym' +if the condition, denoted by stc, is true. +.AT branch null trm dom +.CG terminal conditional_branch notAILI + +.IL HFCJMPZ hplnk stc sym +Half precision compare with zero and branch to label 'sym'. +.AT branch null trm dom +.CG notCG conditional_branch + +.IL MVHP hplnk ir +Move half FP value into specific integer register, ir. +.AT move null trm +.CG terminal notAILI 'l' + +.IL HFMAX hplnk hplnk +Half-precision max +.AT arth comm hp cse +.CG notCG + +.IL HFMIN hplnk hplnk +Half-precision min +.AT arth comm hp cse +.CG notCG + +.so ilitp_atomic.n diff --git a/tools/flang2/utils/ilmtp/CMakeLists.txt b/tools/flang2/utils/ilmtp/CMakeLists.txt index 77527abda7e..2b386806906 100644 --- a/tools/flang2/utils/ilmtp/CMakeLists.txt +++ b/tools/flang2/utils/ilmtp/CMakeLists.txt @@ -33,10 +33,19 @@ add_custom_command( -s ${FLANG2_DOC_BIN_DIR}/ilmtp.rst DEPENDS ilmtp ${ARCH_DEP_ILM_DIR}/ilmtp.n ${ARCH_DEP_ILM_DIR}/ilmtp_atomic.n - ${ARCH_DEP_ILM_DIR}/ilmtp_longdouble.n ${ARCH_DEP_ILI_DIR}/ilitp.n ) +if(NOT ${TARGET_ARCHITECTURE} STREQUAL "riscv64") + add_custom_command( + OUTPUT ${UTILS_ILM_BIN_DIR}/ilmtpdf.h + ${UTILS_ILM_BIN_DIR}/ilmtp.h + ${UTILS_ILM_BIN_DIR}/ilmtp.n1 + ${FLANG2_DOC_BIN_DIR}/ilmtp.rst + APPEND + DEPENDS ${ARCH_DEP_ILM_DIR}/ilmtp_longdouble.n) +endif() + add_custom_target(gen_backend_ilm SOURCES ${UTILS_ILM_BIN_DIR}/ilmtpdf.h ${UTILS_ILM_BIN_DIR}/ilmtp.h diff --git a/tools/flang2/utils/ilmtp/riscv64/ilmtp.n b/tools/flang2/utils/ilmtp/riscv64/ilmtp.n new file mode 100644 index 00000000000..728b70b1dfb --- /dev/null +++ b/tools/flang2/utils/ilmtp/riscv64/ilmtp.n @@ -0,0 +1,4017 @@ +.\"/* +.\" * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +.\" * See https://llvm.org/LICENSE.txt for license information. +.\" * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +.\" * +.\" */ +.NS 25 "ILM Definitions" "Appendix IV - " +.sh 2 "ILM Definitions" +.ft CW +.sz 6 +.nf +.nr IN 0 1 +.de IL +.nr IN +1 +.sp +.in 0 +.ne 4 +.nf +.ta 0.5i 4.5i +\\n(IN. \\$1 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9\t Type: \\$2 +.in 0.5i +.fi +.ad +.. +.de AT +.br +Attributes: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 +.br +.sp +.. +.de OP +.br +.in 0.5i +.nf +.ta 1.0i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +OP: \\$1\t\\$2\t\\$3\t\\$4\t\\$5\t\\$6\t\\$7\t\\$8 +.. +.IL BOS misc stc1 stc2 stc3 +Always (and only) appears as the first ILM of an ILM block. +(roughly corresponds to the beginning of a source statement.) +.nf + +stc1 - source statement line number (negated for insert files?). +If more than one ILM block is written for a given +statement, all but the first have 0 specified for the +line number. +For typical statements, this is actually the line +number of the terminating ';'. +stc2 - current source file index. Default value is 1. +stc3 - number of words for this ILM block (including the BOS). +.AT spec trm +.IL RISNAN arth lnk +.AT spec trm +.IL DISNAN arth lnk +.AT spec trm +.IL FLOAT arth lnk +Convert integer to real number (REAL and FLOAT intrinsics). +.OP FLOAT r p1 +.IL DFLOAT arth lnk +Convert integer to double precision (DFLOAT intrinsic). +.OP DFLOAT r p1 +.CL CTOI arth lnk +Convert unsigned character to signed integer. +.OP MVIR r p1 iv-1 +.FL CTOI arth lnk lnk +.AT spec +.IL SCTOI arth lnk +Convert unsigned character to signed integer. +.OP MVIR r p1 iv-1 +.IL STOI arth lnk +Convert short to signed integer. +.OP MVIR r p1 iv-1 +.IL USTOI arth lnk +Convert unsigned short to signed integer. +.OP MVIR r p1 iv-1 +.IL CTOUI arth lnk +Convert unsigned character to unsigned integer. +.OP MVIR r p1 iv-1 +.IL SCTOUI arth lnk +Convert signed character to unsigned integer. +.OP MVIR r p1 iv-1 +.IL ITOUI arth lnk +Convert signed integer to unsigned integer. +.OP MVIR r p1 iv-1 +.IL UITOI arth lnk +Convert unsigned integer to signed integer. +.OP MVIR r p1 iv-1 +.IL STOUI arth lnk +Convert short to unsigned integer. +.OP MVIR r p1 iv-1 +.IL USTOUI arth lnk +Convert unsigned short to unsigned integer. +.OP MVIR r p1 iv-1 +.IL CDTOUDI arth lnk +.OP MVDP r rp1 iv-1 +.IL CTOUDI arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 rp1 t1 +.OP QJSR t2 =e'%d%ftn_i_sp2dp t1 +.\".OP DFRDPX87 r t2 +.IL DTOUDI arth lnk +.OP MVDP r p1 iv-1 +.IL DTOUI arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_dp2ir t1 +.OP DFRIR r t2 drret +.IL UDCON arth sym +.OP DCON r v1 +.IL UDITOD arth lnk +.OP MVDP r p1 iv-1 +.IL UDITOR arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 rp1 t1 +.OP QJSR t2 =e'%s%ftn_i_dp2sp t1 +.\".OP DFRSPX87 r t2 +.IL UDITOS arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_dp2ir t1 +.OP DFRIR r t2 drret +.IL UDITOSC arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_dp2ir t1 +.OP DFRIR r t2 drret +.IL UDITOUI arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_dp2ir t1 +.OP DFRIR r t2 drret +.IL UITOD arth lnk +.OP NULL t1 iv0 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_ir2dp t1 +.\".OP DFRDPX87 r t2 +.IL UITOR arth lnk +.OP IR2SP r p1 +.IL UITOS arth lnk +.OP MVIR r p1 iv-1 +.IL UITOSC arth lnk +.OP MVIR r p1 iv-1 +.IL UITOUDI arth lnk +.OP NULL t1 iv0 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_ir2dp t1 +.\".OP DFRDPX87 r t2 +.IL ITOUDI arth lnk +Cast a 32-bit integer to a 64-bit unsigned integer (dword). +.OP NULL t1 iv0 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_ir2dp t1 +.\".OP DFRDPX87 r t2 +.IL SCTOUDI arth lnk +Cast a 8 bit integer quantity to a 64-bit unsigned integer (dword). +.OP NULL t1 iv0 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_ir2dp t1 +.\".OP DFRDPX87 r t2 +.IL STOUDI arth lnk +Cast a 16 bit integer quantity to a 64-bit quantity. +.OP NULL t1 iv0 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_ir2dp t1 +.\".OP DFRDPX87 r t2 +.IL UDITOI arth lnk +Cast an unsigned double integer (dword) to a 32-bit signed integer. +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_dp2ir t1 +.OP DFRIR r t2 drret +.IL RTOUI arth lnk +Cast a real to a 32-bit unsigned integer (word). +.OP SP2IR r p1 +.IL RTOUDI arth lnk +Cast a real to a 64-bit unsigned integer (dword). +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_sp2dp t1 +.\".OP DFRDPX87 r t2 +.IL CRTOI arth lnk lnk +Cast a complex to integer (C) +.AT spec +.IL CDTOI arth lnk lnk +.AT spec dcmplx +.IL UITOC arth lnk +Convert unsigned integer to unsigned character. +.OP ICON t1 =i'255 +.OP AND r t1 p1 +.IL ITOSC arth lnk +Convert signed integer to signed character. +.AT spec +.IL ITOS arth lnk +Convert integer to short. +.AT spec +.IL UITOUS arth lnk +Convert unsigned integer to unsigned short. +.OP ICON t1 =i'65535 +.OP AND r t1 p1 +.IL FLOATU arth lnk +Convert unsigned integer to real. +.OP FLOATU r p1 +.IL DFLOATU arth lnk +Convert unsigned to double. +.OP DFLOATU r p1 +.IL RTOR arth lnk lnk +.OP FPOWF r p1 p2 +.IL VRTOR arth lnk lnk +.IL DTOD arth lnk lnk +.OP DPOWD r p1 p2 +.IL CTOC arth lnk lnk +.AT spec +.IL CDTOCD arth lnk lnk +.AT spec dcmplx +.IL FIX arth lnk +Convert real number to integer (INT and IFIX intrinsics). +.OP FIX r p1 +.IL FIXU arth lnk +Convert real number to unsigned. +.OP UFIX r p1 +.IL DBLE arth lnk +Convert single precision floating point value to double precision. +.OP DBLE r p1 +.IL DFIX arth lnk +Convert double precision floating point number to integer. +.OP DFIX r p1 +.IL DFIXU arth lnk +Convert double precision floating point number to +unsigned integer. +.OP DFIXU r p1 +.IL REAL arth lnk +Returns real part of complex number (single precision). +.AT spec +.OP MVSP r rp1 iv-1 +.IL DREAL arth lnk +Returns double precision real part of a double complex value. +.AT spec +.OP MVDP r rp1 iv-1 +.IL IMAG arth lnk +Returns imaginary part of complex value (single precision) +(AIMAG intrinsic). +.AT spec +.OP MVSP r ip1 iv-1 +.IL DIMAG arth lnk +Returns double precision imaginary part of a double complex value +(DIMAG intrinsic). +.AT spec +.OP MVDP r ip1 iv-1 +.IL CMPLX arth lnk lnk +Form complex number out of two single precision real values. +.AT spec +.IL DCMPLX arth lnk lnk +Form double complex number out of two double precision real values. +.AT spec dcmplx +.IL ICHAR fstr lnk +Converts single character to integer. +.AT spec +.IL INCHAR fstr lnk +Converts single ncharacter to integer. +.AT spec +.IL CHAR fstr lnk +Converts integer to character string of length 1. +.AT spec +.IL NCHAR fstr lnk +Converts integer to ncharacter string of length 1. +.AT spec +.IL AINT arth lnk +AINT intrinsic (converts real to real). +.OP AINT r p1 +.IL DINT arth lnk +DINT intrinsic (converts double to double). +.OP DINT r p1 +.IL ANINT arth lnk +ANINT intrinsic (converts real to real). +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_anint t1 +.OP DFRSP r t2 spret +.IL DNINT arth lnk +DNINT intrinsic (converts double to double). +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dnint t1 +.OP DFRDP r t2 dpret +.IL NINT arth lnk +NINT intrinsic (converts real to integer). +.\".OP NULL t1 iv0 +.\".OP DASP t1 p1 sp(0) t1 +.\".OP QJSR t2 =e'%i%__mth_i_nint t1 +.\".OP DFRIR r t2 drret +.OP NINT r p1 +.IL IDNINT arth lnk +IDNINT intrinsic (converts double to integer). +.\".OP NULL t1 iv0 +.\".OP DADP t1 p1 dp(0) t1 +.\".OP QJSR t2 =e'%i%__mth_i_idnint t1 +.\".OP DFRIR r t2 drret +.OP IDNINT r p1 +.IL ZEXTB arth lnk +Zero extend byte (ZEXT intrinsic). +.OP ICON t1 =i'255 +.OP AND r t1 p1 +.IL ZEXTS arth lnk +Zero extend short (ZEXT intrinsic). +.OP ICON t1 =i'65535 +.OP AND r t1 p1 +.IL IABS arth lnk +.OP IABS r p1 +.IL ABS arth lnk +Absolute value of single precision real number. +.OP FABS r p1 +.IL DABS arth lnk +.OP DABS r p1 +.IL CABS arth lnk +.AT spec +.OP DBLE t1 rp1 +.OP DBLE t2 ip1 +.OP DMUL t1 t1 t1 +.OP DMUL t2 t2 t2 +.OP DADD t3 t1 t2 +.OP DSQRT t3 t3 +.OP SNGL r t3 +.IL CDABS arth lnk +.AT spec +.OP NULL t1 iv0 +.OP ARGDP t1 rp1 t1 +.OP ARGDP t2 ip1 t1 +.OP QJSR t3 =e'%d%__mth_i_cdabs t2 +.OP DFRDP r t3 dpret +.IL LEN fstr lnk +Length of a character expression. This ILM contains a link to +one character expression. +The result returned is the sum of the lengths of its operands. +.AT spec +.IL NLEN fstr lnk +Length of ncharacter expr. +.AT spec +.IL CONJG arth lnk +Conjugate of a single precision complex number. +.AT spec +.OP MVSP rr rp1 iv-1 +.OP FNEG ir ip1 +.IL DCONJG arth lnk +Conjugate of a double complex number. +.AT spec dcmplx +.OP MVDP rr rp1 iv-1 +.OP DNEG ir ip1 +.IL SQRT arth lnk +Square root of a single precision real number (SQRT intrinsic). +.OP FSQRT r p1 +.IL DSQRT arth lnk +.OP DSQRT r p1 +.IL CSQRT arth lnk +.AT spec +.IL CDSQRT arth lnk +.AT spec dcmplx +.IL EXP arth lnk +EXP intrinsic for single precision floating point values. +.OP FEXP r p1 +.IL DEXP arth lnk +.OP DEXP r p1 +.IL CEXP arth lnk +.AT spec +.IL CDEXP arth lnk +.AT spec dcmplx +.IL CACOS arth lnk +.AT spec +.IL CDACOS arth lnk +.AT spec dcmplx +.IL CASIN arth lnk +.AT spec +.IL CDASIN arth lnk +.AT spec dcmplx +.IL CATAN arth lnk +.AT spec +.IL CDATAN arth lnk +.AT spec dcmplx +.IL CCOSH arth lnk +.AT spec +.IL CDCOSH arth lnk +.AT spec dcmplx +.IL CSINH arth lnk +.AT spec +.IL CDSINH arth lnk +.AT spec dcmplx +.IL CTANH arth lnk +.AT spec +.IL CDTANH arth lnk +.AT spec dcmplx +.IL CTAN arth lnk +.AT spec +.IL CDTAN arth lnk +.AT spec dcmplx +.IL CACOSH arth lnk +.AT spec +.IL CDACOSH arth lnk +.AT spec dcmplx +.IL CASINH arth lnk +.AT spec +.IL CDASINH arth lnk +.AT spec dcmplx +.IL CATANH arth lnk +.AT spec +.IL CDATANH arth lnk +.AT spec dcmplx +.IL ALOG arth lnk +.OP FLOG r p1 +.IL DLOG arth lnk +.OP DLOG r p1 +.IL CLOG arth lnk +.AT spec +.IL CDLOG arth lnk +.AT spec dcmplx +.IL ALOG10 arth lnk +.OP FLOG10 r p1 +.IL DLOG10 arth lnk +.OP DLOG10 r p1 +.IL SIN arth lnk +Sine of a single precision value +.OP FSIN r p1 +.\".OP NULL t1 iv0 +.]".OP ARGSP t1 p1 t1 +.\".OP QJSR t2 =e'%s%__mth_i_sin t1 +.\".OP DFRSP r t2 spret +.IL DSIN arth lnk +.OP DSIN r p1 +.\".OP NULL t1 iv0 +.\".OP ARGDP t1 p1 t1 +.\".OP QJSR t2 =e'%d%__mth_i_dsin t1 +.\".OP DFRDP r t2 dpret +.IL CSIN arth lnk +.AT spec +.IL CDSIN arth lnk +.AT spec dcmplx +.IL COS arth lnk +Cosine of a single precision number +.OP FCOS r p1 +.\".OP NULL t1 iv0 +.\".OP ARGSP t1 p1 t1 +.\".OP QJSR t2 =e'%s%__mth_i_cos t1 +.\".OP DFRSP r t2 spret +.IL DCOS arth lnk +.OP DCOS r p1 +.\".OP NULL t1 iv0 +.\".OP ARGDP t1 p1 t1 +.\".OP QJSR t2 =e'%d%__mth_i_dcos t1 +.\".OP DFRDP r t2 dpret +.IL CCOS arth lnk +.AT spec +.IL CDCOS arth lnk +.AT spec dcmplx +.IL TAN arth lnk +Tangent of a single precision value +.OP FTAN r p1 +.\".OP NULL t1 iv0 +.\".OP ARGSP t1 p1 t1 +.\".OP QJSR t2 =e'%s%__mth_i_tan t1 +.\".OP DFRSP r t2 spret +.IL DTAN arth lnk +.OP DTAN r p1 +.\".OP NULL t1 iv0 +.\".OP ARGDP t1 p1 t1 +.\".OP QJSR t2 =e'%d%_mth_i_dtan t1 +.\".OP DFRDP r t2 dpret +.IL ASIN arth lnk +.OP FASIN r p1 +.IL DASIN arth lnk +.OP DASIN r p1 +.IL ACOS arth lnk +.OP FACOS r p1 +.IL DACOS arth lnk +.OP DACOS r p1 +.IL ATAN arth lnk +.OP FATAN r p1 +.IL DATAN arth lnk +.OP DATAN r p1 +.IL ATAN2 arth lnk lnk +.OP FATAN2 r p1 p2 +.IL DATAN2 arth lnk lnk +.OP DATAN2 r p1 p2 +.IL SIND arth lnk +SIN in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_sind t1 +.OP DFRSP r t2 spret +.IL DSIND arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dsind t1 +.OP DFRDP r t2 dpret +.IL COSD arth lnk +COS in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_cosd t1 +.OP DFRSP r t2 spret +.IL DCOSD arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dcosd t1 +.OP DFRDP r t2 dpret +.IL TAND arth lnk +TAN in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_tand t1 +.OP DFRSP r t2 spret +.IL DTAND arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dtand t1 +.OP DFRDP r t2 dpret +.IL ERF arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_erf t1 +.OP DFRSP r t2 spret +.IL DERF arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_derf t1 +.OP DFRDP r t2 dpret +.IL ERFC arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_erfc t1 +.OP DFRSP r t2 spret +.IL DERFC arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_derfc t1 +.OP DFRDP r t2 dpret +.IL ERFC_SCALED arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_erfc_scaled t1 +.OP DFRSP r t2 spret +.IL DERFC_SCALED arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_derfc_scaled t1 +.OP DFRDP r t2 dpret +.IL GAMMA arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_gamma t1 +.OP DFRSP r t2 spret +.IL DGAMMA arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dgamma t1 +.OP DFRDP r t2 dpret +.IL LOG_GAMMA arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_log_gamma t1 +.OP DFRSP r t2 spret +.IL DLOG_GAMMA arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dlog_gamma t1 +.OP DFRDP r t2 dpret +.IL HYPOT arth lnk lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p2 t1 +.OP ARGSP t2 p1 t1 +.OP QJSR t3 =e'%s%__mth_i_hypot t2 +.OP DFRSP r t3 spret +.IL DHYPOT arth lnk lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%__mth_i_dhypot t2 +.OP DFRDP r t3 dpret +.IL ACOSH arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_acosh t1 +.OP DFRSP r t2 spret +.IL DACOSH arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dacosh t1 +.OP DFRDP r t2 dpret +.IL ASINH arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_asinh t1 +.OP DFRSP r t2 spret +.IL DASINH arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dasinh t1 +.OP DFRDP r t2 dpret +.IL ATANH arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_atanh t1 +.OP DFRSP r t2 spret +.IL DATANH arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_datanh t1 +.OP DFRDP r t2 dpret +.IL BESSEL_J0 arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_bessel_j0 t1 +.OP DFRSP r t2 spret +.IL DBESSEL_J0 arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dbessel_j0 t1 +.OP DFRDP r t2 dpret +.IL BESSEL_J1 arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_bessel_j1 t1 +.OP DFRSP r t2 spret +.IL DBESSEL_J1 arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dbessel_j1 t1 +.OP DFRDP r t2 dpret +.IL BESSEL_JN arth lnk lnk +.OP JN r p1 p2 +.IL DBESSEL_JN arth lnk lnk +.OP DJN r p1 p2 +.IL BESSEL_Y0 arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_bessel_y0 t1 +.OP DFRSP r t2 spret +.IL DBESSEL_Y0 arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dbessel_y0 t1 +.OP DFRDP r t2 dpret +.IL BESSEL_Y1 arth lnk +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_bessel_y1 t1 +.OP DFRSP r t2 spret +.IL DBESSEL_Y1 arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dbessel_y1 t1 +.OP DFRDP r t2 dpret +.IL BESSEL_YN arth lnk lnk +.OP YN r p1 p2 +.IL DBESSEL_YN arth lnk lnk +.OP DYN r p1 p2 +.IL ASIND arth lnk +ASIN in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_asind t1 +.OP DFRSP r t2 spret +.IL DASIND arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dasind t1 +.OP DFRDP r t2 dpret +.IL ACOSD arth lnk +ACOS in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_acosd t1 +.OP DFRSP r t2 spret +.IL DACOSD arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_dacosd t1 +.OP DFRDP r t2 dpret +.IL ATAND arth lnk +ATAN in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%s%__mth_i_atand t1 +.OP DFRSP r t2 spret +.IL DATAND arth lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%__mth_i_datand t1 +.OP DFRDP r t2 dpret +.IL ATAN2D arth lnk lnk +ATAN2 in degrees. +.OP NULL t1 iv0 +.OP ARGSP t1 p2 t1 +.OP ARGSP t2 p1 t1 +.OP QJSR t3 =e'%s%__mth_i_atan2d t2 +.OP DFRSP r t3 spret +.IL DATAN2D arth lnk lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%__mth_i_datan2d t2 +.OP DFRDP r t3 dpret +.IL SINH arth lnk +.OP FSINH r p1 +.IL DSINH arth lnk +.OP DSINH r p1 +.IL COSH arth lnk +.OP FCOSH r p1 +.IL DCOSH arth lnk +.OP DCOSH r p1 +.IL TANH arth lnk +.OP FTANH r p1 +.IL DTANH arth lnk +.OP DTANH r p1 +.IL SNGL arth lnk +Convert double precision number to single precision (SNGL intrinsic). +.OP SNGL r p1 +.IL IPTR arth lnk +Converts integral value to pointer. +The ili created is: +IAMV r p1 +.AT spec +.IL KPTR arth lnk +Converts long (64-bit) value to pointer. +The ili created is: +KAMV r p1 +.AT spec +.IL PTRI arth lnk +Converts pointer to an integral value +The ili created is: +AIMV r p1 +.AT spec +.IL PTRK arth lnk +Converts pointer to a long (64-bit) value +The ili created is: +AKMV r p1 +.AT spec +.IL INEG arth lnk +Integer negation. +.OP INEG r p1 +.IL UINEG arth lnk +.OP INEG r p1 +.IL RNEG arth lnk +.OP FNEG r p1 +.IL DNEG arth lnk +.OP DNEG r p1 +.IL CNEG arth lnk +.AT spec +.OP FNEG rr rp1 +.OP FNEG ir ip1 +.IL CDNEG arth lnk +Double complex negation. +.AT spec dcmplx +.OP DNEG rr rp1 +.OP DNEG ir ip1 +.IL NOT64 arth lnk +Bitwise negation of 64 bit value (COMPL intrinsic). +./" OP NOT64 r p1 +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_not64 t1 +.\".OP DFRDPX87 r t2 +.IL NOT arth lnk +Bitwise negation of 32 bit signed value (NOT intrinsic). +.OP NOT r p1 +.IL UNOT arth lnk +Bitwise negation of 32 bit unsigned value. +.OP UNOT r p1 +.CL LNOT arth lnk +Logical negation. The link must be to an expression of type +integer, float, or pointer. +The value is 1 if link is zero (0.0, or NULL); otherwise, the value is 0. +.OP ICMPZ r p1 eq +.FL LNOT arth lnk +Logical negation. The link must be to an expression of type +LOGICAL; depends on internal representation of logical values (VAX or +UNIX) +.AT spec +.IL DLNOT arth lnk +Logical negation, where the link is an expression of type double. +The value is 1 if link is zero; otherwise, it is 0. +.OP DCMPZ r p1 eq +.CL LNOP arth lnk +Logical no-op. Used by semant when space must be reserved +for a potential LNOT ILM. +Returns 1 if its operand is non-zero, else 0. +.OP ICMPZ r p1 ne +.FL LNOP arth lnk +Logical noop. Used by semant when space must be reserved +for a potential LNOT ILM. 'lnk' points to a logical +expression. +.OP MVIR r p1 iv-1 +.IL IMERGE arth lnk lnk lnk +Integer valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.OP ICMPZ t1 p3 ne +.OP ISELECT r t1 p2 p1 +.IL KMERGE arth lnk lnk lnk +Integer*8 valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.AT i8 +.OP ICMPZ t1 p3 ne +.OP KSELECT r t1 p2 p1 +.IL RMERGE arth lnk lnk lnk +Real valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.OP ICMPZ t1 p3 ne +.OP FSELECT r t1 p2 p1 +.IL DMERGE arth lnk lnk lnk +Real*8 valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.OP ICMPZ t1 p3 ne +.OP DSELECT r t1 p2 p1 +.IL CMERGE arth lnk lnk lnk +Real*4 complex valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.fi +.OP ICMPZ t1 p3 ne +.OP CSSELECT r t1 p2 p1 +.IL CDMERGE arth lnk lnk lnk +Real*8 complex valued f90 merge intrinsic. +.nf +p1 - tsource +p2 - fsource +p3 - mask +.fi +.OP ICMPZ t1 p3 ne +.OP CDSELECT r t1 p2 p1 +.IL IADD arth lnk lnk +.OP IADD r p1 p2 +.IL UIADD arth lnk lnk +.OP UIADD r p1 p2 +.IL RADD arth lnk lnk +.OP FADD r p1 p2 +.IL DADD arth lnk lnk +.OP DADD r p1 p2 +.IL CADD arth lnk lnk +.AT spec +.OP FADD rr rp1 rp2 +.OP FADD ir ip1 ip2 +.IL CDADD arth lnk lnk +.AT spec dcmplx +.OP DADD rr rp1 rp2 +.OP DADD ir ip1 ip2 +.IL PIADD arth lnk1 lnk2 sym +Add pointer (lnk1) to integer (lnk2) creating a new pointer value. +\'sym' locates a data type item describing the type which +the pointer (lnk1) points to. +.AT spec +.OP ICON t1 scz3 +.OP IMUL t2 t1 p2 +.OP IAMV t3 t2 +.OP AADD r p1 t3 scf3 +.IL PKADD arth lnk1 lnk2 sym +Add pointer (lnk1) to long (lnk2) creating a new pointer value. +\'sym' locates a data type item describing the type which +the pointer (lnk1) points to. +.AT spec +.OP ICON t1 scz3 +.OP IKMV t1 t1 +.OP KMUL t2 t1 p2 +.OP KAMV t3 t2 +.OP AADD r p1 t3 scf3 +.IL ISUB arth lnk lnk +.OP ISUB r p1 p2 +.IL UISUB arth lnk lnk +.OP UISUB r p1 p2 +.IL RSUB arth lnk lnk +.OP FSUB r p1 p2 +.IL DSUB arth lnk lnk +.OP DSUB r p1 p2 +.IL CSUB arth lnk lnk +.AT spec +.OP FSUB rr rp1 rp2 +.OP FSUB ir ip1 ip2 +.IL CDSUB arth lnk lnk +.AT spec dcmplx +.OP DSUB rr rp1 rp2 +.OP DSUB ir ip1 ip2 + +.IL PSUB arth lnk lnk sym +Subtract two pointers (of the same type). +\'sym' locates a data type item describing the type which +the pointer (lnk1) points to. +The result of this operation is an +integer. +.AT spec +.4P ASUB t1 p1 p2 iv0 +.4P AIMV t2 t1 +.4P ICON t1 sz3 +.4P IDIVZR r t2 t1 +.8P ASUB t1 p1 p2 iv0 +.8P AKMV t2 t1 +.8P ICON t1 sz3 +.8P IKMV t1 t1 +.8P KDIVZR r t2 t1 + +.IL PISUB arth lnk1 lnk2 sym +Substract integer (lnk2) from a pointer (lnk1) creating a new +pointer value. +\'sym' locates a data type item describing the type which +the pointer (lnk1) points to. +.AT spec +.OP ICON t1 scz3 +.OP IMUL t2 t1 p2 +.OP IAMV t3 t2 +.OP ASUB r p1 t3 scf3 +.IL PKSUB arth lnk1 lnk2 sym +Substract long (lnk2) from a pointer (lnk1) creating a new +pointer value. +\'sym' locates a data type item describing the type which +the pointer (lnk1) points to. +.AT spec +.OP ICON t1 scz3 +.OP IKMV t1 t1 +.OP KMUL t2 t1 p2 +.OP KAMV t3 t2 +.OP ASUB r p1 t3 scf3 +.IL IMUL arth lnk lnk +.OP IMUL r p1 p2 +.IL UIMUL arth lnk lnk +.OP IMUL r p1 p2 +.IL RMUL arth lnk lnk +.OP FMUL r p1 p2 +.IL DMUL arth lnk lnk +.OP DMUL r p1 p2 +.IL CMUL arth lnk lnk +.AT spec +.OP FMUL t1 rp1 rp2 +.OP FMUL t2 ip1 ip2 +.OP FMUL t3 ip1 rp2 +.OP FMUL t4 ip2 rp1 +.OP FSUB rr t1 t2 +.OP FADD ir t3 t4 +.IL CDMUL arth lnk lnk +.AT spec dcmplx +.OP DMUL t1 rp1 rp2 +.OP DMUL t2 ip1 ip2 +.OP DSUB rr t1 t2 +.OP DMUL t1 ip1 rp2 +.OP DMUL t2 ip2 rp1 +.OP DADD ir t2 t1 +.IL IDIV arth lnk lnk +.OP IDIV r p1 p2 +.IL UIDIV arth lnk lnk +.OP UIDIV r p1 p2 +.IL RDIV arth lnk lnk +.OP FDIV r p1 p2 +.IL DDIV arth lnk lnk +.OP DDIV r p1 p2 +.IL CDIV arth lnk lnk +.AT spec +.IL CDIVR arth lnk lnk +.AT spec +.OP FDIV rr rp1 p2 +.OP FDIV ir ip1 p2 +.IL CDDIV arth lnk lnk +.AT spec dcmplx +.IL CDDIVD arth lnk lnk +.AT spec dcmplx +.OP DDIV rr rp1 p2 +.OP DDIV ir ip1 p2 +.FL ITOI arth lnk lnk +Exponentiation - integer to an integer power. +.OP IPOWI r p1 p2 +.IL RTOI arth lnk lnk +.OP FPOWI r p1 p2 +.IL DTOI arth lnk lnk +.OP DPOWI r p1 p2 +.CL MOD arth lnk lnk +Integer remainder +.OP MOD r p1 p2 +.FL MOD arth lnk lnk +Integer remainder (MOD intrinsic). +.OP MOD r p1 p2 +.IL UIMOD arth lnk lnk +.OP UIMOD r p1 p2 +.IL AMOD arth lnk lnk +.OP FMOD r p1 p2 +.IL DMOD arth lnk lnk +.OP DMOD r p1 p2 +.IL ISIGN arth lnk lnk +.OP ICMPZ t1 p2 lt +.OP IABS t2 p1 +.OP INEG t3 t2 +.OP ISELECT r t1 t2 t3 +.IL SIGN arth lnk lnk +Real valued SIGN intrinsic. +.OP SIGN r p1 p2 +.IL DSIGN arth lnk lnk +.OP DSIGN r p1 p2 +.IL IDIM arth lnk lnk +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGIR t2 p1 t1 +.OP QJSR t3 =e'%i%ftn_i_idim t2 +.OP DFRIR r t3 drret +.IL DIM arth lnk lnk +Real valued DIM intrinsic. +.OP NULL t1 iv0 +.OP ARGSP t1 p2 t1 +.OP ARGSP t2 p1 t1 +.OP QJSR t3 =e'%s%ftn_i_dim t2 +.OP DFRSP r t3 spret +.IL DDIM arth lnk lnk +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%ftn_i_ddim t2 +.OP DFRDP r t3 dpret +.IL DPROD arth lnk lnk +Multiply two single precision real values and return double +precision value. (DPROD intrinsic). +.OP DBLE t1 p1 +.OP DBLE t2 p2 +.OP DMUL r t1 t2 +.IL IMAX arth lnk lnk +.OP IMAX r p1 p2 +.IL UIMAX arth lnk lnk +.OP UIMAX r p1 p2 +.IL RMAX arth lnk lnk +.OP FMAX r p1 p2 +.IL DMAX arth lnk lnk +.OP DMAX p p1 p2 +.IL IMIN arth lnk lnk +.OP IMIN r p1 p2 +.IL UIMIN arth lnk lnk +.OP UIMIN r p1 p2 +.IL RMIN arth lnk lnk +.OP FMIN r p1 p2 +.IL DMIN arth lnk lnk +.OP DMIN r p1 p2 +.IL INDEX fstr lnk lnk +INDEX intrinsic (inputs are two character strings and result is an integer). +.AT spec +.OP QJSR t1 =e'%i%ftn_index iv0 +.OP DFRIR r t1 drret +.IL NINDEX fstr lnk lnk +Same as INDEX except for ncharacter strings. +.AT spec +.OP QJSR t1 =e'%i%ftn_nindex iv0 +.OP DFRIR r t1 drret +.IL AND64 arth lnk lnk +Bitwise logical and of two 64 bit values (AND intrinsic). +./" OP AND64 r p1 p2 +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%ftn_i_and64 t2 +.\".OP DFRDPX87 r t3 +.IL AND arth lnk lnk +Bitwise logical and of two 32 bit values (AND intrinsic). +.OP AND r p1 p2 +.IL OR64 arth lnk lnk +Bitwise logical or of two 64-bit values (OR instrinsic). +./" OP OR64 r p1 p2 +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%ftn_i_or64 t2 +.\".OP DFRDPX87 r t3 +.IL OR arth lnk lnk +Bitwise logical or of two 32 bit values (OR intrinsic). +.OP OR r p1 p2 +.IL XOR64 arth lnk lnk +Bitwise exclusive or of two 64 bit values (NEQV intrinsic) +./" OP XOR64 r p1 p2 +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%ftn_i_xor64 t2 +.\".OP DFRDPX87 r t3 +.IL XOR arth lnk lnk +Bitwise exclusive or of two 32 bit values (^ operator / EOR intrinsic). +.OP XOR r p1 p2 +.IL XNOR64 arth lnk lnk +Bitwise exclusive nor of two 64 bit values (EQV intrinsic) +./" OP XNOR64 r p1 p2 +.OP NULL t1 iv0 +.OP ARGDP t1 p2 t1 +.OP ARGDP t2 p1 t1 +.OP QJSR t3 =e'%d%ftn_i_xnor64 t2 +.\".OP DFRDPX87 r t3 +.IL EQV arth lnk lnk +Bitwise complement of the exclusive or of two 32 bit values +.OP XOR t1 p1 p2 +.OP NOT r t1 +.CL LSHIFT arth lnk lnk +Left shift operator (<<) - first operand is 32 bit signed integer +value and second is a positive integer. +.OP LSHIFT r p1 p2 +.CL RSHIFT arth lnk lnk +Right shift operator (>>). First operand is 32 bit signed integer +value and second is assumed to be a positive integer. +.OP RSHIFT r p1 p2 +.IL KRSHIFT arth lnk lnk +.AT spec i8 +.IL ULSHIFT arth lnk lnk +Left shift operator (<<) - first operand is 32 bit unsigned integer +value and second is a positive integer. +.OP ULSHIFT r p1 p2 +.IL URSHIFT arth lnk lnk +Right shift operator (>>). First operand is 32 bit unsigned integer +value and second is assumed to be a positive integer. +.OP URSHIFT r p1 p2 +.IL ARSHIFT arth lnk lnk +.OP ARSHIFT r p1 p2 +.IL KARSHIFT arth lnk lnk +.OP KARSHIFT r p1 p2 +.IL BGE arth lnk lnk +.OP BGE r p1 p2 +.IL KBGE arth lnk lnk +.OP KBGE r p1 p2 +.IL BGT arth lnk lnk +.OP BGT r p1 p2 +.IL KBGT arth lnk lnk +.OP KBGT r p1 p2 +.IL BLE arth lnk lnk +.OP BLE r p1 p2 +.IL KBLE arth lnk lnk +.OP KBLE r p1 p2 +.IL BLT arth lnk lnk +.OP BLT r p1 p2 +.IL KBLT arth lnk lnk +.OP KBLT r p1 p2 +.IL IDSHIFTL intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_idshiftl t3 +.OP DFRIR r t3 drret +.IL JDSHIFTL intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jdshiftl t3 +.OP DFRIR r t3 drret +.IL KDSHIFTL intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kdshiftl t3 +.OP DFRKR r t3 drret +.IL 1DSHIFTL intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1dshiftl t3 +.OP DFRIR r t3 drret +.IL IDSHIFTR intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_idshiftr t3 +.OP DFRIR r t3 drret +.IL JDSHIFTR intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jdshiftr t3 +.OP DFRIR r t3 drret +.IL KDSHIFTR intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kdshiftr t3 +.OP DFRKR r t3 drret +.IL 1DSHIFTR intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1dshiftr t3 +.OP DFRIR r t3 drret +.IL ISHIFTA intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_ishifta t3 +.OP DFRIR r t3 drret +.IL JSHIFTA intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jshifta t3 +.OP DFRIR r t3 drret +.IL KSHIFTA intr lnk lnk +.OP NULL t1 iv0 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kshifta t3 +.OP DFRKR r t3 drret +.IL 1SHIFTA intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1shifta t3 +.OP DFRIR r t3 drret +.IL ISHIFTL intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_ishiftl t3 +.OP DFRIR r t3 drret +.IL JSHIFTL intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jshiftl t3 +.OP DFRIR r t3 drret +.IL KSHIFTL intr lnk lnk +.OP NULL t1 iv0 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kshiftl t3 +.OP DFRKR r t3 drret +.IL 1SHIFTL intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1shiftl t3 +.OP DFRIR r t3 drret +.IL ISHIFTR intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_ishiftr t3 +.OP DFRIR r t3 drret +.IL JSHIFTR intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jshiftr t3 +.OP DFRIR r t3 drret +.IL KSHIFTR intr lnk lnk +.OP NULL t1 iv0 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kshiftr t3 +.OP DFRKR r t3 drret +.IL 1SHIFTR intr lnk lnk +.OP NULL t1 iv0 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1shiftr t3 +.OP DFRIR r t3 drret +.IL IMERGE_BITS intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_imerge_bits t3 +.OP DFRIR r t3 drret +.IL JMERGE_BITS intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_jmerge_bits t3 +.OP DFRIR r t3 drret +.IL KMERGE_BITS intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAKR t1 p3 dr(2) t1 +.OP DAKR t2 p2 dr(1) t1 +.OP DAKR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%l%ftn_i_kmerge_bits t3 +.OP DFRKR r t3 krret +.IL 1MERGE_BITS intr lnk lnk lnk +.OP NULL t1 iv0 +.OP DAIR t1 p3 dr(2) t1 +.OP DAIR t2 p2 dr(1) t1 +.OP DAIR t3 p1 dr(0) t2 +.OP QJSR t3 =e'%i%ftn_i_1merge_bits t3 +.OP DFRIR r t3 drret +.IL SHIFT64 arth lnk lnk +SHIFT intrinsic - first operand is 64 bit value and second is a positive +or negative integer shift count. +./" OP SHIFT64 r p1 p2 +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%d%ftn_i_shift64 t1 +.\".OP DFRDPX87 r t2 +.FL SHIFT arth lnk lnk +SHIFT intrinsic - first operand is 32 bit value and second is positive or +negative integer shift count (not constants). +When the second operand is a constant, ULSHIFT or URSHIFT is used. +.\".OP SHIFT r p1 p2 +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_shift t1 +.OP DFRIR r t2 drret +.IL I1SHFT intr lnk lnk +ISHFT intrinsic - first operand is 8 bit value and second is positive or +negative integer shift count. If the shift count <= -8 or >=8, the +result is 0. +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_i1shft t1 +.OP DFRIR r t2 drret +.IL IISHFT intr lnk lnk +ISHFT intrinsic - first operand is 16 bit value and second is positive or +negative integer shift count. If the shift count <= -16 or >=16, the +result is 0. +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGIR t1 p1 t1 +.OP QJSR t2 =e'%i%ftn_i_iishft t1 +.OP DFRIR r t2 drret +.IL JISHFT intr lnk lnk +ISHFT intrinsic - first operand is 32 bit value and second is positive or +negative integer shift count. If the shift count <= -32 or >=32, the +result is 0. Expand will convert JISHFT ili to a ULSHIFT, URSHIFT, or +a call. +.OP JISHFT r p1 p2 +.IL LAND arth lnk lnk +Logical .AND. operation. +.OP AND r p1 p2 +.IL VSLAND arth lnk lnk +Vector 16-bit logical and +.CL LOR arth lnk lnk +Logical or. +This opcode is for use within the Semantic Analyzer only, and should +never appear in the ILM's sent to the Expander. +.FL LOR arth lnk lnk +Logical .OR. operation. +.OP OR r p1 p2 +.IL LEQV arth lnk lnk +Logical .EQV. operation. +.\".OP XOR t1 p1 p2 +.\".OP NOT r t1 +.AT spec +.OP ICMP r p1 p2 eq +.IL LNEQV arth lnk lnk +Logical .NEQV. operation. +.OP XOR r p1 p2 +.IL I1SHFTC arth lnk lnk lnk +ISHFTC(p1, p2, p3) - circularly shift the rightmost p3 bits of p1 +by p2, where p1 is a 8-bit interger +.OP NULL t1 iv0 +.OP ARGIR t1 p3 t1 +.OP ARGIR t2 p2 t1 +.OP ARGIR t3 p1 t2 +.OP JSR t1 =e'%i%ftn_i_i1shftc t3 +.OP DFRIR r t1 dr(0) +.IL IISHFTC arth lnk lnk lnk +ISHFTC(p1, p2, p3) - circularly shift the rightmost p3 bits of p1 +by p2, where p1 is a 16-bit interger +.OP NULL t1 iv0 +.OP ARGIR t1 p3 t1 +.OP ARGIR t2 p2 t1 +.OP ARGIR t3 p1 t2 +.OP JSR t1 =e'%i%ftn_i_iishftc t3 +.OP DFRIR r t1 dr(0) +.IL ISHFTC arth lnk lnk lnk +ISHFTC(p1, p2, p3) - circularly shift the rightmost p3 bits of p1 +by p2. +.OP NULL t1 iv0 +.OP ARGIR t1 p3 t1 +.OP ARGIR t2 p2 t1 +.OP ARGIR t3 p1 t2 +.OP QJSR t1 =e'%i%ftn_ishftc t3 +.OP DFRIR r t1 drret +.IL IBITS arth lnk lnk lnk +IBITS(p1, p2, p3) - extract p3 bits beginning at p2 from p1. +.nf +r = p3 != 0 ? (p1 >> p2) & (-1 >> (32 - p3)) : 0 +.OP RSHIFT t1 p1 p2 +.OP ICON t2 =i'-1 +.OP ICON t3 =i'32 +.OP ISUB t4 t3 p3 +.OP URSHIFT t5 t2 t4 +.OP AND t6 t1 t5 +.OP ICMPZ t7 p3 eq +.OP ISELECT r t7 t6 p3 +.IL IBSET arth lnk lnk +IBSET(p1, p2) - set bit p2 of p1 to 1. +.nf +r = p1 | (1 << p2) +.OP ICON t1 =i'1 +.OP LSHIFT t2 t1 p2 +.OP OR r p1 t2 +.IL BTEST arth lnk lnk +BTEST(p1, p2) - .TRUE. if bit p2 of p1 is 1. +.nf +r = (p1 & (1 << p2)) != 0 +.OP ICON t1 =i'1 +.OP LSHIFT t2 t1 p2 +.OP AND t3 p1 t2 +.OP ICMPZ r t3 ne +.IL IBCLR arth lnk lnk +IBLCR(p1, p2) - clear bit p2 of p1. +.nf +r = p1 & ~(1 << p2) +.OP ICON t1 =i'1 +.OP LSHIFT t2 t1 p2 +.OP NOT t3 t2 +.OP AND r p1 t3 +.IL RFLOOR arth lnk +FLOOR of real to real +.OP FFLOOR r p1 +.IL DFLOOR arth lnk +FLOOR of double to double +.OP DFLOOR r p1 +.IL RCEIL arth lnk +CELING of real to real +.OP FCEIL r p1 +.IL DCEIL arth lnk +CELING of double to double +.OP DCEIL r p1 +.IL ICMP arth lnk lnk +Integer comparision of two integer numbers. +The compare ILMs are used only in the context of a relational expression +and do not by themselves generate code. +A compare ILM passes up the opcode of the compare ILI which reflects the +data type of the operands to the relational ILM. +When the relational ILM using the compare ILM is processed, +the appropriate code is generated. +.AT spec +.IL RCMP arth lnk lnk +Compare two single precision floating point numbers. +.AT spec +.IL DCMP arth lnk lnk +Compare two double precision floating point numbers. +.AT spec +.IL UICMP arth lnk lnk +Unsigned integer comparison. +.AT spec +.IL UDICMP arth lnk lnk +Unsigned double integer comparison. +.AT spec +.CL PCMP arth lnk lnk +Pointer comparison. +.AT spec +.IL CCMP arth lnk lnk +Compare two complex numbers. +The value computed is 0 if equal and -1 or 1 if not equal. +.AT spec +.IL CDCMP arth lnk lnk +Compare two double complex numbers. +The value computed is the same as for the ICMP ILM. +.AT spec +.IL SCMP fstr lnk lnk +Compare two strings. +The value computed is the same as for the ICMP ILM. SCMP has no +corresponding vector ILM. +.AT spec +.IL NSCMP fstr lnk lnk +Same as SCMP for ncharacter strings. +.AT spec +.IL EQ arth lnk +Generate true if compare is equal (lnk locates a compare ILM) +.AT spec +.IL NE arth lnk +Generate true if compare is not equal +.AT spec +.IL LT arth lnk +Generate true if compare is less than +.AT spec +.IL GE arth lnk +Generate true if compare is greater than or equal to +.AT spec +.IL LE arth lnk +Generate true if compare is less than or equal to +.AT spec +.IL GT arth lnk +Generate true if compare is greater than +.AT spec +.IL SCAT fstr lnk lnk +Character string concatenation of 2 character expressions +(none of which are themselves concatenations). +.AT spec +.OP QJSR r =e'%v%ftn_str_copy iv0 +.IL NSCAT fstr lnk lnk +Concatenate ncharacter strings. +.AT spec +.OP QJSR r =e'%v%ftn_str_copy iv0 +.IL LOC arth lnk +Returns the address represented by a BASE, ELEMENT, or +a MEMBER ILM, or substring reference. +Used for the '&' operator. +.AT spec +.IL LOCIM arth lnk stc +Returns the address of the imaginary part of a complex object +represented by a BASE, ELEMENT, or a MEMBER ILM, or substring reference. +lnk1 - the address of the object +stc - data type of the complex object +.AT spec +.IL BASE ref sym +Represents base address of a variable, array, struct, or union. +.AT spec +.CL ELEMENT ref lnk lnk stc +Address of an array element reference: +lnk1 - subscripted lvalue +lnk2 - subscript expression +stc - data type of each element +.AT spec +.FL ELEMENT ref n lnk1 stc lnk+ +Address of an array element reference: +lnk1 - subscripted lvalue +stc - data type of each element +lnk+ - subscript expressions (<= 15) +.AT spec +.IL INLELEM ref n lnk1 stc lnk+ +Address of an array element reference. Generated by function inlining. +lnk1 - subscripted lvalue +stc - data type of each element +lnk+ - subscript expressions (<= 15) +.AT spec +.IL MEMBER ref lnk sym +Address of a structure member or field reference. +lnk - base address of the structure. +sym - pointer to a struct member ST item. +.AT spec +.IL SHAPE misc n lnk+ +Shape ILM. Links point to SHD ILMs. One link for each dimension. +.AT spec +.IL SHD misc lnk lnk lnk +Shape descriptor for a dimension. +lnk1 - lower bound +lnk2 - upper bound +lnk3 - stride +.AT spec +.IL UCON arth sym +.OP ICON r v1 +.IL ICON cons sym +.OP ICON r v1 +.IL RCON cons sym +.OP FCON r v1 +.IL DCON cons sym +.OP DCON r v1 +.IL CCON cons sym +.AT spec +.OP FCON rr iv0 +.OP FCON ir iv0 +.IL CDCON cons sym +.AT spec dcmplx +.OP DCON rr iv0 +.OP DCON ir iv0 +.CL ACON cons sym +Address constant ILM. sym is a symbol table pointer to +an address constant. +The template is: +ACON r v1 +.AT spec +.FL ACON cons sym +Address constant. 'sym' must be a symbol table pointer to +an address constant for a label. +This ILM is generated when an ASSIGN statement is processed. +.AT spec +.OP ACON r v1 +.IL LCON cons sym +Logical constant. +.OP ICON r v1 +.IL BR branch sym +Branch to label indicated by 'sym'. +.AT spec trm +.OP JMP null v1 +.CL BRT branch lnk sym +Branch on logical condition true by comparing for zero/nonzero (PGC). +\'lnk' may point to a constant ILM, in which case it will always +be an ICON 0 or 1. +.AT spec trm +.OP ICJMPZ null p1 ne v2 +.CL BRF branch lnk sym +.AT spec trm +.OP ICJMPZ null p1 eq v2 +.FL BRT branch lnk sym +Branch on logical condition true by testing the low bit (PGFTN). +\'lnk' may point to a constant ILM. +.AT spec trm +.OP LCJMPZ null p1 ne v2 +.FL BRF branch lnk sym +.AT spec trm +.OP LCJMPZ null p1 eq v2 +.IL SWITCH branch lnk stc +Switch determinator, where +lnk - switch expression +stc - relative pointer to switch table, consisting +of linked list of case value/label pairs. +.AT spec trm +.IL SWTCHLL branch lnk stc +Switch determinator, where +lnk - switch expression +stc - relative pointer to switch table, consisting +of linked list of case value/label pairs. +.AT spec trm + +.IL IAIF branch lnk sym1 sym2 sym3 +Arithmetic IF branch on integer expression. +\&'sym's are symbol table pointers to labels. +.AT spec trm +.OP ICJMPZ null p1 le v2 +.OP ICJMPZ null p1 eq v3 +.OP ICJMPZ null p1 gt v4 +.IL RAIF branch lnk sym1 sym2 sym3 +Arithmetic if branch on real expression. +.AT spec trm +.OP FCJMPZ null p1 le v2 +.OP FCJMPZ null p1 eq v3 +.OP FCJMPZ null p1 gt v4 +.IL DAIF branch lnk sym1 sym2 sym3 +.AT spec trm +.OP DCJMPZ null p1 le v2 +.OP DCJMPZ null p1 eq v3 +.OP DCJMPZ null p1 gt v4 +.IL AGOTO branch n lnk sym* +Assigned GOTO. +\'lnk' is to an ILD ILM. +\'sym's are symbol table pointers +to labels specified on the assigned GOTO statement, if any. +.AT spec trm +.OP JMPA null t1 +.IL CGOTO branch lnk stc +Computed goto. +lnk - ILM of the computed goto index +stc - relative pointer to goto/switch table, consisting +of linked list of index value/label pairs. +.AT spec trm +.IL CHLD load lnk +Load signed char (byte) +.AT spec +.IL UCHLD load lnk +Load unsigned char (byte) +.AT spec +.IL ILD load lnk +Load long integer +.AT spec +.IL UILD load lnk +Load unsigned long integer +.AT spec +.IL UDILD load lnk +Load unsigned double integer +.AT spec +.IL SILD load lnk +Load short signed integer +.AT spec +.IL USILD load lnk +Load short unsigned integer +.AT spec +.IL RLD load lnk +Load real +.AT spec +.IL DLD load lnk +Load double +.AT spec +.IL QLD load lnk +Load m128 +.AT spec +.IL M256LD load lnk +Load m256 +.AT spec +.IL CLD load lnk +.AT spec +.IL CDLD load lnk +.AT spec dcmplx +.IL LLD load lnk +Load logical value. +.AT spec +.IL SLLD load lnk +Load logical value - LOGICAL*2 +.AT spec + +.IL PLD load lnk sym +Load pointer. For fortran, 'sym' field is used for PLD's +generated by inlining array arguments, and points to actual array +For C & Fortran, the 'sym' field locates the based object +for which the PLD is generated; the 'sym' field is 0 for +loads of normal C pointers. +.AT spec +.IL FLD load lnk +Load field. Always points to a MEMBER ilm. +.AT spec +.IL SFLD load lnk +Load signed field. Always points to a MEMBER ilm. +.AT spec +.IL SUBS fstr lnk1 lnk2 lnk3 +Character substring. Lnk1 must point to a BASE, MEMBER, or ELEMENT ILM. +Lnk2 and lnk3 must point to the integer expressions for the lower +and upper bounds respectively. +.AT spec +.IL NSUBS fstr lnk1 lnk2 lnk3 +Substring of ncharacter string. +.AT spec +.IL NCSELD load lnk +Non-cse load. lnk points to a load ilm. Used for +volatile types. Expands to ILI that forces scheduler to do the load rather +then optimizing it away. +.AT spec +.IL CHST store lnk1 lnk2 +Store signed char, lnk1 = lnk2 (??) +.AT spec trm +.IL UCHST store lnk1 lnk2 +Store unsigned char, lnk1 = lnk2 (??) +.AT spec trm +.IL IST store lnk lnk +Store into integer variable. +.AT spec trm +.IL UIST store lnk lnk +Store into unsigned long integer +.AT spec trm +.IL SIST store lnk lnk +Store short signed integer +.AT spec trm +.IL USIST store lnk lnk +Store short unsigned integer +.AT spec trm +.IL RST store lnk lnk +Store float +.AT spec trm +.IL DST store lnk lnk +Store double +.AT spec trm +.IL QST store lnk lnk +Store m128 +.AT spec trm +.IL M256ST store lnk lnk +Store m256 +.AT spec trm +.IL CST store lnk lnk +Store single complex +.AT spec trm +.IL CSTR store lnk lnk +Store the real part of a single complex +.AT spec trm +.IL CSTI store lnk lnk +Store the imaginary part of a single complex +.AT spec trm +.IL CDST store lnk lnk +.AT spec trm dcmplx +.IL CDSTR store lnk lnk +Store the real part of a double complex +.AT spec trm +.IL CDSTI store lnk lnk +Store the imaginary part of a double complex +.AT spec trm +.IL LST store lnk lnk +.AT spec trm +.IL SLST store lnk lnk +.AT spec trm +.IL AST store lnk lnk +Store address scalar. +This ILM is used for an ASSIGN statement. +\&'lnk' points to an ACON ILM. +.AT spec trm +.IL SST fstr lnk1 lnk2 +Store character expression into character variable, array element, +or substring. +Lnk1 and lnk2 point to character expressions. +Lnk1 is the destination - cannot be a concatenation. +.AT spec trm +.OP QJSR null =e'%v%ftn_str_copy iv0 +.IL NSST fstr lnk1 lnk2 +Store ncharacter expression. +.AT spec trm +.OP QJSR null =e'%v%ftn_str_copy iv0 +.IL PST store lnk lnk +Store pointer +.AT spec trm +.IL PSTRG1 store lnk stc +Store pointer to argument register number stc : used in g++ style thunks +to store the adjusted value bask to rdi/rsi etc before jumping through to the function. +.AT spec trm +.IL FST store lnk lnk +Store into field. +.AT spec trm +.IL SMOVE store lnk1 lnk2 sym +Store from one structure into another (of same type). +lnk1 - base address of receiving structure (to). +lnk2 - base address of stored structure (from). +sym is a data type pointer which describes the structures. +The expansion of this ILM can generate ILI for a sequence of +loads and stores or a call (JSR) to one of: +"c_bcopy" copy bytes +"c_hcopy" copy half-words +"c_wcopy" copy words +"c_dcopy" copy double words +.AT spec trm +.IL SZERO store lnk1 lnk2 sym +Zero memory locations. +lnk1 - base address to zero +lnk2 - number of units to zero +sym - data type of units to zero: +char, short, int, dble +The expansion of this ILM can generate ILI for a sequence of +stores or a JSR to one of +"c_bzero" zero bytes +"c_hzero" zero halfwords +"c_wzero" zero words +"c_dzero" zero double words +.AT spec trm +.IL PSEUDOST store stc lnk +Pseudo store. +This ILM is used to mark an expression whose value may be required +later in the ILM block (e.g., for i++, the orginal value of i may be +needed as the result of this expression. The expander will expand +this ILM to one of the ILIs (FREEIR, FREEAR, or FREEIR) depending on +the type of the register defined by the ILI which lnk locates. +stc is just a dummy field (0) so that the ILM requires a total of +3 words. +.AT spec trm +.IL SPSEUDOST fstr stc lnk +Character pseudo store. lnk points to a character expression. +stc is the length of the destination. +This ILM is used to mark a character expression whose value is +restricted by length; this occurs when a character expression +is used as an argument to a statement function and when the result +of a character statement function is referenced. +.AT spec trm +.IL NSPSEUDOST fstr stc lnk +Same as SPSEUDOST but for ncharacter type. +.AT spec trm +.IL NCSEST store lnk +Non-cse store. lnk points to a store ilm. Used for +volatile types. Expands to ILI that forces scheduler to do the store rather +then optimizing it away. +.AT spec trm +.IL FAPPLY proc n stc lnk lnk* +Call function, where stc is the dtype for the function signature. +'n' is the number of actual arguments. +'lnk1' is the lvalue of the procedure +The other links point to the arguments in the same order they appeared +in the actual argument list. +If the type of the argument is struct, +the lnk will point to +an ILM for the address of the struct. +For other types of arguments the lnk will just point to +the ILM's for the expression. +.AT spec +.IL VAPPLY proc n stc lnk lnk* +Like FAPPLY, but has trm attribute. +The result is discarded if there is one, i.e. if the function signature +has a return type other than DT_VOID. +.AT spec trm +.IL FINVOKE proc n sym stc lnk lnk* +Like FAPPLY, but has label argument indicating where control-flow +jumps if the function throws an exception. +.AT spec +.IL VINVOKE proc n sym stc lnk lnk* +Like VAPPLY, but has label argument similar to FINVOKE. +.AT spec trm +.IL VFUNC proc n lnk lnk* +Call void function, where +'n' is the number of actual arguments. +'lnk1' is the lvalue of the procedure +The links point to the arguments in the same order they appeared +in the actual argument list. +If the type of the argument is struct or double, a temporary +will be allocated for the value and ILM's issued to store +the value into the temp. The lnk will then point to +a LOC ilm which points to a BASE ILM. +For other types of arguments the lnk will just point to +the ILM's for the expression. +.AT spec trm +.CL IFUNC proc n lnk lnk* +Call integer function. +.AT spec +.FL IFUNC proc n sym lnk* +Call integer function. +.AT spec +.IL IFUNCA proc n stc lnk lnk* +Call integer function. +.AT spec +.IL PIFUNCA proc n stc sym lnk lnk* +Call integer function through procedure pointer +.AT spec +.IL IVFUNCA proc n stc sym lnk sym lnk* +Call integer function. +.AT spec +.IL UIFUNC proc n lnk lnk* +Call unsigned function +.AT spec +.CL RFUNC proc n lnk lnk* +Call float function. This ILM is only +when the compiler is asked to not convert ALL instances +of float to double. +.AT spec +.FL RFUNC proc n sym lnk* +Call real function. +.AT spec +.IL RFUNCA proc n stc lnk lnk* +Call real function. +.AT spec +.IL PRFUNCA proc n stc sym lnk lnk* +Call real function through procedure pointer +.AT spec +.IL RVFUNCA proc n stc sym lnk sym lnk* +Call real function. +.AT spec +.CL DFUNC proc n lnk lnk* +Call double function +.AT spec +.FL DFUNC proc n sym lnk* +Call double function +.AT spec +.IL DFUNCA proc n stc lnk lnk* +Call double function +.AT spec +.IL PDFUNCA proc n stc sym lnk lnk* +Call double function through procedure pointer +.AT spec +.IL DVFUNCA proc n stc sym lnk sym lnk* +Call double function +.AT spec +.CL QFUNC proc n lnk lnk* +Call m128 function +.AT spec +.FL QFUNC proc n sym lnk* +Call m128 function +.AT spec +.IL QFUNCA proc n stc lnk lnk* +Call m128 function +.AT spec +.IL QVFUNCA proc n stc sym lnk sym lnk* +Call m128 function +.AT spec +.CL M256FUNC proc n lnk lnk* +Call m256 function +.AT spec +.FL M256FUNC proc n sym lnk* +Call m256 function +.AT spec +.IL M256FUNCA proc n stc lnk lnk* +Call m256 function +.AT spec +.IL M256VFUNC proc n sym lnk sym lnk* +Call m256 function +.AT spec +.IL M256VFUNCA proc n stc sym lnk sym lnk* +Call m256 function +.AT spec +.IL CALL proc n sym lnk* +Call external subprogram. +\'n' is the number of actual arguments. +\'sym' is symbol table pointer to the external subprogram. +The links point to the arguments in the same order they appeared +in the CALL statement. +.AT spec trm +.IL CALLA proc n stc lnk lnk* +Call external subprogram. +\'n' is the number of actual arguments. +\'lnk1' is address of the subprogram +The links point to the arguments in the same order they appeared +in the CALL statement. +.AT spec trm +.IL PCALLA proc n stc sym lnk lnk* +Call subprogram through procedure pointer +\'n' is the number of actual arguments. +\'sym' is the pointer's descriptor +\'lnk1' is address of the subprogram +The links point to the arguments in the same order they appeared +in the CALL statement. +.AT spec trm +.IL VCALLA proc n stc sym lnk sym lnk* +Call external subprogram. +\'n' is the number of actual arguments. +\'sym1' is symbol table pointer to the external subprogram. +'lnk' ilm of invoking object +\'sym2' address of invoking object desc +The links point to the arguments in the same order they appeared +in the CALL statement. +.AT spec trm +.CL CFUNC proc n lnk lnk* +.AT spec +.CL CDFUNC proc n lnk lnk* +.AT spec dcmplx +.FL CFUNC proc n sym lnk* +.AT spec +.IL CFUNCA proc n stc lnk lnk* +.AT spec +.IL PCFUNCA proc n stc sym lnk lnk* +Call complex function through procedure pointer. +.AT spec +.IL CVFUNCA proc n stc sym lnk sym lnk* +.AT spec +.FL CDFUNC proc n sym lnk* +.AT spec dcmplx +.IL CDFUNCA proc n stc lnk lnk* +.AT spec dcmplx +.IL PCDFUNCA proc n stc sym lnk lnk* +Call double complex function through procedure pointer. +.AT spec dcmplx +.IL CDVFUNCA proc n stc sym lnk sym lnk* +.AT spec dcmplx +.IL LFUNC proc n sym lnk* +.AT spec +.IL LFUNCA proc n stc lnk lnk* +.AT spec +.IL PLFUNCA proc n stc sym lnk lnk* +Call logical function through procedure pointer. +.AT spec +.IL LVFUNCA proc n stc sym lnk sym lnk* +.AT spec +.FL PFUNC proc n sym lnk* +Call function which returns a pointer. +.AT spec +.IL PFUNCA proc n stc lnk lnk* +Call function which returns a pointer. +.AT spec +.IL PPFUNCA proc n stc sym lnk lnk* +Call function which returns a pointer through a procedure pointer. +.AT spec +.IL PVFUNCA proc n stc sym lnk sym lnk* +Call function which returns a pointer. +.AT spec +.CL PFUNC proc n lnk lnk* +Call function which returns a pointer. +.AT spec +.CL SFUNC proc n lnk lnk* +Call function which returns a structure/union. +The second link is the address (a LOC ilm) of the +temporary which is used to return the result of the function. +.AT spec +.FL SFUNC proc n sym lnk* +Call function that has the bind(C) attribute and returns a structure/union. +The first link is the address (a LOC ilm) of the +temporary which is used to return the result of the function. +.AT spec +.IL CHFUNC proc n sym lnk lnk* +Call function which returns Fortran character. +The first link is the address (a BASE ilm) of the +temporary which is used to return the result of the function. +.AT spec trm +.IL CHFUNCA proc n stc lnk lnk lnk* +Call function which returns Fortran character. +The first link is the address (a BASE ilm) of the +temporary which is used to return the result of the function. +.AT spec trm +.IL PCHFUNCA proc n stc sym lnk lnk lnk* +Call function which returns Fortran character through a procedure pointer. +The first link is the address (a BASE ilm) of the +temporary which is used to return the result of the function. +.AT spec trm +.IL CHVFUNCA proc n stc sym lnk sym lnk lnk* +Call function which returns Fortran character. +The first link is the address (a BASE ilm) of the +temporary which is used to return the result of the function. +.AT spec trm +.IL NCHFUNC proc n sym lnk lnk* +Call function which returns ncharacter. +.AT spec trm +.IL NCHFUNCA proc n stc lnk lnk lnk* +Call function which returns ncharacter. +.AT spec trm +.IL PNCHFUNCA proc n stc lnk lnk lnk* +Call function which returns ncharacter through a procedure pointer. +.AT spec trm +.IL NCHVFUNCA proc n stc sym lnk sym lnk lnk* +Call function which returns ncharacter. +.AT spec trm +.IL ARG misc lnk lnk stc stc +Special purpose ilm for arguments which require special processing. +For example, an argument which is a structure or union would +use this ilm (the function ilm locates the ARG ilm). +.nf +lnk1 - BASE ilm of temporary (if needed) +lnk2 - ilm of argument +stc - dtype of dummy argument +stc - dtype of actual argument +.AT spec +.IL FARG misc lnk stc +Special purpose ilm for argument passing, to keep the +data type of the actual argument around +.nf +lnk - ilm of argument +stc - dtype of actual argument +.AT spec +.IL PARG misc lnk lnk +Special purpose ilm for passing arguments with the F90 pointer attribute. +.nf +lnk1 - ilm representing the address of the argument's pointer +lnk2 - BASE ilm of the object with the pointer attribute. +.AT spec +.IL FARGF misc lnk stc stc +Same as FARG with the addition of a flag denoting certain context. +.nf +lnk - ilm of argument +stc1 - dtype of actual argument +stc2 - a bit vector: +0x0 - no special case (therefore, same as FARG) +0x1 - corresponding formal is CLASS(#) +.AT spec +.IL FATTR misc lnk stc stc +ILM which passes up the address of the called procedure and specifies +certain attributes, such as stdcall, about the call. +.nf +lnk1 - address of the procedure +stc1 - attributes (bit vector): +0x0001 - stdcall +stc2 - dtype record (TY_PFUNC/TY_FUNC) of the procedure +.AT spec +.IL ENTRY misc sym +This ILM is put out as the entry point for each +entry point defined in this file is processed (except for the +main entry in Fortran). +\'sym' is a symbol table +pointer to the function name. +.AT spec trm +.IL LABEL misc sym +Marks the position of a user defined or compiler created +label within the current ILM block. 'sym' is a symbol table +pointer to a label. +.AT spec trm noinlc +.IL ESTMT misc lnk +Expression statement -- generated when the value of an +expression (other than an assignment or VFUNC) is not +referenced (i.e., the value may be discarded). +However, the functions appearing in the expression must +still be evaluated (because of side effects). +.AT spec trm +.IL RET misc +Written for a RETURN statement which does not return a value. +.AT spec trm +.IL RETV misc lnk +Return value from function. +.AT spec trm +.IL ARET misc lnk +Alternate return. 'lnk' points to expression defining the +alternate return number. +.AT spec trm +.IL RETAUTO misc sym +Return from function after freeing automatic objects. +\'sym' is the symbol of the block containing the return. +.AT spec trm +.IL RETVAUTO misc lnk sym +Return value from function after freeing automatic objects. +\'sym' is the symbol of the block containing the return. +.AT spec trm +.IL NOP misc +.AT spec trm +.IL ASM misc sym +asm ( ); 'sym' is the symbol table pointer of the +ST_STRING representing . +.AT spec trm +.IL GASM misc sym lnk lnk lnk +asm ( : : : ); +\'sym' is the symbol table pointer of the +ST_STRING representing . +'lnk1' is GASMLNK of list of outputs +'lnk2' is GASMLNK of list of inputs +'lnk3' is GASMLNK of list of clobber descriptors +.AT spec trm +.IL GASMLNK misc sym1 lnk lnk sym2 stc3 +\'sym1' is the symbol table pointer of the ST_STRING representing the +descriptor ('=r' for outputs, 'r' for inputs, 'r2' for clobbers) +'lnk1' is the link to the output or input expression +'lnk2' is the link to the next GASMLNK +\'sym2' is the symbol table pointer of the identifier representing the constraint +name for an input or output item. It is 0 if no constraint name applies to this +item. +'stc3' dtype for expression +.AT spec trm +.CL END misc +End of function -- written when the final '}' is processed. +.AT spec trm +.FL END misc +End of subroutine or main program - last ILM in ilm file seen by Expander. +.AT spec trm +.IL ENDF misc lnk +End of function subprogram - lnk points to load of the +compiler created variable for the function return value. +.AT spec trm +.IL DOBEG misc lnk sym1 sym2 +DO-loop begin. May be used, as an optimization, for certain +for loops. +ILM's to store the initial DO value into the DO index +variable must precede the DOBEG ILM, +and a LABEL ILM for the loop-top label must follow it. +.nf + +lnk - link to expression computing the loop count: + +INT((e2 - e1 + e3) / e3) + +sym1 - symbol table pointer to zero trip label. +sym2 - symbol table pointer to DO count temporary. +.AT spec trm +.IL DOBEGNZ misc lnk sym1 sym2 lnk +DO-loop begin. Used as an optimization, for certain +for array assignment compiler generated forall loops. +ILM's to store the initial DO value into the DO index +variable must precede the DOBEGNZ ILM, +and a LABEL ILM for the loop-top label must follow it. +.nf + +lnk - link to expression computing the loop count: + +INT((e2 - e1 + e3) / e3) + +sym1 - symbol table pointer to zero trip label. +sym2 - symbol table pointer to DO count temporary. +lnk - link to expression to check if array is zero-size + +.AT spec trm +.IL DOENDNZ misc sym1 sym2 +DO-loop end. +Always matches a DOBEGNZ ILM. +.nf + +sym1 - symbol table pointer to loop top label. +sym2 - symbol table pointer to DO count variable. +This item generates the following for the loop end condtion: +v2 <-- v2 - 1 +if ( v2 > 0 ) goto v1 + +.AT spec trm +.IL DOEND misc sym1 sym2 +DO-loop end. +Always matches a DOBEG ILM. +.nf + +sym1 - symbol table pointer to loop top label. +sym2 - symbol table pointer to DO count variable. +This item generates the following for the loop end condtion: +v2 <-- v2 - 1 +if ( v2 > 0 ) goto v1 +.AT spec trm +.IL BYVAL misc lnk stc +General ILM to support passing arguments by value. +.nf +lnk - link to argument being passed by value +stc - its data type +.AT spec +.IL DPVAL misc lnk +This ILM is generated when the %VAL operator is used. +\&'lnk' is a pointer to a 32-bit valued expression. +.AT spec +.IL DPREF misc lnk +This ILM is generated when the %REF operator is used. +.AT spec +.IL DPSCON misc stc +Define parameter which is a short integer constant passed +by value. This ILM is included for the convenience of semant +when generating code for io statements. +.AT spec +.IL DPNULL misc +Define a parameter which is a 'null pointer', i.e. the value 0 is +to be passed, and an additional argument for the character length +(which equals 0) is to be added to the end of the argument list. +.AT spec +.IL CMSIZE misc sym +Get the size of the common block (sym1). +.AT spec +.IL MAD24 arth lnk lnk lnk +.AT spec +.OP IMUL t1 p1 p2 +.OP IADD r t1 p3 +.IL UMAD24 arth lnk lnk lnk +.AT spec +.OP IMUL t1 p1 p2 +.OP UIADD r t1 p3 +.IL MUL24 arth lnk lnk +.AT spec +.OP IMUL r p1 p2 +.IL UMUL24 arth lnk lnk +.AT spec +.OP IMUL r p1 p2 +.IL HADD arth lnk lnk +hadd(x,y), where x and y are char or short, and +computed as (x+y) >> 1 +.OP ICON t1 =i'1 +.OP IADD t2 p1 p2 +.OP RSHIFT r t2 t1 +.IL UHADD arth lnk lnk +hadd(x,y), where x and y are unsigned char or unsigned short, and +computed as (x+y) >> 1 +.OP ICON t1 =i'1 +.OP UIADD t2 p1 p2 +.OP URSHIFT r t2 t1 +.IL IHADD arth lnk lnk +hadd(x,y), where x and y are int, and +computed as (x>>1) + (y>>1) + (x&y)&1 +.OP ICON t1 =i'1 +.OP ARSHIFT t2 p1 t1 +.OP ARSHIFT t3 p2 t1 +.OP AND t4 p1 p2 +.OP AND t4 t4 t1 +.OP IADD t5 t2 t3 +.OP IADD r t5 t4 +.IL UIHADD arth lnk lnk +hadd(x,y), where x and y are unsigned, and +computed as (x>>1) + (y>>1) + (x&y)&1 +.OP ICON t1 =i'1 +.OP URSHIFT t2 p1 t1 +.OP URSHIFT t3 p2 t1 +.OP AND t4 p1 p2 +.OP AND t4 t4 t1 +.OP UIADD t5 t2 t3 +.OP UIADD r t5 t4 +.IL KHADD arth lnk lnk +hadd(x,y), where x and y are long, and +computed as (x>>1) + (y>>1) + (x&y)&1 +.OP ICON t1 =i'1 +.OP KARSHIFT t2 p1 t1 +.OP KARSHIFT t3 p2 t1 +.OP IKMV t1 t1 +.OP KAND t4 p1 p2 +.OP KAND t4 t4 t1 +.OP KADD t5 t2 t3 +.OP KADD r t5 t4 +.IL UKHADD arth lnk lnk +hadd(x,y), where x and y are unsigned long, and +computed as (x>>1) + (y>>1) + (x&y)&1 +.OP ICON t1 =i'1 +.OP KURSHIFT t2 p1 t1 +.OP KURSHIFT t3 p2 t1 +.OP IKMV t1 t1 +.OP KAND t4 p1 p2 +.OP KAND t4 t4 t1 +.OP UKADD t5 t2 t3 +.OP UKADD r t5 t4 +.IL RHADD arth lnk lnk +rhadd(x,y), where x and y are char or short, and +computed as (x+y+1) >> 1 +.OP ICON t1 =i'1 +.OP IADD t2 p1 p2 +.OP IADD t2 t2 t1 +.OP RSHIFT r t2 t1 +.IL URHADD arth lnk lnk +rhadd(x,y), where x and y are unsigned char or unsigned short, and +computed as (x+y+1) >> 1 +.OP ICON t1 =i'1 +.OP UIADD t2 p1 p2 +.OP UIADD t2 t2 t1 +.OP URSHIFT r t2 t1 +.IL IRHADD arth lnk lnk +rhadd(x,y), where x and y are int, and +computed as (x>>1) + (y>>1) + (x|y)&1 +.OP ICON t1 =i'1 +.OP ARSHIFT t2 p1 t1 +.OP ARSHIFT t3 p2 t1 +.OP OR t4 p1 p2 +.OP AND t4 t4 t1 +.OP IADD t5 t2 t3 +.OP IADD r t5 t4 +.IL UIRHADD arth lnk lnk +rhadd(x,y), where x and y are unsigned, and +computed as (x>>1) + (y>>1) + (x|y)&1 +.OP ICON t1 =i'1 +.OP URSHIFT t2 p1 t1 +.OP URSHIFT t3 p2 t1 +.OP OR t4 p1 p2 +.OP AND t4 t4 t1 +.OP UIADD t5 t2 t3 +.OP UIADD r t5 t4 +.IL KRHADD arth lnk lnk +rhadd(x,y), where x and y are long, and +computed as (x>>1) + (y>>1) + (x|y)&1 +.OP ICON t1 =i'1 +.OP KARSHIFT t2 p1 t1 +.OP KARSHIFT t3 p2 t1 +.OP IKMV t1 t1 +.OP KOR t4 p1 p2 +.OP KAND t4 t4 t1 +.OP KADD t5 t2 t3 +.OP KADD r t5 t4 +.IL UKRHADD arth lnk lnk +rhadd(x,y), where x and y are unsigned long, and +computed as (x>>1) + (y>>1) + (x|y)&1 +.OP ICON t1 =i'1 +.OP KURSHIFT t2 p1 t1 +.OP KURSHIFT t3 p2 t1 +.OP IKMV t1 t1 +.OP KOR t4 p1 p2 +.OP KAND t4 t4 t1 +.OP UKADD t5 t2 t3 +.OP UKADD r t5 t4 +.IL VECTFUNC proc n lnk stc lnk* +Call function which returns a vector +n - the number of arguments. +lnk1 - address of the function being called +stc - the function's vector data type. +lnk2 - address (a LOC ilm) of the temporary which is used to return +the result of the function. +lnk3 ... - user arguments +.AT spec +.IL VSCALAR ref lnk stc2 stc3 +Represents the address of a scalar component of a vector +lnk - base address of vector +stc2 - which component [0, n-1], where n is the number of components in the +vector +stc3 - element dtype +.AT spec +.IL VSEL ref lnk sym stc +Represents the address of selecting multiple components from a vector +lnk - base address of vector +sym - component mask (int vector constant) +stc - result vector data type of the components +.AT spec +.IL VCON cons sym +.OP VCON r v1 +.IL VLD load lnk stc +Vector load. +.nf +lnk - its address +stc - its vector data type +.AT spec +.IL VLDU load lnk stc +Vector load (unaligned) +.nf +lnk - its address +stc - its vector data type +.AT spec +.IL VNEG arth lnk stc +.OP VNEG r p1 v2 +.IL VADD arth lnk lnk stc +.OP VADD r p1 p2 v3 +.IL VSUB arth lnk lnk stc +.OP VSUB r p1 p2 v3 +.IL VMUL arth lnk lnk stc +.OP VMUL r p1 p2 v3 +.IL VDIV arth lnk lnk stc +.AT spec +.IL VDIVZ arth lnk lnk stc +Vector divide where divide by zero does not fault. +.AT spec +.IL VMOD arth lnk lnk stc +.AT spec +.IL VMODZ arth lnk lnk stc +Vector remainder where divide by zero does not fault. +.AT spec +.IL VCVTV arth lnk stc stc +Vector convert from vector +.OP VCVTV r p1 v2 v3 +.IL VCVTS arth lnk stc +Vector convert from scalar +.OP VCVTS r p1 v2 +.IL VCVTR arth lnk stc1 stc2 +Reinterpret a vector object as if it were a different vector type (a.k.a. an +LLVM bitcast instruction). The two types must have the same total byte size, +but may have different element types and different numbers of elements. This +will always be a no-op at runtime. +lnk - the vector value to be reinterpreted +stc1 - the vector dtype to convert to +stc2 - the vector dtype being converted from, which is the type of lnk +.OP VCVTR r p1 v2 v3 +.IL VNOT arth lnk stc +.OP VNOT r p1 v2 +.IL VAND arth lnk lnk stc +.OP VAND r p1 p2 v3 +.IL VOR arth lnk lnk stc +.OP VOR r p1 p2 v3 +.IL VXOR arth lnk lnk stc +.OP VXOR r p1 p2 v3 +.IL VLSHIFTV arth lnk lnk stc +Vector >> by scalar +.OP VLSHIFTV r p1 p2 v3 +.IL VRSHIFTV arth lnk lnk stc +Vector >> by vector +.OP VRSHIFTV r p1 p2 v3 +.IL VLSHIFTS arth lnk lnk stc +Vector << by scalar +.OP VLSHIFTS r p1 p2 v3 +.IL VRSHIFTS arth lnk lnk stc +Vector >> by scalar +.OP VRSHIFTS r p1 p2 v3 +.IL VCMP arth lnk lnk stc +A generic vector comparison. The result is a single boolean scalar. +.AT spec +.IL VCMPEQ arth lnk lnk stc +Element-wise vector comparison for equality. The result is a vector. +.AT spec +.IL VCMPNE arth lnk lnk stc +Element-wise vector comparison for inequality. The result is a vector. +.AT spec +.IL VCMPLT arth lnk lnk stc +Element-wise vector comparison for less-than. The result is a vector. +.AT spec +.IL VCMPGT arth lnk lnk stc +Element-wise vector comparison for greater-than. The result is a vector. +.AT spec +.IL VCMPLE arth lnk lnk stc +Element-wise vector comparison for less-equal. The result is a vector. +.AT spec +.IL VCMPGE arth lnk lnk stc +Element-wise vector comparison for greater-equal. The result is a vector. +.AT spec +.IL VBLEND arth lnk lnk lnk stc +Element-wise vector conditional operator. The result is a vector where for +each element i, result[i] = a[i] ? b[i] : c[i]. +.OP VBLEND r p1 p2 p3 v4 +.IL VPERMUTE arth lnk lnk lnk stc +Shuffle contents of vector registers. lnk1 and lnk2 can be the same vector +or lnk2 can be null. lnk1 dtype is used as dtype for both lnk1 and lnk2, +unless lnk2 is null. stc is the result dtype, lnk3 is a vector constant +representing a mask where each field represents which L-to-R element of +concatenated vector is to be placed in corresponding result +field. lnk3 size must match the size of the result vector, but can be +different than lnk1 and lnk2's size. +.OP VPERMUTE r p1 p2 p3 v4 +.IL VST store lnk lnk stc +Vector store. +lnk1 - destination +lnk2 - source +stc - its vector data type +.AT spec trm +.IL VSTU store lnk lnk stc +Vector store (unaligned) +lnk1 - destination +lnk2 - source +stc - its vector data type +.AT spec trm +.IL ADJARR misc sym sym sym +This ILM is emitted after every "entry" if the entry has +adjustable array arguments. This ILM is used control any additional +setup necessary for the array bounds information of the entry's +adjustable arrays. This ILM will do nothing if the this is for +the primary entry and code has already been emitted for its adjustable +arrays. +\'sym1' entry symbol +\'sym2' label of the additional code +\'sym3' label to which the code branches (returns) +.AT spec trm +.IL VFENTER misc sym +Enter a "function" which computes the value of an expression in a +variable format item (). This ILM is "closed" by a VFRET. +.AT spec trm +.IL VFRET misc lnk +Return the value of an expression in a variable format item (). +.AT spec trm +.IL PRAGMA misc stc1 stc2 stc3 +pragma/directive ILM +.IL FLOATK arth lnk +Convert long long to real number (REAL and FLOAT intrinsics). +.AT i8 +.OP FLOATK r p1 +.IL FLOATUK arth lnk +Convert unsigned long long to real +.AT i8 +.OP FLOATUK r p1 +.FL DFLOATK arth lnk +Convert integer to double precision (DFLOAT intrinsic). +.AT i8 +.OP DFLOATK r p1 +.CL DFLOATK arth lnk +Convert long long to double precision (DFLOAT intrinsic). +.AT i8 +.OP DFLOATK r p1 +.IL DFLOATUK arth lnk +Convert unsigned long long integer to double precision (DFLOAT intrinsic). +.AT i8 +.OP DFLOATUK r p1 +.FL KNEG arth lnk +Integer negation. +.AT i8 +.OP KNEG r p1 +.CL KNEG arth lnk +Integer negation. +.AT i8 +.OP KNEG r p1 +.IL UKNEG arth lnk +Integer negation. +.AT i8 +.OP UKNEG r p1 +.IL KADD arth lnk lnk +.AT spec i8 +.IL UKADD arth lnk lnk +.AT i8 +.OP UKADD kr p1 p2 +.IL KSUB arth lnk lnk +.AT spec i8 +.IL UKSUB arth lnk lnk +.AT i8 +.OP UKSUB kr p1 p2 +.IL KMUL arth lnk lnk +.AT spec i8 +.IL UKMUL arth lnk lnk +.AT i8 +.OP UKMUL kr p1 p2 +.IL KDIV arth lnk lnk +.AT spec i8 +.IL UKDIV arth lnk lnk +.AT i8 +.OP UKDIV kr p1 p2 +.IL IDIVZ arth lnk lnk +Signed integer divide where divide by zero does not fault. +.OP IDIVZ r p1 p2 +.IL UIDIVZ arth lnk lnk +Unsigned integer divide where divide by zero does not fault. +.OP UIDIVZ r p1 p2 +.IL KDIVZ arth lnk lnk +Signed integer64 divide where divide by zero does not fault. +.AT i8 +.OP KDIVZ r p1 p2 +.IL UKDIVZ arth lnk lnk +Unsigned integer64 divide where divide by zero does not fault. +.AT i8 +.OP UKDIVZ kr p1 p2 +.IL KTOI intr lnk lnk +Exponentiation - integer to an integer power. +.AT i8 +.OP NULL t1 iv0 +.OP ARGIR t1 p2 t1 +.OP ARGKR t2 p1 t1 +.\".OP QJSR t3 =e'%l%__mth_i_kpowi t2 +.OP QJSR t3 =e'%l%__mth_i_kpowi t2 +.OP DFRKR r t3 krret +.IL KTOK intr lnk lnk +Exponentiation - integer to an integer power. +.AT i8 +.OP NULL t1 iv0 +.OP ARGKR t1 p2 t1 +.OP ARGKR t2 p1 t1 +.\".OP QJSR t3 =e'%l%__mth_i_kpowk t2 +.OP QJSR t3 =e'%l%__mth_i_kpowk t2 +.OP DFRKR r t3 krret +.IL RTOK intr lnk lnk +.OP FPOWK r p1 p2 +.IL DTOK intr lnk lnk +.OP DPOWK r p1 p2 +.IL CTOK intr lnk lnk +.AT spec +.IL CDTOK intr lnk lnk +.AT spec dcmplx +.IL KCMP arth lnk lnk +.AT spec +.IL UKCMP arth lnk lnk +.AT spec i8 +.IL KABS arth lnk +.AT i8 +.OP KABS r p1 +.IL KFIX arth lnk +Convert real number to integer*8 (INT and IFIX intrinsics). +.AT i8 +.OP FIXK r p1 +.IL UKFIX arth lnk +Convert real number to integer*8 (INT and IFIX intrinsics). +.AT i8 +.OP FIXUK r p1 +.IL KDFIX arth lnk +Convert double precision floating point number to integer*8. +.AT i8 +.OP DFIXK r p1 +.IL UKDFIX arth lnk +Convert double precision floating point number to integer*8. +.AT i8 +.OP DFIXUK r p1 +.FL ITOI8 arth lnk +Convert integer to integer*8 +.AT i8 +.OP IKMV kr p1 +.CL ITOI8 arth lnk +Convert long to long long +.AT i8 +.OP IKMV kr p1 +.IL ITOUI8 arth lnk +Convert long to unsigned long (unsigned long long) +.AT i8 +.OP IKMV kr p1 +.IL UITOI8 arth lnk +Convert unsigned int to long (long long) +.AT i8 +.OP UIKMV kr p1 +.IL UITOUI8 arth lnk +Convert unsigned int to unsigned long (unsigned long long) +.AT i8 +.OP UIKMV kr p1 +.FL I8TOI arth lnk +Convert integer*8 to integer*4 +.AT spec +.OP KIMV r p1 +.CL I8TOI arth lnk +Convert long long to long +.OP KIMV r p1 +.IL I8TOUI arth lnk +Convert long long to long +.OP KIMV r p1 +.IL UI8TOI arth lnk +Convert long long to long +.OP KIMV r p1 +.IL UI8TOUI arth lnk +Convert long long to long +.OP KIMV r p1 +.IL KNINT intr lnk +NINT intrinsic (converts real to integer*8). +.AT i8 +.OP NULL t1 iv0 +.OP ARGSP t1 p1 t1 +.OP QJSR t2 =e'%l%__mth_i_knint t1 +.OP DFRKR r t2 krret +.IL KDNINT intr lnk +KIDNINT intrinsic (converts double to integer). +.AT i8 +.OP NULL t1 iv0 +.OP ARGDP t1 p1 t1 +.OP QJSR t2 =e'%l%__mth_i_kidnnt t1 +.OP DFRKR r t2 krret +.IL KMAX arth lnk lnk +.OP KMAX r p1 p2 +.IL UKMAX arth lnk lnk +.OP UKMAX r p1 p2 +.IL KMIN arth lnk lnk +.OP KMIN r p1 p2 +.IL UKMIN arth lnk lnk +.OP UKMIN r p1 p2 +.IL KDIM intr lnk lnk +.AT i8 +.OP NULL t1 iv0 +.OP DAKR t1 p2 dr(1) t1 +.OP DAKR t2 p1 dr(0) t1 +.OP QJSR t2 =e'%l%ftn_i_kidim t2 +.OP DFRKR r t2 krret +.FL KMOD arth lnk lnk +Integer remainder (MOD intrinsic). +.AT i8 +.OP KMOD r p1 p2 +.CL KMOD arth lnk lnk +Integer remainder (MOD intrinsic). +.AT i8 +.OP KMOD r p1 p2 +.IL UKMOD arth lnk lnk +Integer remainder (MOD intrinsic). +.AT i8 +.OP KUMOD r p1 p2 +.IL MODZ arth lnk lnk +Integer remainder where divide by zero does not fault. +.OP MODZ r p1 p2 +Integer remainder (MODZ intrinsic). +.OP MODZ r p1 p2 +.IL UIMODZ arth lnk lnk +Unsigned integer mod where divide by zero does not fault. +.OP UIMODZ r p1 p2 +.IL KMODZ arth lnk lnk +Integer64 remainder where divide by zero does not fault. +.AT i8 +.OP KMODZ r p1 p2 +.IL UKMODZ arth lnk lnk +Unsigned integer64 remainder where divide by zero does not fault. +.AT i8 +.OP KUMODZ r p1 p2 +.IL KSIGN arth lnk lnk +.AT i8 +.OP NULL t1 iv0 +.OP DAKR t1 p2 dr(1) t1 +.OP DAKR t2 p1 dr(0) t1 +.OP QJSR t3 =e'%l%ftn_i_kisign t2 +.OP DFRKR r t3 krret +.FL KAND arth lnk lnk +Bitwise logical and of two 64 bit values (AND intrinsic). +.AT i8 +.OP KAND r p1 p2 +.CL KAND arth lnk lnk +Bitwise logical and of two 64 bit values (AND intrinsic). +.AT i8 +.OP KAND r p1 p2 +.FL KOR arth lnk lnk +Bitwise logical or of two 64 bit values (OR intrinsic). +.AT i8 +.OP KOR r p1 p2 +.CL KOR arth lnk lnk +Bitwise logical or of two 64 bit values (OR intrinsic). +.AT i8 +.OP KOR r p1 p2 +.FL KXOR arth lnk lnk +Bitwise exclusive or of two 64 bit values (^ operator / EOR intrinsic). +.AT i8 +.OP KXOR r p1 p2 +.CL KXOR arth lnk lnk +Bitwise exclusive or of two 64 bit values (^ operator / EOR intrinsic). +.AT i8 +.OP KXOR r p1 p2 +.FL KNOT arth lnk +Bitwise negation of 64 bit signed value (NOT intrinsic). +.AT i8 +.OP KNOT r p1 +.CL KNOT arth lnk +Bitwise negation of 64 bit signed value (NOT intrinsic). +.AT i8 +.OP KNOT r p1 +.IL UKNOT arth lnk +Bitwise negation of 64 bit signed value (NOT intrinsic). +.AT i8 +.OP UKNOT r p1 +.IL KBITS arth lnk lnk lnk +IBITS(p1, p2, p3) - extract p3 bits beginning at p2 from p1. +.nf +r = p3 != 0 ? (p1 >> p2) & (-1 >> (64 - p3)) : 0 +.AT i8 +.OP KIMV t1 p2 +.OP KARSHIFT t1 p1 t1 +.OP KCON t2 =ll'-1 +.OP KIMV t3 p3 +.OP ICON t4 =i'64 +.OP ISUB t4 t4 t3 +.OP KURSHIFT t5 t2 t4 +.OP KAND t6 t1 t5 +.OP KCMPZ t7 p3 eq +.OP KSELECT r t7 t6 p3 +.IL KBSET arth lnk lnk +IBSET(p1, p2) - set bit p2 of p1 to 1. +.nf +r = p1 | (1 << p2) +.AT i8 +.OP KCON t1 =ll'1 +.OP KIMV t2 p2 +.OP KLSHIFT t2 t1 t2 +.OP KOR r p1 t2 +.IL KBTEST arth lnk lnk +BTEST(p1, p2) - .TRUE. if bit p2 of p1 is 1. +.nf +r = (p1 & (1 << p2)) != 0 +.AT i8 +.OP KCON t1 =ll'1 +.OP KIMV t2 p2 +.OP KLSHIFT t2 t1 t2 +.OP KAND t3 p1 t2 +.OP KCMPZ t4 t3 ne +.OP IKMV r t4 +.IL KBCLR arth lnk lnk +IBLCR(p1, p2) - clear bit p2 of p1. +.nf +r = p1 & ~(1 << p2) +.AT i8 +.OP KCON t1 =ll'1 +.OP KIMV t2 p2 +.OP KLSHIFT t2 t1 t2 +.OP KNOT t3 t2 +.OP KAND r p1 t3 +.IL KSHFTC intr lnk lnk lnk +ISHFTC(p1, p2, p3) - circularly shift the rightmost p3 bits of p1 +by p2. +.AT i8 +.OP NULL t1 iv0 +.OP KIMV t2 p3 +.OP ARGIR t1 t2 t1 +.OP KIMV t2 p2 +.OP ARGIR t2 t2 t1 +.OP ARGKR t3 p1 t2 +.OP QJSR t1 =e'%l%ftn_i_kishftc t3 +.OP DFRKR r t1 krret +.FL KULSHIFT arth lnk lnk +Left shift operator (<<) - first operand is 32 bit unsigned integer +value and second is a positive integer. +.AT i8 +.OP KIMV t1 p2 +.OP KLSHIFT r p1 t1 +.CL KULSHIFT arth lnk lnk +Left shift operator (<<) - first operand is 64 bit unsigned integer +value and second is a 32-bit positive integer. +.AT spec i8 +.FL KURSHIFT arth lnk lnk +Right shift operator (>>). First operand is 64 bit unsigned integer +value and second is assumed to be a positive 64-bit integer. +.AT i8 +.OP KIMV t1 p2 +.OP KURSHIFT r p1 t1 +.CL KURSHIFT arth lnk lnk +Right shift operator (>>). First operand is 64 bit unsigned integer +value and second is assumed to be a positive 32-bit integer. +.AT spec i8 +.IL KAIF branch lnk sym1 sym2 sym3 +.AT spec trm +.OP ICJMPZ null p1 le v2 +.OP ICJMPZ null p1 eq v3 +.OP ICJMPZ null p1 gt v4 +.IL KLD load lnk +.AT spec i8 +.IL KLLD load lnk +Load logical value. +.AT spec i8 +.IL KST store lnk lnk +.AT spec trm +.IL KLST store lnk lnk +.AT spec trm +.FL KFUNC proc n sym lnk* +.AT spec trm i8 +.IL KFUNCA proc n stc lnk lnk* +.AT spec trm i8 +.IL PKFUNCA proc n stc sym lnk lnk* +Call a function which returns an integer*8 through a procedure pointer. +.AT spec trm i8 +.IL KVFUNCA proc n stc sym lnk sym lnk* +.AT spec trm i8 +.CL KFUNC proc n lnk lnk* +.AT spec i8 +.IL KCON cons sym +.AT spec i8 +.IL KISHFT intr lnk lnk +ISHFT intrinsic - first operand is 64 bit value and second is positive or +negative integer shift count. If the shift count <= -64 or >=64, the +result is 0. +.AT i8 +.OP KISHFT r p1 p2 +.IL DPREF8 misc lnk +This ILM is generated when integer*8/logical*8 arguments +are passed in certains contexts and where the address needs +to be adjusted by expand. +.AT spec +.IL LNOT8 arth lnk +Logical negation. The link must be to an expression of type +LOGICAL; depends on internal representation of logical values (VAX or +UNIX) +.AT spec i8 +.IL LNOP8 arth lnk +Logical noop. Used by semant when space must be reserved +for a potential LNOT ILM. 'lnk' points to a logical +expression. +.AT i8 spec +.OP MVIR r p1 iv-1 +.IL LAND8 arth lnk lnk +Logical .AND. operation. +.AT i8 +.OP KAND r p1 p2 +.IL LOR8 arth lnk lnk +Logical .OR. operation. +.AT i8 +.OP KOR r p1 p2 +.IL LEQV8 arth lnk lnk +Logical .EQV. operation. +.AT i8 +.OP KCMP t1 p1 p2 eq +.OP IKMV r t1 +.IL LNEQV8 arth lnk lnk +Logical .NEQV. operation. +.AT i8 +.OP KXOR r p1 p2 +.IL EQ8 arth lnk +Generate true if compare is equal (lnk locates a compare FLM) +.AT spec i8 +.IL NE8 arth lnk +Generate true if compare is not equal +.AT spec i8 +.IL LT8 arth lnk +Generate true if compare is less than +.AT spec i8 +.IL GE8 arth lnk +Generate true if compare is greater than or equal to +.AT spec i8 +.IL LE8 arth lnk +Generate true if compare is less than or equal to +.AT spec i8 +.IL GT8 arth lnk +Generate true if compare is greater than +.AT spec i8 +.IL K2D arth lnk +Cast a 64-bit integer to a 64-bit unsigned integer (dword). +.OP KR2DP r p1 +.IL K2R arth lnk +Cast a 64-bit integer to a single precision real. +.OP KR2SP r p1 +.IL K2I arth lnk +Cast an integer to a 64-bit integer. +.OP KIMV r p1 +.IL D2K arth lnk +Cast a 64-bit unsigned integer (dword) to a 64-bit integer. +.AT i8 +.OP MVKR r p1 iv-1 +.IL R2K arth lnk +Cast a single precision real to a 64-bit integer. +.AT i8 +.OP SP2IR r rp1 +.IL I2K arth lnk +Cast an integer to a 64-bit integer. +.AT i8 +.OP UIKMV r p1 +.IL KEQV arth lnk lnk +.AT i8 +Bitwise complement of the exclusive or of two 32 bit values +.OP KXOR t1 p1 p2 +.OP KNOT r t1 +.IL UKLD load lnk +Load unsigned double integer +.AT spec i8 +.IL UKST store lnk lnk +.AT spec i8 trm +.IL KAST store lnk lnk +Store address scalar. +This ILM is used for an ASSIGN statement where varref is integer*8 +\&'lnk' points to an ACON ILM. +.AT spec trm +.IL KLEN fstr lnk +Length of a character expression, returned as integer*8. +.AT spec i8 +.IL KINDEX fstr lnk lnk +KINDEX intrinsic (inputs are two character strings and result is an integer*8). +.AT spec i8 +.IL UI2K arth lnk +Cast an unsigned integer to a 64-bit integer. +.AT i8 +.OP UIKMV r p1 +.IL BLEADZ intr lnk +8-bit integer LEADZ intrinsic +.OP ILEADZI r p1 iv0 +.IL SLEADZ intr lnk +16-bit integer LEADZ intrinsic +.OP ILEADZI r p1 iv1 +.IL ILEADZ intr lnk +32-bit integer LEADZ intrinsic +.OP ILEADZ r p1 +.IL KLEADZ intr lnk +64-bit integer LEADZ intrinsic +.AT i8 +.OP KLEADZ r p1 +.IL BTRAILZ intr lnk +8-bit integer TRAILZ intrinsic +.OP ITRAILZI r p1 iv0 +.IL STRAILZ intr lnk +16-bit integer TRAILZ intrinsic +.OP ITRAILZI r p1 iv1 +.IL ITRAILZ intr lnk +32-bit integer TRAILZ intrinsic +.OP ITRAILZ r p1 +.IL KTRAILZ intr lnk +64-bit integer TRAILZ intrinsic +.AT i8 +.OP KTRAILZ r p1 +.IL BPOPCNT intr lnk +8-bit integer POPCNT intrinsic +.OP IPOPCNTI r p1 iv0 +.IL SPOPCNT intr lnk +16-bit integer POPCNT intrinsic +.OP IPOPCNTI r p1 iv1 +.IL IPOPCNT intr lnk +32-bit integer POPCNT intrinsic +.OP IPOPCNT r p1 +.IL KPOPCNT intr lnk +64-bit integer POPCNT intrinsic +.AT i8 +.OP KPOPCNT r p1 +.IL BPOPPAR intr lnk +8-bit integer POPPAR intrinsic +.OP IPOPPARI r p1 iv0 +.IL SPOPPAR intr lnk +16-bit integer POPPAR intrinsic +.OP IPOPPARI r p1 iv1 +.IL IPOPPAR intr lnk +32-bit integer POPPAR intrinsic +.OP IPOPPAR r p1 +.IL KPOPPAR intr lnk +64-bit integer POPPAR intrinsic +.AT i8 +.OP KPOPPAR r p1 +.IL ENLAB misc +Marks the position of the first executable statement within +a function: Compiler generated +.AT spec trm +.IL BPAR SMP lnk +Begin parallel region. +.nf +lnk - link to logical expression (inhibit parallel flag): +0 -- parallel execution +nonzero -- serial execution +.AT spec trm +.IL BPARD SMP lnk +Begin nested parallel region. +.nf +lnk - link to logical expression (inhibit parallel flag): +0 -- parallel execution +nonzero -- serial execution +.AT spec trm +.IL EPARD SMP +End nested parallel region. +Always matches a BPARD ilm. +.AT spec trm +.IL EPAR SMP +End parallel region. +Always matches a BPAR ilm. +.AT spec trm +.IL BCS SMP +Begin critical section. +.AT spec trm +.IL ECS SMP +End critical section. +Always matches a BCS ilm. +.AT spec trm +.IL BARRIER SMP +Barrier; thread synchronization point. +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_barrier2 t1 +.IL PDO SMP sym stc +Marks the block associated with label as a parallel loop. +\'sym' - symbol table pointer to the label. +'stc' - encoded schedule information: +stc&0xff (stc>>8)&Oxff +0 static 0 chunk not specified +0 static 1 chunk is 1 +0 static 1 chunk is 'n' +1 dynamic NA +2 guided NA +3 interleaved NA +4 runtime NA +.AT spec trm +.IL BSECTIONS SMP sym +Begin SECTIONS directive. +.nf + +The BSECTIONS, SECTION, and ESECTIONS ILMs define a sections +control structure. The sequence of ILMs and generated code +appear as: +BSECTIONS L1 +if (_mp_lcpu2() .ne. 0) goto L1 +
+SECTION 1 L2 L1 +L1: +if (_mp_lcpu2() .ne. mod(1, _mp_ncpus2()) goto L2 +
+SECTION 2 L3 L2 +L2: +if (_mp_lcpu2() .ne. mod(2, _mp_ncpus2()) goto L3 +
+... +SECTION n LL Ln +Ln: +if (_mp_lcpu2() .ne. mod(n, _mp_ncpus2()) goto LL +
+ESECTIONS LL +LL: +... + +sym - symbol table pointer of the label of the next lexical section +.AT spec trm +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_lcpu2 t1 +.OP DFRIR t2 t2 drret +.OP ICJMPZ null t2 ne v1 +.IL LSECTION SMP lnk sym1 sym2 +LSECTION represent the end of last section directive, used in llvm target. +.nf +lnk - ILM representing the current section number. +sym1 - symbol table pointer of the label of the next lexical section +sym2 - symbol table pointer of the label which labels this section. +.AT spec trm +.IL SECTION SMP lnk sym1 sym2 +SECTION directive. +.nf +lnk - ILM representing the current section number. +sym1 - symbol table pointer of the label of the next lexical section +sym2 - symbol table pointer of the label which labels this section. +.AT spec trm +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_lcpu2 t1 +.OP DFRIR t2 t2 drret +.OP JSR t3 =e'_mp_ncpus2 t1 +.OP DFRIR t3 t3 drret +.OP MOD t3 p1 t3 +.OP ICJMP null t3 t2 ne v2 +.IL ESECTIONS SMP sym +End SECTIONS directive; always matches a BSECTIONS. +.nf +sym - symbol table pointer of the label of the end of the +sections/endsections control structure. +.AT spec trm +.IL MASTER SMP sym +Begin master section. +.nf +sym - symbol table pointer to the end of section label. +.AT spec trm +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_lcpu2 t1 +.OP DFRIR t2 t2 drret +.OP ICJMPZ null t2 ne v1 +.IL EMASTER SMP sym +End master section. +Always matches a MASTER ilm. +.nf +sym - symbol table pointer to the end of section label. +.AT spec trm +.IL SINGLE SMP lnk sym +Single directive. +.nf +lnk - ILM representing the current single section number. +sym - symbol table pointer to the end of section label. +.AT spec trm +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_lcpu2 t1 +.OP DFRIR t2 t2 drret +.OP JSR t3 =e'_mp_ncpus2 t1 +.OP DFRIR t3 t3 drret +.OP MOD t3 p1 t3 +.OP ICJMP null t3 t2 ne v2 +.IL ESINGLE SMP sym +End single section. +Always matches a SINGLE ilm. +.nf +sym - symbol table pointer to the end of section label. +.AT spec trm +.IL LCPU SMP +Intrinsic for computing the cpu/thread number - only works +within the context of BPAR/EPAR. +.AT spec +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_lcpu t1 +.OP DFRIR r t2 drret +.IL LCPU2 SMP +.AT spec +Intrinsic for computing the cpu/thread number - more general +version of LCPU. +.IL LCPU3 SMP +.AT spec +Intrinsic for computing the cpu/thread number to be used as the subscript +of a threadprivate's vector. +.IL NCPUS SMP +.AT spec +Intrinsic for computing the number of cpus/threads - only works +within the context of BPAR/EPAR. +.OP NULL t1 iv0 +.OP JSR t2 =e'_mp_ncpus t1 +.OP DFRIR r t2 drret +.IL NCPUS2 SMP +.AT spec +Intrinsic for computing the number of cpus/threads - more general +version of NCPUS. +.IL PRE_TLS_COPY SMP sym +Prepare the copyin for threadprivate in TLS. Thread that comes upon the +parallel region must save tls-threaprivate address. +.nf +sym - symbol of the tls-threadprivate that is to be copied. +.AT spec trm +.IL BCOPYIN SMP +Begin a copyin block. +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_copyin_init t1 +.IL COPYIN SMP sym +Copyin a threadprivate common block or member +.nf +sym - symbol table entry of the object to be copied in; if it's +ST_CMBLK, the whole common block is copied in. +.AT spec trm +.IL COPYIN_A SMP sym lnk +Copyin a threadprivate allocatable +.nf +sym - symbol table entry of the allocatable object to be copied in. +lnk - size of the allocatable +.AT spec trm +.IL COPYIN_CL SMP sym1 sym2 +Copyin a threadprivate common block or member +.nf +sym1 - symbol table entry of the object to be copied in; if it's +ST_CMBLK, the whole common block is copied in. +sym2 - symbol table entry of the assignment operator routine +.AT spec trm +.IL ECOPYIN SMP +End a copyin block. +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_copyin_term t1 +.IL BCOPYPRIVATE SMP lnk +Begin a copyprivate block. +.nf +lnk - thread number of the thread from which the value(s) are to be copied +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_copypriv_init t1 +.IL COPYPRIVATE_P SMP lnk1 lnk2 +Copyprivate (out) a private variables +.nf +lnk1 - thread number of the thread from which the value(s) are to be copied +lnk2 - link to the data item that is the object of the COPYPRIVATE +.AT spec trm +.IL COPYPRIVATE_PA SMP lnk1 lnk2 lnk3 +Copyprivate (out) a private allocatable variable +.nf +lnk1 - thread number of the thread from which the value(s) are to be copied +lnk2 - link to the data item that is the object of the COPYPRIVATE +lnk3 - size of the allocatable +.AT spec trm +.IL COPYPRIVATE_CL_P SMP lnk1 lnk2 sym +Copyprivate (out) a C++ private variable of type class +.nf +lnk1 - thread number of the thread from which the value(s) are to be copied +lnk2 - link to the data item that is the object of the COPYPRIVATE +sym - symbol table enttry of the assignment operator routine +.AT spec trm +.IL COPYPRIVATE SMP lnk sym +Copyprivate (out) a threadprivate common block, common block member, or variable +.nf +lnk - thread number of the thread from which the value(s) are to be copied +sym - symbol table entry of the object to be copied out; if it's +ST_CMBLK, the whole common block is copied out. +.AT spec trm +.IL COPYPRIVATE_CL SMP lnk1 sym1 sym2 +Copyprivate (out) a threadprivate C++ variable of type class +.nf +lnk1 - thread number of the thread from which the value(s) are to be copied +sym1 - symbol table entry of the class object to be copied out +sym2 - link to the ilms loading the assignment operator routine +.AT spec trm +.IL ECOPYPRIVATE SMP lnk +End a copyprivate block. +.nf +lnk - thread number of the thread from which the value(s) are to be copied +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_copypriv_term t1 +.IL FLUSH SMP +Flush to memory +.AT spec trm +.IL P SMP sym +P(semaphore) - begin a critical section. +.nf +sym - symbol table entry of a semaphore variable +.AT spec trm +.IL V SMP sym +V(semaphore) - end a critical section. +.nf +sym - symbol table entry of a semaphore variable +.AT spec trm +.IL PREFETCH misc lnk stc +Cache prefetch. +.nf +lnk1 - ILM link to an address +stc2 - prefetch flag (for future use). +.AT spec trm +.OP PREFETCH null p1 +.IL BBND misc sym stc +BBND begins the ILMs of the assignments of the bounds +of an adjustable array when it's unknown by +semant that the array is dummy or allocatable +at the time the array is declared. +This could occur when an adjustable array is declared +before its appearance in an ENTRY statement. +If the array is a dummy argument, +the expander will skip the ensuing bounds assignments. +.nf +sym - symbol table entry of an array with adjustable bounds +stc - number of words in the ensuing block of ILMs +representing the adjustable bounds. +.AT spec trm +.IL FILE misc stc stc stc +FILE gives file information when inlining a file. +First operand is the line number. +Second operand is the FIH index of the current file (source or include file). +Third operand is the global ILM index. +.AT spec trm +.IL BEGIN_CATCH misc +Mark the beginning of a user's C++ catch region for GSCOPE purposes +.AT spec trm +.IL END_CATCH misc +Mark the end of a user's C++ catch region for GSCOPE purposes +.AT spec trm +.IL EHREG_ST misc sym sym +Store catch_clause, caught_object to registers +.AT spec trm +.IL EHRESUME misc sym sym +Resume propagation of an existing in-flight exception whose unwinding was +interrupted to run some cleanup code. +.AT spec trm +.IL ALLOC arth lnk +Allocate memory for a C or C++ variable length array. +.OP ALLOC r p1 +.IL DEALLOC misc lnk +Deallocate memory that was allocated by ALLOC. +.AT spec trm +.IL ALLOCA arth lnk lnk sym stc +Use the alloca builtin to create stack space. +.nf +lnk - number of elements +lnk - size (units of bytes) of the base type +sym - symbol table entry of the automatic array +stc - flags: 0 - function level; 1 - from inliner +.AT spec +.IL DEALLOCA misc lnk sym1 sym2 stc +Deallocate memory that was allocated by ALLOCA. +Generally, this is a no-op, but if IM_ALLOCA reverts to using +the heap, need to explicitly free. +lnk - load of array's pointer variable +sym1 - symbol table entry of the automatic array +sym2 - symbol table entry of the deallocation routine +stc - flags: 0 - function level; 1 - from inliner +.AT spec trm +.IL BMPSCOPE SMP sym +Begin scope parallel/clause region. +.nf +sym - symbol table entry to scope ST_BLOCK for this region +.AT spec trm noinlc +.IL EMPSCOPE SMP +End scope for parallel/clause region. +Always matches a BMPSCOPE ilm. +.AT spec trm noinlc +.IL BPARN SMP lnk lnk +Begin parallel region with num_threads. +.nf +lnk1 - link to logical expression (inhibit parallel flag): +0 -- parallel execution +nonzero -- serial execution +lnk2 - link to the num_threads values +.AT spec trm +.IL EPARN SMP +End parallel region. +Always matches a BPARN ilm. +.AT spec trm +.IL BPARA SMP lnk lnk stc stc +Begin parallel region with num_threads and proc_bind. +.nf +lnk1 - link to logical expression (inhibit parallel flag): +0 -- parallel execution +nonzero -- serial execution +lnk2 - link to the num_threads values +stc1 - bit vector: +0x01 - proc_bind is present +0x02 - num_thread is presetnt +0x04 - if is present +stc2: +0x0 - proc_bind - false +0x02 - proc_bind - master +0x03 - proc_bind - close +0x04 - proc_bind - spread +.AT spec trm +.IL BLOCK misc sym +Beginning of a lexical block; sym is the symbol table pointer to the +block symbol. +.AT spec trm +.FL PCMP arth lnk lnk +Pointer comparison for Fortran. +.AT spec +.IL PRAGMASYM misc n stc stc sym* +Handles a pragma with a list of symbols. +First stc is the pragma identifier, 2nd stc is the scope. +.AT spec trm +.IL PRAGMAEXPR misc n stc stc lnk stc* +Handles a pragma with an expression argument +First stc is the pragma identifier, 2nd stc is the scope. +Link is the expression. +List of stc gives any other arguments. +.AT spec trm +.IL PRAGMASYMEXPR misc n stc stc sym lnk* +Handles a pragma with a symbol and a number of expression arguments. +First stc is the pragma identifier, 2nd stc is the scope. +Sym is the symbol. +Links point to the arguments. +.AT spec trm +.IL PRAGMAGEN misc n stc stc stc* +Handles a pragma with no expression and no symbol arguments. +First stc is the pragma identifier, 2nd stc is the scope. +List of stc gives any other arguments. +.AT spec trm +.IL MPLOOP SMP sym sym sym sym sym stc stc +Begin parallel do/loop +sym - lower bound +sym - upper bound +sym - stride +sym - chunk +sym - plast +stc - dtype of loop bound type +stc - schedule type +.AT spec trm +.IL MPDISTLOOP SMP sym sym sym sym sym sym stc stc +Begin parallel do/loop +sym - lower bound +sym - upper bound +sym - stride +sym - chunk +sym - plast +sym - upperD +stc - dtype of loop bound type +stc - schedule type +.AT spec trm +.IL BTASKDUP SMP +Begin taskdup routine +.AT spec trm +.IL ETASKDUP SMP +End taskdup routine +.AT spec trm +.IL MPTASKLOOP SMP sym sym sym sym stc +Begin taskloop +sym - lower bound +sym - upper bound +sym - stride +sym - plast +stc - dtype of loop bound type +.AT spec trm +.IL TASKLASTPRIV SMP sym +taskloop lastprivate offset on task structure +sym - offset constant +.AT spec trm +.IL MPLOOPFINI SMP stc stc +Begin parallel do/loop +stc - dtype of loop bound type +stc - schedule type +.AT spec trm +.IL MPSCHED SMP sym sym sym sym stc +Begin parallel do/loop schedule +sym - lower bound +sym - upper bound +sym - stride +sym - plast +stc - dtype of loop bound type +.AT spec trm +.IL MPBORDERED SMP +Begin KMPC ordered region +.AT spec trm +.IL MPEORDERED SMP +End KMPC ordered region +.AT spec trm +.IL BPDO SMP +Begin parallel do/loop +.AT spec trm +.IL EPDO SMP +End parallel do/loop +Always matches a BPDO ilm. +.AT spec trm +.IL CANCEL SMP sym stc lnk +Cancel construct +.nf +sym - symbol table pointer to the end of construct label. +stc - bit vector: +0x01 - parallel +0x02 - loop +0x03 - sections +0x04 - taskgroup +lnk - link to the logical expression in the if clause; if the clause +is absent, this field is 1 - always call cancel. +.fi +.AT spec trm +.IL CANCELPOINT SMP sym stc +Cancellation construct +.nf +sym - symbol table pointer to the end of construct label. +stc - bit vector: +0x01 - parallel +0x02 - loop +0x03 - sections +0x04 - taskgroup +.fi +.AT spec trm +.IL TASKFIRSTPRIV SMP sym sym +Task firstprivate +sym - symbol table pointer to the shared variable. +sym - symbol table pointer to the private copy. +.AT spec trm +.IL BTASK SMP sym stc lnk lnk +Begin task +Always matches a ETASK ilm +.nf +sym - symbol table pointer to the end of task label. +If this is llvm and C, this will actually be a symbol +table pointer to the flags variable that should already be initialized. +stc - bit vector: +0x01 - untied clause is present +0x02 - if clause is present +lnk1 - link to the logical expression in the if clause; if the clause +is absent, this field is 'null' (BOS_SIZE) +lnk2 - link to the logical expression in the final clause; if the clause +is absent, this field is 'null' +.AT spec trm +.IL BTASKLOOP SMP sym stc lnk lnk lnk lnk +Begin task +Always matches a ETASK ilm +.nf +sym - symbol table pointer to the end of task label. +If this is llvm and C, this will actually be a symbol +table pointer to the flags variable that should already be initialized. +stc - bit vector: +0x01 - untied clause is present +0x02 - if clause is present +0x20 - if final is present +0x80 - if mergeable is present +0x1000 - nogroup clause is present +0x2000 - grainsize clause is present +0x4000 - num_tasks clause is present +lnk1 - link to the logical expression in the if clause; if the clause +is absent, this field is 'null' (BOS_SIZE) +lnk2 - link to the logical expression in the final clause; if the clause +is absent, this field is 'null' +lnk3 - link to priority expression, if clause is absent, this file is 0 +lnk4 - link to grainsize or num_tasks, if clause is abssent, this field +.AT spec trm +.IL ETASKGROUP SMP +Begin Task group. +.AT spec trm +.IL TASKGROUP SMP +End of Task group. +.AT spec trm +.IL ETEAMS SMP +End of Teams register. +.AT spec trm +.IL BTEAMS SMP +Teams register +.AT spec trm +.IL BTEAMSN SMP lnk lnk +Teams register +lnk1 - link to num_teams expression. +lnk2 - link to thread limit expression. +.AT spec trm +.IL ETARGETDATA SMP +End of target data +.nf +.AT spec trm +.IL BTARGETDATA SMP lnk +Begin target data +.nf +lnk - link to logical expression (inhibit target data flag): +0 -- target data execution on host(device is host) +nonzero -- target data execution on device +.AT spec trm +.IL BTARGETUPDATE SMP lnk stc +Begin target update +.nf +lnk - link to logical expression (inhibit target update flag): +0 -- nop +nonzero -- target update execution +stc - bit vector: +0x01 - set if nowait +0x02 - set IF clause is present +0x04 - set if IN depend +0x08 - set if OUT depend +0x10 - set if INOUT depend +.AT spec trm +.IL TARGETUPDATE SMP n stc stc lnk lnk* +Handles a to/from clause from target update with a link to a symbol and a number of expression arguments. +.nf +n - number of extra args +stc - map type +stc - scope. It is useless for this case and always zero. It's needed to process TARGETUPDATE ilm in the same way of MP_MAP +lnk - symbol to be mapped +.fi +.AT spec trm +.IL ETARGETUPDATE SMP +End target update +.nf +.AT spec trm +.IL TARGETENTERDATA SMP lnk stc +Begin target enter data +.nf +lnk - link to logical expression (inhibit target enter data flag): +0 -- target enter data execution on host(device is host) +nonzero -- target enter execution on device +stc - bit vector: +0x01 - set if nowait +0x02 - set IF clause is present +0x04 - set if IN depend +0x08 - set if OUT depend +0x10 - set if INOUT depend +.AT spec trm +.IL TARGETEXITDATA SMP lnk stc +Begin target exit data +.nf +lnk - link to logical expression (inhibit target exit data flag): +0 -- target exit data execution on host(device is host) +nonzero -- target exit data execution on device +stc - bit vector: +0x01 - set if nowait +0x02 - set IF clause is present +0x04 - set if IN depend +0x08 - set if OUT depend +0x10 - set if INOUT depend +.AT spec trm +.IL ETARGET SMP +End of Target register. +.AT spec trm +.IL BTARGET SMP lnk stc +Target register +lnk - link to logical expression (inhibit target exit data flag): +0 -- target exit data execution on host(device is host) +nonzero -- target exit data execution on device +stc - bit vector: +0x01 - set if nowait +0x02 - set when IF target clause is present +0x04 - set when IF parallel clause is present +0x08 - set if IN depend +0x10 - set if OUT depend +0x20 - set if INOUT depend +0x40 - set if teams clause is present +0x80 - set if distribute clause is present +0x100 - set if for clause is present +0x200 - set if simd clause is present +.AT spec trm +.IL EDISTRIBUTE SMP +End of Distribute register. +.AT spec trm +.IL BDISTRIBUTE SMP +Distribute register +.AT spec trm +.IL ETASKREG SMP +End of Task register used in llvm target to mark the end of task region. +.AT spec trm +.IL TASKREG SMP +Task register +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_task_begin t1 +.IL ETASKLOOPREG SMP +End of Taskloop register used in llvm target to mark the end of task region. +.AT spec trm +.IL TASKLOOPVARS SMP +Begin set up taskloop variables +.AT spec trm +.IL TASKLOOPREG SMP lnk lnk lnk +Begin taskloop register +.nf +lnk1 - lowerbound +lnk2 - upperbound +lnk3 - stride +.AT spec trm +.IL ETASK SMP sym +End task +Always matches a BTASK ilm +.nf +sym - symbol table pointer to the end of task label. +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_task_end t1 +.IL ETASKLOOP SMP sym +End taskloop +Always matches a BTASKLOOP ilm +.nf +sym - symbol table pointer to the end of taskloop label. +.AT spec trm +.IL TASKWAIT SMP +Taskwait +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_task_wait t1 +.IL TASKYIELD SMP +Taskyield +.AT spec trm +.OP NULL t1 iv0 +.OP QJSR null =e'_mp_task_yield t1 +.IL BMPPG SMP +Mark the block representing possible prologue of an mp region for +the parallel, parallel do, parallel section, & task directives. +.AT spec trm +.IL EMPPG SMP +End the mp region to which the prologue applies. +Always matches a BMPPG ilm. +.AT spec trm +.IL BAMPPG SMP +Add the ensuing code to the prologue +.AT spec trm +.IL EAMPPG SMP +End adding to the prologue. +Always matches a BAMPPG ilm. +.AT spec trm +.IL INLINE_START misc sym +INLINE_START is put out at the beginning of an lined function to tell zc_eh +processing to process a possible region +.AT spec trm +.IL INLINE_END misc sym +INLINE_END is put out at the end of an lined function to tell zc_eh +processing to process a possible region +.AT spec trm +.IL PRAGMASLIST misc n stc stc lnk* +Handles a pragma with a list of links to symbols. +First stc is the pragma identifier, 2nd stc is the scope. +.AT spec trm +.IL PRAGMASELIST misc n stc stc lnk lnk* +Handles a pragma with a link to a symbol and a number of expression arguments. +First stc is the pragma identifier, 2nd stc is the scope. +Sym is the symbol link. +Links point to the arguments. +.AT spec trm + +.CP FLOAT128CON cons sym +Float128 constant. +.OP FLOAT128CON r v1 +.CP FLOAT128LD load lnk +Float128 load. +.AT spec +.CP FLOAT128ST store lnk lnk +Float128 store +.AT spec trm +.CP FLOAT128FROM arth lnk +Convert double to float128. +.OP FLOAT128FROM r p1 +.CP FLOAT128TO arth lnk +Convert float128 to double. +.OP FLOAT128TO r p1 +.CP FLOAT128CHS arth lnk +Float128 negation. +.OP FLOAT128CHS r p1 +.CP FLOAT128ADD arth lnk lnk +Float128 addition. +.OP FLOAT128ADD r p1 p2 +.CP FLOAT128SUB arth lnk lnk +Float128 subtraction. +.OP FLOAT128SUB r p1 p2 +.CP FLOAT128MUL arth lnk lnk +Float128 multiplication. +.OP FLOAT128MUL r p1 p2 +.CP FLOAT128DIV arth lnk lnk +Float128 division. +.OP FLOAT128DIV r p1 p2 +.CP FLOAT128CMP arth lnk lnk +Float128 comparison. +.AT spec +.CP FLOAT128FUNC proc n lnk lnk* +Call function returning float128 +.AT spec +.CP FLOAT128CMPLX arth lnk lnk +.AT spec +.CP FLOAT128REAL arth lnk +.AT spec +.CP FLOAT128IMAG arth lnk +.AT spec +.CP CFLOAT128CON cons sym +Float128 complex constant. +.AT spec float128cmplx +.CP CFLOAT128LD load lnk +Float128 complex load. +.AT spec float128cmplx +.CP CFLOAT128ST store lnk lnk +Float128 complex store. +.AT spec trm float128cmplx +.CP CFLOAT128STR store lnk lnk +Store the real part of float128 complex. +.AT spec trm +.CP CFLOAT128STI store lnk lnk +Store the imaginary part of float128 complex. +.AT spec trm +.CP CFLOAT128CHS arth lnk +Float128 complex negation. +.AT float128cmplx +.OP FLOAT128CHS rr rp1 +.OP FLOAT128CHS ir ip1 +.CP CFLOAT128ADD arth lnk lnk +Float128 complex addition. +.AT float128cmplx +.OP FLOAT128ADD rr rp1 rp2 +.OP FLOAT128ADD ir ip1 ip2 +.CP CFLOAT128SUB arth lnk lnk +Float128 complex subtraction. +.AT float128cmplx +.OP FLOAT128SUB rr rp1 rp2 +.OP FLOAT128SUB ir ip1 ip2 +.CP CFLOAT128MUL arth lnk lnk +Float128 complex multiplication. +.AT float128cmplx +.OP FLOAT128MUL t1 rp1 rp2 +.OP FLOAT128MUL t2 ip1 ip2 +.OP FLOAT128SUB rr t1 t2 +.OP FLOAT128MUL t1 ip1 rp2 +.OP FLOAT128MUL t2 ip2 rp1 +.OP FLOAT128ADD ir t2 t1 +.CP CFLOAT128DIV arth lnk lnk +Float128 complex division. +.AT float128cmplx +.OP FLOAT128MUL t1 rp2 rp2 +.OP FLOAT128MUL t2 ip2 ip2 +.OP FLOAT128ADD t1 t1 t2 +.OP FLOAT128MUL t2 rp1 rp2 +.OP FLOAT128MUL t3 ip1 ip2 +.OP FLOAT128ADD t2 t2 t3 +.OP FLOAT128DIV rr t2 t1 +.OP FLOAT128MUL t2 ip1 rp2 +.OP FLOAT128MUL t3 rp1 ip2 +.OP FLOAT128SUB t2 t2 t3 +.OP FLOAT128DIV ir t2 t1 +.CP CFLOAT128CMP arth lnk lnk +Float128 complex comparison. +.AT spec float128cmplx +.CP CFLOAT128FUNC proc n lnk lnk* +Call function returning float128 complex. +.AT spec float128cmplx + +.so ilmtp_atomic.n + +.IL PRAGMADPSELIST misc n stc stc lnk stc lnk* +Handles a pragma with a link to a symbol and a number of expression arguments. +n is number of subscripts defined by this pragma +First stc is the pragma identifier, 2nd stc is the scope, 3rd stc is the policy id. +First link is the symbol link. +Links point to the arguments. +.AT spec trm +.IL MP_TARGETMODE SMP stc lnk lnk lnk +End of Target register. +.nf +stc Combined costruct mode +lnk link to num_teams clause if exists +lnk link to thread_limit clause if exists +lnk link to num_threads clause if exists +.AT spec trm +.IL MP_TARGETLOOPTRIPCOUNT SMP sym +loop trip count for target region +.nf +sym - trip count +.AT spec trm +.IL MP_MAP SMP n stc stc lnk lnk* +Handles a map clause with a link to a symbol and a number of expression arguments. +.nf +n - number of extra args +stc - map type +stc - scope +lnk - symbol to be mapped +.fi +.AT spec trm +.IL MP_REDUCTIONITEM SMP sym sym stc +Begin of reduction clause. +.nf +sym - reduction shared symbol +sym - reduction private symbol +stc - reduction operation +.fi +.AT spec trm +.IL MP_BREDUCTION SMP +Begin of reduction clause. +.AT spec trm +.IL MP_EREDUCTION SMP +End of reduction clause. +.AT spec trm +.IL MP_EMAP SMP +End of map clause. +.AT spec trm +.IL MP_BEGIN_DIR SMP +Begin directive +.AT spec trm +.IL MP_END_DIR SMP +End directive +.AT spec trm +.IL HFLD load lnk +Load half precision +.AT spec +.IL HFST store lnk lnk +Store half precision +.IL HFCON cons sym +Half precision constant +.OP HFCON r v1 +.IL HFADD arth lnk lnk +Add half precision +.OP HFADD r p1 p2 +.IL HFMUL arth lnk lnk +Multiply half precision +.OP HFMUL r p1 p2 +.IL HFSUB arth lnk lnk +Subtract half precision +.OP HFSUB r p1 p2 +.IL HFDIV arth lnk lnk +Divide half precision +.OP HFDIV r p1 p2 +.IL HFNEG arth lnk +Negate half precision +.OP HFNEG r p1 +.IL R2HF arth lnk +Convert single precision to half precision +.OP SP2HP r p1 +.IL D2HF arth lnk +Convert double precision to half precision +.OP DP2HP r p1 +.IL HF2R arth lnk +Convert half precision to single precision +.OP HP2SP r p1 +.CL HFFUNC proc n lnk lnk* +Call half precision function +.AT spec +.FL HFFUNC proc n sym lnk* +Call half precision function +.AT spec +.IL HFCMP arth lnk lnk +Compare half precision +.AT spec +.FL HFAIF branch lnk sym1 sym2 sym3 +.AT spec trm +.OP HFCJMPZ null p1 le v2 +.OP HFCJMPZ null p1 eq v3 +.OP HFCJMPZ null p1 gt v4 +.IL HFMAX arth lnk lnk +.OP HFMAX r p1 p2 +.IL HFMIN arth lnk lnk +.OP HFMIN r p1 p2 +.IL UXLNEQV arth lnk lnk +Logical .LNEQV. operation for unixlogical +.OP ICMPZ t1 p1 eq +.OP ICMPZ t2 p2 eq +.OP ICMP r t1 t2 ne +.IL UXLEQV arth lnk lnk +Logical .LEQV. operation for unixlogical +.OP ICMPZ t1 p1 eq +.OP ICMPZ t2 p2 eq +.OP ICMP r t1 t2 eq +.IL UXLAND arth lnk lnk +Logical .LAND. operation for unixlogical +.OP ICMPZ t1 p1 eq +.OP ICMPZ t2 p2 eq +.OP IADD t3 t1 t2 +.OP ICMPZ r t3 eq +.IL UXLNOT arth lnk +Logical .LNOT. operation for unixlogical +.OP ICMPZ r p1 eq +.IL UXLNEQV8 arth lnk lnk +Logical .LNEQV8. operation for unixlogical +.AT i8 +.OP KCMPZ t1 p1 eq +.OP KCMPZ t2 p2 eq +.OP IKMV t1 t1 +.OP IKMV t2 t2 +.OP KCMP kr t1 t2 ne +.IL UXLEQV8 arth lnk lnk +Logical .LEQV8. operation for unixlogical +.AT i8 +.OP KCMPZ t1 p1 eq +.OP KCMPZ t2 p2 eq +.OP IKMV t1 t1 +.OP IKMV t2 t2 +.OP KCMP kr t1 t2 eq +.IL UXLAND8 arth lnk lnk +Logical .LAND8. operation for unixlogical +.AT i8 +.OP KCMPZ t1 p1 eq +.OP KCMPZ t2 p2 eq +.OP KADD t3 t1 t2 +.OP KCMPZ kr t3 eq +.IL UXLNOT8 arth lnk +Logical .LNOT8. operation for unixlogical +.AT i8 +.OP KCMPZ kr p1 eq diff --git a/tools/flang2/utils/ilmtp/riscv64/ilmtp_atomic.n b/tools/flang2/utils/ilmtp/riscv64/ilmtp_atomic.n new file mode 100644 index 00000000000..9e83417ddb8 --- /dev/null +++ b/tools/flang2/utils/ilmtp/riscv64/ilmtp_atomic.n @@ -0,0 +1,72 @@ +.\"/* +.\" * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +.\" * See https://llvm.org/LICENSE.txt for license information. +.\" * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +.\" * +.\" */ + + +.IL BEGINATOMIC misc +Start marker for an ACC Atomic statement. +.AT spec trm +.IL ENDATOMIC misc +End marker for an ACC Atomic statement. +.AT spec trm +.IL BEGINATOMICREAD misc +Start marker for an ACC Atomic Read statement. +.AT spec trm +.IL ENDATOMICREAD misc +End marker for an ACC Atomic Read statement. +.AT spec trm +.IL BEGINATOMICWRITE misc +Start marker for an ACC Atomic Write statement. +.AT spec trm +.IL ENDATOMICWRITE misc +End marker for an ACC Atomic Write statement. +.AT spec trm +.IL BEGINATOMICCAPTURE misc +Start marker for an ACC Atomic Capture block. +.AT spec trm +.IL ENDATOMICCAPTURE misc +End marker for an ACC Atomic Capture block. +.AT spec trm +.IL MP_ATOMIC SMP +Begin atomic region. +Always matches a ENDATOMIC ilm. +.AT spec trm +.IL MP_ENDATOMIC SMP +End atomic region. +Always matches a MP_ATOMIC ilm. +.AT spec trm +.IL MP_ATOMICREAD SMP lnk stc +Atomic read +.nf +lnk - link variable to be loaded +stc - memory order +.AT spec trm +.IL MP_ATOMICWRITE SMP lnk lnk stc +Atomic write +.nf +lnk1 - link to left hand side of atomic write +lnk2 - link to right hand side of atomic write +stc1 - memory order +.AT spec trm +.IL MP_ATOMICUPDATE SMP lnk lnk stc stc +Atomic write +.nf +lnk1 - link to left hand side of atomic update +lnk2 - link to rhs atomic update +stc1 - memory order +stc2 - aop +.AT spec trm +.IL MP_ATOMICCAPTURE SMP lnk lnk stc stc stc +Atomic write +.nf +lnk1 - link to left hand side of atomic capture +lnk2 - link to right hand side of capture statement +stc1 - memory order +stc2 - aop +stc4 - bit vector(unused): +0x01 - set if we capture before update +0x02 - set if this is a capture & write +.AT spec trm